[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-24-g9a295e7

Philippe Brochard pbrochard at common-lisp.net
Wed Apr 18 19:52:04 UTC 2012


This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  9a295e721720d5e8485e9bd10ebd049627f9b1b1 (commit)
      from  8f23f83012bba1b87afea860370fd5eaed2e869c (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 9a295e721720d5e8485e9bd10ebd049627f9b1b1
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Mon Apr 16 23:41:59 2012 +0200

    src/clfswm-corner.lisp (wait-window-in-query-tree): Add a limit of try to wait the command window.

diff --git a/ChangeLog b/ChangeLog
index 123bd91..b1ba271 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-04-16  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-corner.lisp (wait-window-in-query-tree): Add a limit
+	of try to wait the command window.
+
 2012-02-25  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (place-frames-from-xrandr)
diff --git a/src/clfswm-corner.lisp b/src/clfswm-corner.lisp
index 9ec9ca1..2e50f7a 100644
--- a/src/clfswm-corner.lisp
+++ b/src/clfswm-corner.lisp
@@ -76,15 +76,17 @@ stop the button event"
 ;;; CONFIG - Corner actions definitions:  ;;;
 ;;;***************************************;;;
 (defun find-window-in-query-tree (target-win)
-  (dolist (win (xlib:query-tree *root*))
-    (when (child-equal-p win target-win)
-      (return t))))
+  (when 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
+  (dotimes (try *corner-command-try-number*)
      (dolist (win (xlib:query-tree *root*))
        (when (funcall wait-test win)
-	 (return-from wait-window-in-query-tree win)))))
+	 (return-from wait-window-in-query-tree win)))
+     (sleep *corner-command-try-delay*)))
 
 
 (defun generic-present-body (cmd wait-test win &optional focus-p)
@@ -92,15 +94,21 @@ stop the button event"
   (unless (find-window-in-query-tree win)
     (do-shell cmd)
     (setf win (wait-window-in-query-tree wait-test))
-    (grab-all-buttons win)
-    (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)))
+    (if win
+        (progn
+          (grab-all-buttons win)
+          (hide-window win))
+        (notify-message *corner-error-message-delay*
+                        (list (format nil "Error with command ~S" cmd)
+                              *corner-error-message-color*))))
+  (when 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))))
   win)
 
 
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 024f823..06af769 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -1598,11 +1598,16 @@ For window: set current child to window or its parent according to window-parent
 	  (refresh-notify-window)
 	  (xlib:display-finish-output *display*))))))
 
+(defun notify-message (delay &rest messages)
+  (erase-timer :close-notify-window)
+  (funcall #'open-notify-window messages)
+  (add-timer delay #'close-notify-window :close-notify-window))
+
 
 (defun display-hello-window ()
-  (open-notify-window '(("Welcome to CLFSWM" "yellow")
-			"Press Alt+F1 for help"))
-  (add-timer *notify-window-delay* #'close-notify-window))
+  (notify-message *notify-window-delay*
+                  '("Welcome to CLFSWM" "yellow")
+                  "Press Alt+F1 for help"))
 
 
 ;;; Run or raise functions
diff --git a/src/config.lisp b/src/config.lisp
index 163becf..a7481ce 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -151,7 +151,14 @@ You can tweak this to what you want"
   'Corner "The clfswm terminal command.
 This command must set the window title to *clfswm-terminal-name*")
 
-
+(defconfig *corner-error-message-color* "red"
+  'Corner "Error message color")
+(defconfig *corner-error-message-delay* 5
+  'Corner "Time to display the error message on commad error")
+(defconfig *corner-command-try-delay* 0.2
+  'Corner "Time to wait before checking window in query tree")
+(defconfig *corner-command-try-number* 10
+  'Corner "Number of try to wait the window in query tree")
 
 
 ;;; Hook definitions

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog              |    5 +++++
 src/clfswm-corner.lisp |   36 ++++++++++++++++++++++--------------
 src/clfswm-util.lisp   |   11 ++++++++---
 src/config.lisp        |    9 ++++++++-
 4 files changed, 43 insertions(+), 18 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager




More information about the clfswm-cvs mailing list