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

[pbrochard at common-lisp.net]

Author: pbrochard
Date: Fri May 30 16:41:37 2008
New Revision: 139

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/menu-def.lisp
Log:
unhide-a-child-from-all-frames: Unhide a child from a choice in all frames with hidden children. info-mode-menu: Handle separators.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Fri May 30 16:41:37 2008
@@ -1,3 +1,10 @@
+2008-05-30  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (unhide-a-child-from-all-frames): Unhide a
+	child from a choice in all frames with hidden children.
+
+	* src/clfswm-info.lisp (info-mode-menu): Handle separators.
+
 2008-05-28  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (hide-current-child, unhide-a-child)

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Fri May 30 16:41:37 2008
@@ -271,25 +271,29 @@
 
 (defun info-mode-menu (item-list &key (x 0) (y 0) (width nil) (height nil))
   "Open an info help menu.
-Item-list is: '((key function) (key function))
+Item-list is: '((key function) separator (key function))
 or with explicit docstring: '((key function \"documentation 1\") (key function \"bla bla\") (key function)) 
-key is a character, a keycode or a keysym"
+key is a character, a keycode or a keysym
+Separator is a string or a symbol (all but a list)"
   (let ((info-list nil)
 	(action nil))
     (dolist (item item-list)
-      (destructuring-bind (key function explicit-doc) (ensure-n-elems item 3)
-	(push (format nil "~@(~A~): ~A" key (or explicit-doc
-						(documentation function 'function)))
-	      info-list)
-	(define-info-key-fun (list key 0)
-	    (lambda (&optional args)
-	      (declare (ignore args))
-	      (setf action function)
-	      (throw 'exit-info-loop nil)))))
+      (typecase item
+	(cons (destructuring-bind (key function explicit-doc) (ensure-n-elems item 3)
+		(push (format nil "~@(~A~): ~A" key (or explicit-doc
+							(documentation function 'function)))
+		      info-list)
+		(define-info-key-fun (list key 0)
+		    (lambda (&optional args)
+		      (declare (ignore args))
+		      (setf action function)
+		      (throw 'exit-info-loop nil)))))
+	(t (push (format nil "-=- ~A -=-" item) info-list))))
     (info-mode (nreverse info-list) :x x :y y :width width :height height)
     (dolist (item item-list)
-      (let ((key (first item)))
-	(undefine-info-key-fun (list key 0))))
+      (when (consp item)
+	(let ((key (first item)))
+	  (undefine-info-key-fun (list key 0)))))
     (typecase action
       (function (funcall action))
       (symbol (when (fboundp action)

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Fri May 30 16:41:37 2008
@@ -977,18 +977,26 @@
   (leave-second-mode))
 
 
+(defun frame-unhide-child (hidden frame-src frame-dest)
+  "Unhide a hidden child from frame-src in frame-dest"
+  (with-slots (hidden-children) frame-src
+    (setf hidden-children (remove hidden hidden-children)))
+  (with-slots (child) frame-dest
+    (pushnew hidden child)))
+  
+
+
 (defun unhide-a-child ()
   "Unhide a child in the current frame"
   (when (frame-p *current-child*)
     (with-slots (child hidden-children) *current-child*
       (info-mode-menu (loop :for i :from 0
-			 :for h :in hidden-children
+			 :for hidden :in hidden-children
 			 :collect (list (code-char (+ (char-code #\a) i))
-					(let ((hd h))
+					(let ((lhd hidden))
 					  (lambda ()
-					    (setf hidden-children (remove hd hidden-children))
-					    (pushnew hd child)))
-					(format nil "Unhide ~A" (child-fullname h))))))
+					    (frame-unhide-child lhd *current-child* *current-child*)))
+					(format nil "Unhide ~A" (child-fullname hidden))))))
     (show-all-children))
   (leave-second-mode))
 
@@ -1004,5 +1012,26 @@
   (leave-second-mode))
 
 
+(defun unhide-a-child-from-all-frames ()
+  "Unhide a child from all frames in the current frame"
+  (when (frame-p *current-child*)
+    (let ((acc nil)
+	  (keynum -1))
+      (with-all-frames (*root-frame* frame)
+	(when (frame-hidden-children frame)
+	  (push (format nil "~A" (child-fullname frame)) acc)
+	  (dolist (hidden (frame-hidden-children frame))
+	    (push (list (code-char (+ (char-code #\a) (incf keynum)))
+			(let ((lhd hidden))
+			  (lambda ()
+			    (frame-unhide-child lhd frame *current-child*)))
+			(format nil "Unhide ~A" (child-fullname hidden)))
+		  acc))))
+      (info-mode-menu (nreverse acc)))
+    (show-all-children))
+  (leave-second-mode))
+
+
+
 
     

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Fri May 30 16:41:37 2008
@@ -77,6 +77,7 @@
 (add-menu-key 'child-menu "Delete" 'remove-current-child)
 (add-menu-key 'child-menu "h" 'hide-current-child)
 (add-menu-key 'child-menu "u" 'unhide-a-child)
+(add-menu-key 'child-menu "f" 'unhide-a-child-from-all-frames)
 (add-menu-key 'child-menu "a" 'unhide-all-children)