[clfswm-cvs] r405 - in clfswm: . src

Philippe Brochard pbrochard at common-lisp.net
Sat Feb 12 22:43:02 UTC 2011


Author: pbrochard
Date: Sat Feb 12 17:43:02 2011
New Revision: 405

Log:
*never-managed-window-list*: Structure change to be more flexible. Let the choice to focus, raise and do nothing on never managed windows.

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/config.lisp
   clfswm/src/xlib-util.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat Feb 12 17:43:02 2011
@@ -1,3 +1,14 @@
+2011-02-12  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/xlib-util.lisp (equal-wm-class-fun, equal-wm-name-fun)
+	(raise-window-fun, raise-and-focus-window-fun): New functions.
+
+	* src/config.lisp (*clfswm-terminal-cmd*): Switch from xterm to
+	urxvt.
+	(*never-managed-window-list*): Structure change to be more
+	flexible. Let the choice to focus, raise and do nothing on never
+	managed windows.
+
 2011-02-09  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (mouse-focus-move/resize-generic): Take

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Sat Feb 12 17:43:02 2011
@@ -179,9 +179,9 @@
 (defun never-managed-window-p (window)
   (when (xlib:window-p window)
     (dolist (type *never-managed-window-list*)
-      (destructuring-bind (test predicate result raise) type
-	(when (funcall test (funcall predicate window) result)
-	  (return (values t raise)))))))
+      (when (funcall (first type) window)
+	(return (values t (second type)))))))
+
 
 
 (defgeneric child-name (child))

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Sat Feb 12 17:43:02 2011
@@ -160,12 +160,14 @@
 
 (defun find-child-under-mouse-in-never-managed-windows (x y)
   "Return the child under mouse from never managed windows"
-  (dolist (win (xlib:query-tree *root*))
-    (unless (window-hidden-p win)
-      (multiple-value-bind (managed raise)
-	  (never-managed-window-p win)
-	(when (and managed raise (in-window win x y))
-	  (return-from find-child-under-mouse-in-never-managed-windows win))))))
+  (let ((ret nil))
+    (dolist (win (xlib:query-tree *root*))
+      (unless (window-hidden-p win)
+	(multiple-value-bind (never-managed raise)
+	    (never-managed-window-p win)
+	  (when (and never-managed raise (in-window win x y))
+	    (setf ret win)))))
+    ret))
 
 
 (defun find-child-under-mouse-in-child-tree (x y &optional first-foundp)
@@ -630,16 +632,16 @@
 		 (frame (funcall mouse-fn child parent root-x root-y)))
 	       (focus-all-children child parent window-parent)
 	       (show-all-children *current-root*)))
-	   (move/resize-never-managed (child)
-	     (raise-window child)
+	   (move/resize-never-managed (child raise-fun)
+	     (funcall raise-fun child)
 	     (funcall (cond ((eql mouse-fn #'move-frame) #'move-window)
 			    ((eql mouse-fn #'resize-frame) #'resize-window))
 		      child root-x root-y)))
     (let ((child (find-child-under-mouse root-x root-y nil t)))
-      (multiple-value-bind (never-managed raise)
+      (multiple-value-bind (never-managed raise-fun)
 	  (never-managed-window-p child)
-	(if (and (xlib:window-p child) never-managed raise)
-	    (move/resize-never-managed child)
+	(if (and (xlib:window-p child) never-managed raise-fun)
+	    (move/resize-never-managed child raise-fun)
 	    (move/resize-managed child))))))
 
 
@@ -1473,7 +1475,8 @@
 			  (cons (second tx))
 			  (t *notify-window-foreground*)))))
     (defun is-notify-window-p (win)
-      (xlib:window-equal win window))
+      (when (and (xlib:window-p win) (xlib:window-p window))
+	(xlib:window-equal win window)))
 
     (defun refresh-notify-window ()
       (add-timer 0.1 #'refresh-notify-window :refresh-notify-window)
@@ -1490,7 +1493,8 @@
     (defun close-notify-window ()
       (erase-timer :refresh-notify-window)
       (setf *never-managed-window-list*
-	    (remove (list #'equal #'is-notify-window-p t t) *never-managed-window-list* :test #'equal))
+	    (remove (list #'is-notify-window-p (raise-window-fun))
+		    *never-managed-window-list* :test #'equal))
       (when gc
 	(xlib:free-gcontext gc))
       (when window
@@ -1528,7 +1532,7 @@
 					 :line-style :solid))
 	  (when (frame-p *current-child*)
 	    (setf current-child *current-child*)
-	    (push (list #'equal #'is-notify-window-p t t) *never-managed-window-list*))
+	    (push (list #'is-notify-window-p (raise-window-fun)) *never-managed-window-list*))
 	  (map-window window)
 	  (refresh-notify-window)
 	  (xlib:display-finish-output *display*))))))

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Sat Feb 12 17:43:02 2011
@@ -47,11 +47,12 @@
 
 ;;; CONFIG - Never managed window list
 (defparameter *never-managed-window-list*
-  '((string-equal xlib:get-wm-class "ROX-Pinboard" nil)
-    (string-equal xlib:get-wm-class "xvkbd" t)
-    (string-equal xlib:wm-name "clfswm-terminal" t))
+  (list (list (equal-wm-class-fun "ROX-Pinboard") nil)
+	(list (equal-wm-class-fun "xvkbd") (raise-window-fun))
+	(list (equal-wm-name-fun "clfswm-terminal") (raise-and-focus-window-fun)))
   "Config(): CLFSWM will never manage windows of this type.
-A list of (predicate-function-on-window expected-string raise-p)")
+A list of (list match-function handle-function)")
+
 
 
 (defparameter *hide-unmanaged-window* t
@@ -129,8 +130,8 @@
 (defparameter *clfswm-terminal-name* "clfswm-terminal"
   "Config(Corner group): The clfswm terminal name")
 ;;(defparameter *clfswm-terminal-cmd* (format nil "xterm -T ~A -e /bin/bash --noprofile --norc" *clfswm-terminal-name*)
-;;(defparameter *clfswm-terminal-cmd* (format nil "urxvt -name ~A" *clfswm-terminal-name*)
-(defparameter *clfswm-terminal-cmd* (format nil "xterm -T ~A" *clfswm-terminal-name*)
+(defparameter *clfswm-terminal-cmd* (format nil "urxvt -name ~A" *clfswm-terminal-name*)
+;;(defparameter *clfswm-terminal-cmd* (format nil "xterm -T ~A" *clfswm-terminal-name*)
   "Config(Corner group): The clfswm terminal command.
 This command must set the window title to *clfswm-terminal-name*")
 

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Sat Feb 12 17:43:02 2011
@@ -393,14 +393,14 @@
 
 (defun raise-window (window)
   "Map the window if needed and bring it to the top of the stack. Does not affect focus."
-  (when window
+  (when (xlib:window-p window)
     (when (window-hidden-p window)
       (unhide-window window))
     (setf (xlib:window-priority window) :top-if)))
 
 (defun focus-window (window)
   "Give the window focus."
-  (when window
+  (when (xlib:window-p window)
     (xlib:set-input-focus *display* window :parent)))
 
 
@@ -797,3 +797,23 @@
      when (plusp k)
      return t))
 
+;;; Windows wm class and name tests
+(defun equal-wm-class-fun (class)
+  (lambda (win)
+    (when (xlib:window-p win)
+      (string-equal (xlib:get-wm-class win) class))))
+
+(defun equal-wm-name-fun (name)
+  (lambda (win)
+    (when (xlib:window-p win)
+      (string-equal (xlib:wm-name win) name))))
+
+(defun raise-window-fun ()
+  (lambda (win)
+    (raise-window win)))
+
+(defun raise-and-focus-window-fun ()
+  (lambda (win)
+    (raise-window win)
+    (focus-window win)))
+




More information about the clfswm-cvs mailing list