[STUMP][CONTRIB] Tag-based window management

[Raskin Michael]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

                Hello
        Recently I decided to try tag-based window management. I implemented it
for StumpWM and I find it quite convenient. Attached file contains main
definitions for the tag manipulations.

        Tag-based window management means that each window has a list of
attributes - tags - associated with it. Window numbering preferences are
stored among the other tags; set of the windows for the current group is
formed dynamically based on the same tags.

        Tags are implemented as special window properties (STUMPW_TAGS). That
ensures low probability of conflict with other X11 software, and
possibility for the tags to survive global group reshuffling, StumpWM
reload, StumpWM crash and even temporary IceWM launch.

        Key bindings are deliberately omitted. I find them too personal (I use
weird combos including T (S-t)).

        This file is suitable to go to contrib/ directly for everyone to load.
On the other hand it can be included in the main source tree seemingly
without problems. In that case a few functions could go to wrappers.lisp
(symbolize, list-symbolize) and group.lisp (move-windows-to-group).


Michael Raskin
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.9 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org

iQEcBAEBAgAGBQJJ5PrcAAoJEE6tnN0aWvw3ug0IAKARNcsFkuH4Q3UNcvGloA/R
GjUFRtrDROuV5yyFTJud9LvTZ7WEll+hJojg1CEblnEaHUJpHUuNq3Pp5tuRM2M5
6qtZw0GcYWa32Ak1253z8xqWHei7NGh+5oacawdQL4Uh1UBQYEtHv6EWCSkRYdaB
Th48Ip5VVg+1SQSZ0dAbboFUfCfFbIQ0nSfKYjeOfCZgIlRh9cVH9sjbIPA/WZdo
aNEisFDye5qXbvqjy49F1B/Q29Fv+KNq2JgfyTr+lkvwEXOEZ9TheC7LjbnQOpS6
BHaGJOzqCqf4C9PFEdls6+lEFF9u+mWDtZcy2YXrU4sApTjS13rvg04UFnjaFvA=
=qUQ5
-----END PGP SIGNATURE-----

;; Current file copyright (C) 2009 Michael Raskin

;;  This file is part of stumpwm.
;;
;; stumpwm is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; stumpwm is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA

(in-package :stumpwm)

; Window tags. Window tags are special window properties (stored in X11 window 
properties)
; that can be used for window manipulations. They can survive temporary WM 
change and allow
; more flexible classification of windows than selecting window groups for them.

; Basic operations

(defcommand window-tags (&optional (argwin nil)) ()
            "Show window tags"
        (let* ((win (or argwin (current-window)))
               (tags (xlib:get-property (window-xwin win) :STUMPWM_TAGS))
               (tagstring (utf8-to-string tags))
               (taglist 
                 (if tags (with-input-from-string (tagstream tagstring) (read 
tagstream)) nil)
                 )
               )
          (if argwin taglist (message "Tags: ~{~%~a~}" taglist))))

(defun (setf window-tags) (newtags &optional (argwin nil))
  "Set the window tag set for a window"
        (let*
          ((win (or argwin (current-window)))
           (tagstring (write-to-string newtags))
           )
          (xlib:change-property (window-xwin win)
                                :STUMPWM_TAGS
                                (string-to-utf8 tagstring)
                                :UTF8_STRING 8
                                )))

(defun clear-tags-if (clearp &optional (argwin nil))
  "Remove tags matched by predicate"
  (let*
    ((win (or argwin (current-window)))
     (new-tags (remove-if clearp (window-tags win)))
     )
    (setf (window-tags win) new-tags)))

; String parsing for commands

(defun symbolize (x)
  (if (not x) nil
    (if (symbolp x) x
      (intern (string-upcase x)))))

(defun list-symbolize (x)
  (if (stringp x)
    (list-symbolize (with-input-from-string (xs x) (read xs)))
    (if (not x) nil
      (if (not (consp x))
        (list x)
        x))))


; Commands for basic operations

(defcommand clear-tags (&optional (argtags nil) (argwin nil)) (:rest :rest)
            "Remove specified or all tags"
            (let*
              ((tags (list-symbolize argtags))
               (condition (if tags (lambda(x) (find x tags)) (lambda (x) t)))
               ) 
              (clear-tags-if condition argwin)))

(defcommand tag-window (argtag &optional (argwin nil)) ((:rest "Tag to set: ") 
:rest)
            "Add a tag to current window"
            (let*
              ((win (or argwin (current-window)))
               (tag (list-symbolize argtag))
               )
              (setf (window-tags win) (union tag (window-tags win)))))

(defcommand all-tags () ()
            "List all windows with their tags"
            (let ((*suppress-echo-timeout* t))
              (message 
                "Window list: ~{~%~{[ ~a ] ( ~a | ~a | ~a ) ~% ->~{~a, ~}~}~}"
                (mapcar
                  (lambda(x)
                    (list
                      (window-title x)
                      (window-class x)
                      (window-res x)
                      (window-role x)
                      (window-tags x)
                      ))
                  (screen-windows (current-screen)))
                )))

; Selection of tags and windows by tags

(defun tags-from (argtags &optional (argwindow nil))
  "Check whether (current) window has one of the specified tags.
  Tag T is implicitly assigned to all windows."
  (let*
    ((tags (list-symbolize argtags))
     (window (or argwindow (current-window)))
     (wtags (union (list t) (window-tags window)))
     )
    (intersection tags wtags)))

(defun select-by-tags (argtags &optional (without nil))
  "Select windows with (without) one of the specified tags 
  (any of the specified tags) from current screen. Tag T
  is implicitly assigned to every window"
  (let*
    ((tags (list-symbolize argtags))
     (condition (lambda(w) (tags-from tags w)))
     (windows (screen-windows (current-screen)))
     )
    (if without 
      (remove-if condition windows)
      (remove-if-not condition windows))))

; Window manipulations using tags

; General function

(defun move-windows-to-group (windows &optional (arggroup nil))
  "Move all windows from the list to the group"
  (let*
    ((group 
       (if (stringp arggroup) 
         (or 
           (find-group (current-screen) arggroup) 
           (add-group (current-screen) arggroup)
           )
         (or arggroup (current-group))))
     )
    (mapcar (lambda (w) (move-window-to-group w group)) windows)))

; And convenient instances

(defcommand pull-tag (argtag) ((:rest "Tag(s) to pull: "))
            "Pull all windows with the tag (any of the tags) to current group"
            (move-windows-to-group (select-by-tags (list-symbolize argtag))))

(defcommand push-without-tag (argtag) ((:rest "Tag(s) needed to stay in the 
group: "))
            "Push windows not having the tag (any of the tags) to .tag-store"
            (move-windows-to-group (select-by-tags (list-symbolize argtag) T) 
".tag-store"))

(defcommand push-tag (argtag) ((:rest "Tag(s) to push: "))
            "Push windows having the tag (any of the tags) to .tag-store"
            (move-windows-to-group (select-by-tags (list-symbolize argtag)) 
".tag-store"))

(defcommand pull+push (argtag) ((:rest "Tag(s) to select: "))
            "Pull all windows with the tag, push all without"
            (pull-tag argtag)
            (push-without-tag argtag))

(defcommand push-window () ()
            "Push window to tag store"
            (move-windows-to-group (list (current-window)) ".tag-store")
            )

; Manage window numbers by tags..

(defcommand number-by-tags () ()
            "Every window tagged <number> will have a chance to have that 
number. 
            The remaining windows will have packed numbers"

            ; First, assign impossible numbers.
            (mapcar
              (lambda(x)
                (setf (window-number x) -1)
                )
              (group-windows (current-group))
              )
            ; Now try to assign numbers to windows holding corresponding tags.
            (mapcar
              (lambda (x) 
                (let* 
                  ((num (find-if #'numberp (window-tags x)))
                   (occupied (mapcar 'window-number (group-windows 
(current-group))))
                   )
                  (if (and num (not (find num occupied)))
                    (setf (window-number x) num)
                    )))
              (group-windows (current-group))
              )
            ; Give up and give smallest numbers possible
            (repack-window-numbers 
              (mapcar 'window-number
                      (remove-if-not 
                        (lambda(x) (equal (window-number x) (find-if #'numberp 
(window-tags x))))
                        (group-windows (current-group))
                        )
                )
              )
            )

tags.lisp.sig
Description: Binary data