[sawfish] New grammar for 'add-window-matcher' and 'remove-window-matcher'.

[Christopher Bratusek <chrisb src gnome org>]

commit 720c1c5d64dbb9d0f77bc09cd56a1bbae9456f76
Author: Teika kazura <teika lavabit com>
Date:   Fri Dec 4 15:23:12 2009 +0900

    New grammar for 'add-window-matcher' and 'remove-window-matcher'.
    Now it is possible to specify both window's name and class (and others).
    They now take two arguments. Old usage is still supported. Doc is done.
    
    The old behavior was buggy, and even if the old grammar is used,
    it is amended.
     Suppose you've already got rules for '((WM_NAME "foo") (WM_CLASS "class"))
    and '((WM_NAME "bar") (WM_CLASS "class")).
    Now if you you (add-window-matcher 'WM_CLASS "class" actions...),
    then it used to be added to *one of* the above two, and it was unpredictable
    which would be! This is fixed.

 lisp/sawfish/wm/custom-defaults.jl  |   12 ++++-
 lisp/sawfish/wm/ext/match-window.jl |   88 ++++++++++++++++++++++++----------
 man/news.texi                       |   19 ++++++++
 man/sawfish.texi                    |   68 ++++++++++++++++++++++++---
 4 files changed, 151 insertions(+), 36 deletions(-)
---
diff --git a/lisp/sawfish/wm/custom-defaults.jl b/lisp/sawfish/wm/custom-defaults.jl
index 4a02f8b..8acde51 100644
--- a/lisp/sawfish/wm/custom-defaults.jl
+++ b/lisp/sawfish/wm/custom-defaults.jl
@@ -1,4 +1,4 @@
-;; custom-defaults.jl -- customize settings loaded if no user customization
+;; custom-defaults.jl -- loaded if there's no user customization
 
 ;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
 
@@ -18,5 +18,11 @@
 ;; along with sawfish; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
-(custom-set-typed-variable (quote workspace-geometry) (quote (4 1 . 1))
-                           (quote workspace-geometry))
+;; This file is read if there's no ~/.sawfish/custom.
+
+;; The following can be taken as an example.
+;; (But it is a deprecated variable, so meaningless per se.)
+
+;;(custom-set-typed-variable (quote workspace-geometry)
+;;			     (quote (4 1 . 1))
+;;                           (quote workspace-geometry))
diff --git a/lisp/sawfish/wm/ext/match-window.jl b/lisp/sawfish/wm/ext/match-window.jl
index bbb585c..2ae2bb7 100644
--- a/lisp/sawfish/wm/ext/match-window.jl
+++ b/lisp/sawfish/wm/ext/match-window.jl
@@ -21,19 +21,7 @@
 ;; Commentary:
 
 ;; This module provides a general mechanism for setting properties on
-;; matched windows as they're created. It removes much of the need for
-;; manually creating functions to put in before-add-window-hook.
-
-;; For example, doing:
-
-;;	(add-window-matcher 'WM_CLASS "Term" '(place-mode . interactive))
-
-;; makes all terminal windows be placed interactively. Or even better:
-
-;;	(add-window-matcher 'WM_CLASS "Netscape/Navigator"
-;;			    '(ignore-program-position . t))
-
-;; makes netscape windows a lot easier to live with.
+;; matched windows as they're created.
 
 (define-structure sawfish.wm.ext.match-window
 
@@ -203,13 +191,52 @@
   (define (define-match-window-formatter name formatter)
     (put name 'match-window-formatter formatter))
 
+  (define (alist-eq-p a b)
+    "Whether alist a and b are equal. Used by add/remove-window-matcher"
+    (let (ret-val tem)
+      (when (eq (length a)
+		(length b))
+	(setq ret-val t)
+	(while b
+	  (setq tem (assoc (caar b) a))
+	  (if (and tem
+		   (equal (cdr tem) (cdar b)))
+	      (setq b (cdr b))
+	    (setq ret-val nil)
+	    (setq b nil))))
+      ret-val))
+
 ;;; main entry point
 
-  (define (add-window-matcher prop value #!rest actions)
+  (define (add-window-matcher rules #!rest actions)
+    ;; #!rest is used to support the old usage.
+    ;; The new grammar is (add-window-matcher rules actions),
+    ;; where `actions' is an alist.
+    ;;
+    ;; The old grammar remains supported, but it is deprecated.
+    ;; It was:
+    ;;  (add-window-matcher 'WM_CLASS "Term"
+    ;;       '(place-mode . interactive)
+    ;;       '(maximize . all)
+    ;;        ... )
+    ;; The new style is introduced in 1.6. The old one can be deleted in
+    ;; future.
+    ;;
+    ;; It used to have a bug in how the match was done.
+    ;; Read the commit log.
+    ;;
+    ;; This wrapper function exists only to support the old use.
+    (if (consp rules)
+	(add-window-matcher-core rules (car actions))
+      ;; old usage
+      (add-window-matcher-core (list (cons rules (car actions)))
+			       (cdr actions)))
+    )
+
+  (define (add-window-matcher-core rules actions)
     (catch 'out
       (let
-	  ((pair (cons prop value))
-	   (add-to (lambda (slot)
+	  ((add-to (lambda (slot)
 		     (mapc (lambda (action)
 			     (let
 				 ((tem (assq (car action) (cdr slot))))
@@ -217,21 +244,30 @@
 				   (rplacd tem (cdr action))
 				 (rplacd slot (cons action (cdr slot))))))
 			   actions))))
-	;; does the list already contain a (PROP . VALUE) pair?
+	;; does the list already contain any actions for rules?
+	;; then add, using add-to.
 	(mapc (lambda (cell)
-		(when (member pair (car cell))
+		(when (alist-eq-p rules (car cell))
 		  (add-to cell)
 		  (throw 'out t)))
 	      match-window-profile)
-	;; no
-	(setq match-window-profile (cons (list (cons pair nil))
+	;; no. create new entry
+	(setq match-window-profile (cons (list* rules actions)
 					 match-window-profile))
-	(add-to (car match-window-profile)))))
-
-  (define (remove-window-matcher prop value #!rest props)
+      )))
+
+  (define (remove-window-matcher rules #!rest props)
+    ;; See add-window-matcher for why this wrapper is.
+    (if (consp rules)
+	(remove-window-matcher-core rules (car props))
+      ;; old usage
+      (remove-window-matcher-core (list (cons rules (car props)))
+				  (cdr props)))
+    )
+  
+  (define (remove-window-matcher-core rules props)
     (let
-	((pair (cons prop value))
-	 (remove-from (lambda (slot)
+	((remove-from (lambda (slot)
 			(mapc (lambda (p)
 				(let
 				    ((tem (assq p (cdr slot))))
@@ -239,7 +275,7 @@
 				    (rplacd slot (delq tem (cdr slot))))))
 			      props))))
       (mapc (lambda (cell)
-	      (when (member pair (car cell))
+	      (when (alist-eq-p rules (car cell))
 		(remove-from cell)))
 	    match-window-profile)
       ;; remove any empty matchers
diff --git a/man/news.texi b/man/news.texi
index 6a89b2d..4169022 100644
--- a/man/news.texi
+++ b/man/news.texi
@@ -205,6 +205,25 @@ Internally, a new function @code{remove-frame-part-value} which allows to change
 In practice, @code{rename-window} works, but technically speaking, the
 window name is not supposed to be changed in ICCCM.
 
+ item Window rules can be set by lisp
+
+Window rules (former ``matched windows'') can easily be set from
+configurator, but it can now be set by lisp, too, with
+ code{add-window-matcher} function. For the details, @xref{Window
+Rules by Matching}. An example usage is like this:
+
+
+ lisp
+(add-window-matcher '((WM_NAME . "^root$")
+                      (WM_CLASS . "^XTerm/xterm$"))
+                    '((ignore-program-position . t)
+                      (maximize . vertical)))
+ end lisp
+
+In fact, this function has existed, but now it can take multiple
+rules, and the grammar has changed. The old syntax is still allowed,
+but deprecated.
+
 @item 5 new move-cursor commands (@code{move-cursor-} @code{northwest}, @code{northeast}, @code{southwest}, @code{southeast}), and @code{move-cursor-center} [Christopher Bratusek]
 
 @item Added @code{resize-by-factor} meta-function and @code{double-}, @code{halve-window-size} functions making use of it [Christopher Bratusek]
diff --git a/man/sawfish.texi b/man/sawfish.texi
index cfe831d..fc5e25f 100644
--- a/man/sawfish.texi
+++ b/man/sawfish.texi
@@ -810,6 +810,7 @@ Return true if @var{window} includes @var{atom} in its
 * Animating Windows::
 * Cycling Between Windows::
 * Window Groups::
+* Window Rules by Matching::
 @end menu
 
 
@@ -2509,7 +2510,7 @@ screen.
 @deffnx Command maximize-window-fullscreen window
 Maximize both dimensions of @var{window} on the screen, removing
 window decorations and making the window edges flush with the screen
-sides. 
+sides.
 
 If @var{state} nil, it unmaximizes. Else, it maximizes. If called as
 a command, it always maximizes.
@@ -2778,7 +2779,7 @@ Switch input focus to the most-recently focused window in the current
 workspace.
 @end defun
 
- node Window Groups,  , Cycling Between Windows, Windows
+ node Window Groups, Window Rules by Matching , Cycling Between Windows, Windows
 @section Window Groups
 @cindex Groups, windows
 
@@ -2816,6 +2817,59 @@ belongs to one group.
 * Operations on Groups::
 @end menu
 
+ node Window Rules by Matching, , Window Groups, Windows
+ section Window Rules by Matching
+ cindex Matching, windows
+
+Sawfish can trigger actions particular to each window. More
+precisely, if the window's properties match to the user set rule, then
+it is executed when the window appears. Check is done in
+ code{before-add-window-hook}  (@pxref{Standard Hooks})
+
+These rules can easily be set by configurater GUI, but there're
+functions to manipulate them. They're defined in
+ code{sawfish wm ext match-window} 
+
+ defun add-window-matcher rules actions
+Let us see an example first:
+
+ lisp
+(add-window-matcher '((WM_NAME . "^root$")
+                      (WM_CLASS . "^XTerm/xterm$"))
+                    '((ignore-program-position . t)
+                      (maximize . vertical)))
+ end lisp
+
+ var{rules} is an alist, and each value is matched using regex.
+Allowed keys are any of @code{WM_NAME}, @code{WM_CLASS},
+ code{WM_ICON_NAME}, @code{WM_WINDOW_ROLE}, @code{WM_CLIENT_MACHINE},
+ code{WM_COMMAND}, and @code{WM_LOCALE_NAME}. Values to the keys are
+strings. Windows are selected if all of these rules match.
+
+ var{actions} is an alist. For possible keys and values, see
+ file{lisp/sawfish/wm/ext/match-window.jl}.
+
+Check for invalid arguments are not done.
+ end defun
+
+ defun remove-window-matcher rules props
+Opposite of @code{add-window-matcher}, but unlike it, @var{props} are
+list of properties. Example:
+
+ lisp
+(remove-window-matcher '((WM_NAME . "^root$"))
+                       '(place-mode ignore-program-position))
+ end lisp
+ end defun
+
+The best place to use @code{add-window-matcher} is in
+ file{~/.sawfish/rc}. It's because rules modified by these commands are
+not necessarily saved, depending on how you run the configurator.
+
+The rules are stored in variable @code{match-window-profile}. Use
+the above functions to modify its value. It is not recommended
+to directly manipulate it.
+
 @node Assigning Windows to Groups, Operations on Groups, Window Groups, Window Groups
 @subsection Assigning Windows to Groups
 @cindex Groups, assigning windows to
@@ -4021,7 +4075,7 @@ for most cases.
 The number of viewports of the virtual desktop. This is a cons cell
 @code{(columns . rows)}.  Defaults to @code{(1 . 1)}.
 
-If @code{viewport-boundary-mode} is @code{dynamic} (@pxref{Dynamic 
+If @code{viewport-boundary-mode} is @code{dynamic} (@pxref{Dynamic
 Viewport}), then this variable is the current size of the current
 workspace, and does not have the meaning as a user option.
 @end defvar
@@ -4122,7 +4176,7 @@ each step in the motion.
 @defvr Customizable scroll-viewport-steps
 When you move the viewport, the bigger this value, the more
 smoothly the screen is scrolled. It is the number of steps for
-scrolling. 
+scrolling.
 
 The default value 1 means the change is instantaneous, and no scroll
 is done. The upper limit for customization is 50.
@@ -4150,7 +4204,7 @@ specification may change.
 
 @defvar viewport-minimum-dimensions
 This is only useful if dynamic viewport is enabled. It means that
- code{viewport-dimensions} gets never less than this variable. 
+ code{viewport-dimensions} gets never less than this variable.
 
 If setting @code{viewport-minimum-dimensions} by hand (not by the
 customization interface) be sure to call
@@ -4968,7 +5022,7 @@ Sawfish generates applications menu from @file{*.desktop} files.
 If non-nil, @code{apps-menu} is automatically generated from
 @code{user-apps-menu} and @file{*.desktop} files. If you set
 @code{apps-menu}, then it won't happen anyway.
- 
+
 Default is @code{t}.
 @end defvar
 
@@ -6446,7 +6500,7 @@ The hook functions are passed one argument which is the command name.
 
 @defvr {Hook} pre-command-hook
 Called before each command is evaluated. If you set the value
- code{this-command} to @code{nil} in this hook, then the command 
+ code{this-command} to @code{nil} in this hook, then the command
 won't be executed.
 @end defvr