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

[pbrochard at common-lisp.net]

Author: pbrochard
Date: Wed May 28 17:55:15 2008
New Revision: 137

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-menu.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/menu-def.lisp
   clfswm/src/package.lisp
Log:
hide-current-child, unhide-a-child, unhide-all-children: New functions. info-mode-menu: Handle symbols and functions.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed May 28 17:55:15 2008
@@ -1,5 +1,11 @@
 2008-05-28  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-util.lisp (hide-current-child, unhide-a-child)
+	(unhide-all-children): New functions.
+
+	* src/clfswm-info.lisp (info-mode-menu): Handle symbols and
+	functions.
+
 	* src/clfswm-util.lisp (hide/show-frame-window): new function and
 	menu item.
 

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Wed May 28 17:55:15 2008
@@ -9,8 +9,6 @@
 
 - Use conpressed motion events for clisp. [Philippe]
 
-- cd/pwd a la shell to navigate throw frames. [Philippe] 
-
 - Hide/Unhide child [Philippe]
 
 - Raise/lower child - this can be done with children order [Philippe]
@@ -28,6 +26,8 @@
 MAYBE
 =====
 
+- cd/pwd a la shell to navigate throw frames. [Philippe] 
+
 - From stumpwm: [Philippe]
  "In other news stumpwm should catch unhandled errors, restart, and
  print an error message. And there is now a soft-restart command. With
@@ -51,3 +51,4 @@
 - Remote access to the clfswm REPL [Philippe]
 
 - Undo/redo (any idea to implement this is welcome)
+

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Wed May 28 17:55:15 2008
@@ -290,8 +290,10 @@
     (dolist (item item-list)
       (let ((key (first item)))
 	(undefine-info-key-fun (list key 0))))
-    (when (fboundp action)
-      (funcall action))))
+    (typecase action
+      (function (funcall action))
+      (symbol (when (fboundp action)
+		(funcall action))))))
 
 
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Wed May 28 17:55:15 2008
@@ -354,7 +354,7 @@
 
 (defun display-frame-info (frame)
   (let ((dy (+ (xlib:max-char-ascent *default-font*) (xlib:max-char-descent *default-font*))))
-    (with-slots (name number gc window child) frame
+    (with-slots (name number gc window child hidden-children) frame
       (clear-pixmap-buffer window gc)
       (setf (xlib:gcontext-foreground gc) (get-color (if (and (equal frame *current-root*)
 							      (equal frame *current-child*))
@@ -377,8 +377,11 @@
 				    (frame (format str "frame:~A[~A] " (frame-number child)
 						   (aif (frame-name child) it "")))))))))
 	(dolist (ch child)
-	  (when (xlib:window-p ch)
-	    (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch))))))
+	  (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy) (ensure-printable (child-fullname ch))))
+	(setf (xlib:gcontext-foreground gc) (get-color "DarkGreen"))
+	(dolist (ch hidden-children)
+	  (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy)
+			    (format nil "~A - hidden" (ensure-printable (child-fullname ch))))))
       (copy-pixmap-buffer window gc))))
 
 

Modified: clfswm/src/clfswm-menu.lisp
==============================================================================
--- clfswm/src/clfswm-menu.lisp	(original)
+++ clfswm/src/clfswm-menu.lisp	Wed May 28 17:55:15 2008
@@ -119,4 +119,3 @@
       (t (when (fboundp action)
 	   (funcall action))))))
 
-      
\ No newline at end of file

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Wed May 28 17:55:15 2008
@@ -961,3 +961,48 @@
   "Show the current frame window"
   (hide/show-frame-window *current-child* t))
 
+
+
+;;; Hide/Unhide current child
+(defun hide-current-child ()
+  "Hide the current child"
+  (let ((parent (find-parent-frame *current-child*)))
+    (when (frame-p parent)
+      (with-slots (child hidden-children) parent
+	(hide-all *current-child*)
+	(setf child (remove *current-child* child))
+	(pushnew *current-child* hidden-children)
+	(setf *current-child* parent))
+      (show-all-children)))
+  (leave-second-mode))
+
+
+(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
+			 :collect (list (code-char (+ (char-code #\a) i))
+					(let ((hd h))
+					  (lambda ()
+					    (setf hidden-children (remove hd hidden-children))
+					    (pushnew hd child)))
+					(format nil "Unhide ~A" (child-fullname h))))))
+    (show-all-children))
+  (leave-second-mode))
+
+
+(defun unhide-all-children ()
+  "Unhide all current frame hidden children"
+  (when (frame-p *current-child*)
+    (with-slots (child hidden-children) *current-child*
+      (dolist (c hidden-children)
+	(pushnew c child))
+      (setf hidden-children nil))
+    (show-all-children))
+  (leave-second-mode))
+
+
+
+    

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Wed May 28 17:55:15 2008
@@ -75,6 +75,9 @@
 (add-menu-key 'child-menu "r" 'rename-current-child)
 (add-menu-key 'child-menu "x" 'remove-current-child-from-tree)
 (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 "a" 'unhide-all-children)
 
 
 (add-sub-menu 'frame-menu "a" 'frame-adding-menu "Adding frame menu")

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Wed May 28 17:55:15 2008
@@ -100,8 +100,8 @@
 			  :initform nil
 			  :documentation "A list of forced unmanaged windows (wm-name or window)")
    (show-window-p :initarg :show-window-p :accessor frame-show-window-p :initform t)
-   (hidden-list :initarg :hidden-list :accessor frame-hidden-list :initform nil
-		:documentation "A list of hidden children")
+   (hidden-children :initarg :hidden-children :accessor frame-hidden-children :initform nil
+		    :documentation "A list of hidden children")
    (n-focused-child :initarg :n-focused-child :accessor frame-n-focused-child :initform 0
 		    :documentation "A number to choose which child to focus")
    (window :initarg :window :accessor frame-window :initform nil)