[sawfish] syntax changes in get-window-by-class/re get-window-by-name/re added get-window-by-id window-role ge

[Christopher Bratusek <chrisb src gnome org>]

commit 5135c2a0d73715dccb53ebab339189af92bb8881
Author: Christopher Roy Bratusek <zanghar freenet de>
Date:   Tue Nov 9 20:08:54 2010 +0100

    syntax changes in get-window-by-class/re get-window-by-name/re
    added get-window-by-id window-role get-window-by-role

 ChangeLog                  |    8 +++++
 lisp/sawfish/wm/windows.jl |   76 ++++++++++++++++++++++++++++++--------------
 2 files changed, 60 insertions(+), 24 deletions(-)
---
diff --git a/ChangeLog b/ChangeLog
index 986cbd3..be99431 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2010-11-09  Christopher Bratusek <zanghar freenet de>
+	* lisp/sawfish/wm/windows.jl: added window-role function
+				      merged get-window-by-name-re into get-window-by-name
+				      added possibility to get-window-by-name to check on icon-name
+				      merged get-window-by-class-re into get-window-by-class
+				      added get-window-by-id
+				      added get-window-by-role
+
 2010-11-06  Teika kazura <teika lavabit com>
 	* man/news.texi
 	* sawfish.el: supports let-loop indent.
diff --git a/lisp/sawfish/wm/windows.jl b/lisp/sawfish/wm/windows.jl
index fe82037..bf9e185 100644
--- a/lisp/sawfish/wm/windows.jl
+++ b/lisp/sawfish/wm/windows.jl
@@ -25,9 +25,9 @@
      ;; this module re-exports them for convenience.
      (structure-interface sawfish.wm.windows.subrs)
      (export get-window-by-name
-	     get-window-by-name-re
 	     get-window-by-class
-	     get-window-by-class-re
+	     get-window-by-id
+	     get-window-by-role
 	     window-really-wants-input-p
 	     window-transient-p
 	     mark-window-as-transient
@@ -38,6 +38,7 @@
 	     window-in-cycle-p
 	     window-class
 	     window-pid
+	     window-role
 	     warp-cursor-to-window
 	     activate-window
 	     constrain-dimension-to-hints
@@ -124,29 +125,51 @@
 
 ;;; finding windows, reading properties
 
-  (define (get-window-by-name name)
-    "Find a window object whose window-name is NAME. Returns nil if no such
+  (define (get-window-by-name name #!key regex icon)
+    "Find a window object whose window-name is NAME. If REGEX is set then find
+a window object whose window-name matches NAME. If ICON is set then window-icon-name
+is being checked instead. Returns nil if no such window is found."
+    (if icon 
+        (if regex
+	    (car (filter-windows (lambda (w)
+				   (string-match name (window-icon-name w)))))
+	  (car (filter-windows (lambda (w)
+				 (string= (window-icon-name w) name)))))
+      (if regex
+          (car (filter-windows (lambda (w)
+			         (string-match name (window-name w)))))
+        (car (filter-windows (lambda (w)
+  			       (string= (window-name w) name)))))))
+
+  (define (get-window-by-class class #!key regex)
+    "Find a window object whose window-class is CLASS. If REGEX is set then find
+a window object whose window-class matches CLASS. Returns nil if no such window
+is found."
+    (if regex
+        (car (filter-windows (lambda (w)
+			       (string-match class (window-class w)))))
+      (car (filter-windows (lambda (w)
+  			     (string= (window-class w) class))))))
+
+  (define (get-window-by-id id #!key regex)
+    "Find a window object whose window-id is ID. If REGEX is set then find
+a window object whose window-id matches ID. Returns nil if no such window
+is found."
+    (if regex
+        (car (filter-windows (lambda (w)
+			       (string-match id (window-id w)))))
+      (car (filter-windows (lambda (w)
+			     (string= (window-id w) id))))))
+
+  (define (get-window-by-role role #!key regex)
+    "Find a window object whose window-role is ROLE. If REGEX is set then
+find a window object whose window-role matches ROLE. Returns nil if no such
 window is found."
-    (car (filter-windows (lambda (w)
-			   (string= (window-name w) name)))))
-
-  (define (get-window-by-name-re name)
-    "Find a window object whose window-name matches the regexp NAME.
-Returns nil if no such window is found."
-    (car (filter-windows (lambda (w)
-			   (string-match name (window-name w))))))
-
-  (define (get-window-by-class class)
-    "Find a window object whose window-class is CLASS. Returns nil if no such
-window is found."
-    (car (filter-windows (lambda (w)
-			   (string= (window-class w) class)))))
-
-  (define (get-window-by-class-re class)
-    "Find a window object whose window-class matches the regexp CLASS.
-Returns nil if no such window is found."
-    (car (filter-windows (lambda (w)
-			   (string-match class (window-class w))))))
+    (if regex
+        (car filter-windows (lambda (w)
+			      (string-match role (window-role w))))
+      (car filter-windows (lambda (w)
+			    (string= (window-role w) role)))))
 
   (define (window-really-wants-input-p w)
     "Return nil if window W should never be focused."
@@ -235,6 +258,11 @@ is returned."
     (when (caddr (get-x-property win '_NET_WM_PID))
       (aref (caddr (get-x-property win '_NET_WM_PID)) 0)))
 
+  (define (window-role win)
+    "Returns the window role, or nil if not available."
+    (when (get-x-text-property win 'WM_WINDOW_ROLE)
+      (aref (get-x-text-property win 'WM_WINDOW_ROLE) 0)))
+
   (define (get-window-wm-protocols w)
     "Return a list of symbols defining the X11 window manager protocols
 supported by client window W."