[STUMP] [UPDATE]Re: Tag-based window management

[Michael Raskin]

Julian Stecklina wrote:
> Some general comments:

Thanks for your feedback. After having done it for myself and having
shared it I needed something to actually make me clean it up..

>  - You use READ without *READ-EVAL* bound to NIL. READ is generally a
>    bad idea for everything that is not a quick hack IMHO. 

Oh. You guessed. It was actually a result of cleaning up a big quick
hack.. OK. Fixed. I now use strings.

>  - A line with only a ) violates StumpWM's style.

Fixed.

>  - You use INTERN without binding *PACKAGE* to something sensible.

I agree, that was a bad idea on my part.

>  - Interned symbols are never garbage collected (unless

Or StumpWM crashes. For me it crashes much quicker than runs out of
memory, so I didn't pay attention. Thanks.

>    uninterned). Creating interned symbols at runtime and never disposing
>    of them is IMHO problematic. You could just as well use strings to
>    represent tags. 

Well, now I do use strings. I didn't use them from the beginning because
I had not found willpower to track all ":test 'equalp" in generally not
working code. Now that it worked somehow I did these replaces. As a
bonus, I have seen on #stumpwm that someone wants tags  _before_ looking
for willpower.

As an added bonus, tags are now entered just as a space-separated list
(no more LISP list of symbols syntax).

;; 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.

; String parsing for commands

(defun string-split-by-spaces (x)
  (if (not x) nil 
    (if (listp x) (mapcar 'string-upcase x)
      (cl-ppcre:split " " (string-upcase x)))))

; 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 (string-split-by-spaces tagstring) 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 (format nil "~{~a ~}" (mapcar 'string-upcase 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)))

; Commands for basic operations

(defcommand clear-tags (&optional (argtags nil) (argwin nil)) (:rest :rest)
            "Remove specified or all tags"
            (let*
              ((tags (string-split-by-spaces argtags))
               (condition (if tags (lambda(x) (find x tags :test 'equalp)) 
(lambda (x) t)))) 
              (clear-tags-if condition argwin)))

(defcommand clear-all-tags () ()
            "Remove all tags and start afresh"
            (mapcar (lambda(x) (clear-tags nil x)) (screen-windows 
(current-screen))))

(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 (string-split-by-spaces argtag)))
              (setf (window-tags win) (union tag (window-tags win) :test 
'equalp))))

(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 (string-split-by-spaces argtags))
     (window (or argwindow (current-window)))
     (wtags (union (list "T") (window-tags window) :test 'equalp)))
    (intersection tags wtags :test 'equalp)))

(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 (string-split-by-spaces 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 (string-split-by-spaces 
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 (string-split-by-spaces 
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 (string-split-by-spaces 
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..

(defun window-number-from-tag (window)
  "Find a numeric tag, if any, and parse it"
  (let*
    ((tags (window-tags window))
     (numtag (find-if (lambda(x) (cl-ppcre:scan "^[0-9]+$" x)) tags))
     (num (and numtag (parse-integer numtag))))
    num))

(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 (window-number-from-tag 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) (equalp (window-number x) 
(window-number-from-tag x)))
                        (group-windows (current-group))))))