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

[Philippe Brochard]

Author: pbrochard
Date: Wed Apr 13 18:24:28 2011
New Revision: 443

Log:
src/clfswm-menu.lisp (open-menu): Save info hash table keys instead of deleting newly created keys.

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-menu.lisp
   clfswm/src/clfswm-query.lisp
   clfswm/src/menu-def.lisp
   clfswm/src/tools.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed Apr 13 18:24:28 2011
@@ -1,3 +1,8 @@
+2011-04-14  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-menu.lisp (open-menu): Save info hash table keys
+	instead of deleting newly created keys.
+
 2011-03-21  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (x-px->fl, y-px->fl): Takes care of

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Wed Apr 13 18:24:28 2011
@@ -344,7 +344,6 @@
 	      (unless keyboard-grabbed-p
 		(xgrab-keyboard *root*))
 	      (wait-no-key-or-button-press)
-              (set-default-info-keys)
 	      (generic-mode 'info-mode 'exit-info-loop
 			    :loop-function (lambda ()
 					     (raise-window (info-window info)))
@@ -372,7 +371,8 @@
 Separator is a string or a symbol (all but a list)
 Function can be a function or a list (function color) for colored output"
   (let ((info-list nil)
-	(action nil))
+	(action nil)
+        (old-info-keys (copy-hash-table *info-keys*)))
     (labels ((define-key (key function)
 	       (define-info-key-fun (list key)
 		   (lambda (&optional args)
@@ -394,10 +394,7 @@
 		       (define-key key function)))))
 	  (t (push (list (format nil "-=- ~A -=-" item) *menu-color-comment*) info-list))))
       (let ((selected-item (info-mode (nreverse info-list) :width width :height height)))
-	(dolist (item item-list)
-	  (when (consp item)
-	    (let ((key (first item)))
-	      (undefine-info-key-fun (list key)))))
+        (setf *info-keys* old-info-keys)
 	(when selected-item
 	  (awhen (nth selected-item item-list)
 	    (when (consp it)

Modified: clfswm/src/clfswm-menu.lisp
==============================================================================
--- clfswm/src/clfswm-menu.lisp	(original)
+++ clfswm/src/clfswm-menu.lisp	Wed Apr 13 18:24:28 2011
@@ -139,7 +139,8 @@
 
 (defun open-menu (&optional (menu *menu*) (parent nil))
   "Open the main menu"
-  (let ((action nil))
+  (let ((action nil)
+        (old-info-keys (copy-hash-table *info-keys*)))
     (labels ((populate-menu ()
 	       (let ((info-list nil))
 		 (dolist (item (menu-item menu))
@@ -159,8 +160,7 @@
 			     (leave-info-mode nil))))))
 		 (nreverse info-list))))
       (let ((selected-item (info-mode (populate-menu))))
-	(dolist (item (menu-item menu))
-	  (undefine-info-key-fun (list (menu-item-key item))))
+        (setf *info-keys* old-info-keys)
 	(when selected-item
 	  (awhen (nth selected-item (menu-item menu))
 	    (setf action (menu-item-value it)))))

Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp	(original)
+++ clfswm/src/clfswm-query.lisp	Wed Apr 13 18:24:28 2011
@@ -315,7 +315,6 @@
     (unless grab-keyboard-p
       (ungrab-main-keys)
       (xgrab-keyboard *root*))
-    (set-default-query-keys)
     (generic-mode 'query-mode 'exit-query-loop
 		  :enter-function #'query-enter-function
 		  :loop-function #'query-loop-function

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Wed Apr 13 18:24:28 2011
@@ -107,33 +107,33 @@
 
 (add-sub-menu 'frame-movement-menu "p" 'frame-pack-menu "Frame pack menu")
 (add-sub-menu 'frame-movement-menu "f" 'frame-fill-menu "Frame fill menu")
-(add-sub-menu 'frame-movement-menu "z" 'frame-resize-menu "Frame resize menu")
+(add-sub-menu 'frame-movement-menu "r" 'frame-resize-menu "Frame resize menu")
 (add-menu-key 'frame-movement-menu "c" 'center-current-frame)
-(add-menu-key 'frame-movement-menu "r" 'with-movement-select-next-brother)
-(add-menu-key 'frame-movement-menu "l" 'with-movement-select-previous-brother)
-(add-menu-key 'frame-movement-menu "u" 'with-movement-select-next-level)
-(add-menu-key 'frame-movement-menu "d" 'with-movement-select-previous-level)
-(add-menu-key 'frame-movement-menu "t" 'with-movement-select-next-child)
-
-
-(add-menu-key 'frame-pack-menu "u" 'current-frame-pack-up)
-(add-menu-key 'frame-pack-menu "d" 'current-frame-pack-down)
-(add-menu-key 'frame-pack-menu "l" 'current-frame-pack-left)
-(add-menu-key 'frame-pack-menu "r" 'current-frame-pack-right)
-
-
-(add-menu-key 'frame-fill-menu "u" 'current-frame-fill-up)
-(add-menu-key 'frame-fill-menu "d" 'current-frame-fill-down)
-(add-menu-key 'frame-fill-menu "l" 'current-frame-fill-left)
-(add-menu-key 'frame-fill-menu "r" 'current-frame-fill-right)
+(add-menu-key 'frame-movement-menu "Right" 'with-movement-select-next-brother)
+(add-menu-key 'frame-movement-menu "Left" 'with-movement-select-previous-brother)
+(add-menu-key 'frame-movement-menu "Up" 'with-movement-select-next-level)
+(add-menu-key 'frame-movement-menu "Down" 'with-movement-select-previous-level)
+(add-menu-key 'frame-movement-menu "Tab" 'with-movement-select-next-child)
+
+
+(add-menu-key 'frame-pack-menu "Up" 'current-frame-pack-up)
+(add-menu-key 'frame-pack-menu "Down" 'current-frame-pack-down)
+(add-menu-key 'frame-pack-menu "Left" 'current-frame-pack-left)
+(add-menu-key 'frame-pack-menu "Right" 'current-frame-pack-right)
+
+
+(add-menu-key 'frame-fill-menu "Up" 'current-frame-fill-up)
+(add-menu-key 'frame-fill-menu "Down" 'current-frame-fill-down)
+(add-menu-key 'frame-fill-menu "Left" 'current-frame-fill-left)
+(add-menu-key 'frame-fill-menu "Right" 'current-frame-fill-right)
 (add-menu-key 'frame-fill-menu "a" 'current-frame-fill-all-dir)
 (add-menu-key 'frame-fill-menu "v" 'current-frame-fill-vertical)
 (add-menu-key 'frame-fill-menu "h" 'current-frame-fill-horizontal)
 
-(add-menu-key 'frame-resize-menu "u" 'current-frame-resize-up)
-(add-menu-key 'frame-resize-menu "d" 'current-frame-resize-down)
-(add-menu-key 'frame-resize-menu "l" 'current-frame-resize-left)
-(add-menu-key 'frame-resize-menu "r" 'current-frame-resize-right)
+(add-menu-key 'frame-resize-menu "Up" 'current-frame-resize-up)
+(add-menu-key 'frame-resize-menu "Down" 'current-frame-resize-down)
+(add-menu-key 'frame-resize-menu "Left" 'current-frame-resize-left)
+(add-menu-key 'frame-resize-menu "Right" 'current-frame-resize-right)
 (add-menu-key 'frame-resize-menu "a" 'current-frame-resize-all-dir)
 (add-menu-key 'frame-resize-menu "m" 'current-frame-resize-all-dir-minimal)
 

Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp	(original)
+++ clfswm/src/tools.lisp	Wed Apr 13 18:24:28 2011
@@ -35,6 +35,8 @@
            :config-all-groups
            :config-group->string
 	   :find-in-hash
+           :view-hash-table
+           :copy-hash-table
 	   :nfuncall
 	   :pfuncall
 	   :symbol-search
@@ -170,6 +172,19 @@
 	   hashtable))
 
 
+(defun view-hash-table (title hashtable)
+  (maphash (lambda (k v)
+             (format t "[~A] ~A ~A~%" title k v))
+           hashtable))
+
+(defun copy-hash-table (hashtable)
+  (let ((rethash (make-hash-table :test (hash-table-test hashtable))))
+    (maphash (lambda (k v)
+               (setf (gethash k rethash) v))
+             hashtable)
+    rethash))
+
+
 (defun nfuncall (function)
   (when function
     (funcall function)))