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

[Philippe Brochard]

Author: pbrochard
Date: Fri Sep 10 17:02:16 2010
New Revision: 315

Log:
src/clfswm-corner.lisp (generate-present-body): New macro. (present-clfswm-terminal, present-virtual-keyboard): Use generate-present-body.

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-corner.lisp
   clfswm/src/clfswm.lisp
   clfswm/src/package.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Fri Sep 10 17:02:16 2010
@@ -1,3 +1,9 @@
+2010-09-10  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-corner.lisp (generate-present-body): New macro.
+	(present-clfswm-terminal, present-virtual-keyboard): Use
+	generate-present-body.
+
 2010-09-09  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (update-menus): Follow XDG specifications

Modified: clfswm/src/clfswm-corner.lisp
==============================================================================
--- clfswm/src/clfswm-corner.lisp	(original)
+++ clfswm/src/clfswm-corner.lisp	Fri Sep 10 17:02:16 2010
@@ -110,35 +110,50 @@
   t)
 
 
-(defun present-virtual-keyboard ()
-  "Present a virtual keyboard"
-  (stop-button-event)
-  (do-shell (if *vt-keyboard-on*
-		*virtual-keyboard-kill-cmd*
-		*virtual-keyboard-cmd*))
-  (setf *vt-keyboard-on* (not *vt-keyboard-on*))
-  t)
+
+(defun find-window-in-query-tree (target-win)
+  (dolist (win (xlib:query-tree *root*))
+    (when (child-equal-p win target-win)
+      (return t))))
+
+(defun wait-window-in-query-tree (wait-test)
+  (loop
+     (dolist (win (xlib:query-tree *root*))
+       (when (funcall wait-test win)
+	 (return-from wait-window-in-query-tree win)))))
+
+
+(defmacro generate-present-body (cmd wait-test win &optional focus-p)
+  `(progn
+     (stop-button-event)
+     (unless (find-window-in-query-tree ,win)
+       (do-shell ,cmd)
+       (setf ,win (wait-window-in-query-tree ,wait-test))
+       (hide-window ,win))
+     (cond ((window-hidden-p ,win) (unhide-window ,win)
+	    (when ,focus-p
+	      (focus-window ,win))
+	    (raise-window ,win))
+	   (t (hide-window ,win)
+	      (show-all-children nil)))
+     t))
+
+
+(let (win)
+  (defun present-virtual-keyboard ()
+    "Present a virtual keyboard"
+    (generate-present-body *virtual-keyboard-cmd*
+			   (lambda (win)
+			     (string-equal (xlib:get-wm-class win) "xvkbd"))
+			   win)))
 
 
-(defun present-clfswm-terminal ()
-  "Hide/Unhide a terminal"
-  (labels ((find-clfswm-terminal ()
-	     (dolist (win (xlib:query-tree *root*))
-	       (when (child-equal-p win *clfswm-terminal*)
-		 (return t)))))
-    (stop-button-event)
-    (unless (find-clfswm-terminal)
-      (do-shell *clfswm-terminal-cmd*)
-      (loop :with done = nil :until done
-	 :do (dolist (win (xlib:query-tree *root*))
-	       (when (string-equal (xlib:wm-name win) *clfswm-terminal-name*)
-		 (setf *clfswm-terminal* win
-		       done t))))
-      (hide-window *clfswm-terminal*))
-    (cond ((window-hidden-p *clfswm-terminal*) (unhide-window *clfswm-terminal*)
-	   (focus-window *clfswm-terminal*)
-	   (raise-window *clfswm-terminal*))
-	  (t (hide-window *clfswm-terminal*)
-	     (show-all-children nil)))
-    t))
+(let (win)
+  (defun present-clfswm-terminal ()
+    "Hide/Unhide a terminal"
+    (generate-present-body *clfswm-terminal-cmd*
+			   (lambda (win)
+			     (string-equal (xlib:wm-name win) *clfswm-terminal-name*))
+			   win
+			   t)))
 

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Fri Sep 10 17:02:16 2010
@@ -135,7 +135,7 @@
      (format t "Ignoring XLib asynchronous error: ~s~%" error-key))
     ((eq error-key 'xlib:access-error)
      (write-line "Another window manager is running.")
-     (throw :exit-clfswm nil))
+     (throw 'exit-clfswm nil))
      ;; all other asynchronous errors are printed.
      (asynchronous
       (format t "Caught Asynchronous X Error: ~s ~s" error-key key-vals))
@@ -179,7 +179,6 @@
 					    :depth (xlib:screen-root-depth *screen*)
 					    :drawable *root*)
 	*in-second-mode* nil
-	*clfswm-terminal* nil
 	*vt-keyboard-on* nil)
   (init-modifier-list)
   (xgrab-init-pointer)

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Fri Sep 10 17:02:16 2010
@@ -185,8 +185,7 @@
 (defparameter *in-second-mode* nil)
 
 
-(defparameter *vt-keyboard-on* nil)
-(defparameter *clfswm-terminal* nil)
+;;(defparameter *vt-keyboard-on* nil)  PHIL here
 
 
 ;;; Placement variables. A list of two absolute coordinates