[clfswm-cvs] CVS clfswm

[pbrochard]

Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv25205

Modified Files:
	bindings-second-mode.lisp clfswm-internal.lisp 
	clfswm-util.lisp 
Log Message:
Do action on *current-child* and not on (get-current-child) (ie: the focused child)

--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/27 22:34:55	1.14
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/28 20:36:26	1.15
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Feb 27 21:08:44 2008
+;;; #Date#: Thu Feb 28 21:30:15 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse for second mode
@@ -108,6 +108,17 @@
 		    (#\m group-movement-menu))))
 
 
+
+(defun selection-menu ()
+  "Selection menu"
+  (info-mode-menu '((#\x cut-current-child)
+		    (#\c copy-current-child)
+		    (#\v paste-selection)
+		    (#\p paste-selection-no-clear)
+		    ("Delete" remove-current-child)
+		    (#\z clear-selection))))
+
+
 (defun utility-menu ()
   "Utility menu"
   (info-mode-menu '((#\i identify-key)
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/27 22:34:55	1.16
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/28 20:36:26	1.17
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Feb 27 22:23:42 2008
+;;; #Date#: Thu Feb 28 21:18:23 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -396,11 +396,11 @@
 
 
 
-(defun hide-all-groups (root)
+(defun hide-all-childs (root)
   (hide-child root)
   (when (group-p root)
     (dolist (child (group-child root))
-      (hide-all-groups child))))
+      (hide-all-childs child))))
 
 
 
@@ -410,7 +410,7 @@
   (let ((group-is-root? (and (equal *current-root* *current-child*)
 			     (not (equal *current-root* *root-group*)))))
     (if group-is-root?
-	(hide-all-groups *current-root*)
+	(hide-all-childs *current-root*)
 	(select-current-group nil))
     (let ((father (find-father-group *current-child*)))
       (when (group-p father)
@@ -468,13 +468,13 @@
 
 (defun enter-group ()
   "Enter in the selected group - ie make it the root group"
-  (hide-all-groups *current-root*)
+  (hide-all-childs *current-root*)
   (setf *current-root* *current-child*)
   (show-all-childs))
 
 (defun leave-group ()
   "Leave the selected group - ie make its father the root group"
-  (hide-all-groups *current-root*)
+  (hide-all-childs *current-root*)
   (awhen (find-father-group *current-root*)
     (when (group-p it)
       (setf *current-root* it)))
@@ -483,13 +483,13 @@
 
 (defun switch-to-root-group ()
   "Switch to the root group"
-  (hide-all-groups *current-root*)
+  (hide-all-childs *current-root*)
   (setf *current-root* *root-group*)
   (show-all-childs))
 
 (defun switch-and-select-root-group ()
   "Switch and select the root group"
-  (hide-all-groups *current-root*)
+  (hide-all-childs *current-root*)
   (setf *current-root* *root-group*)
   (setf *current-child* *current-root*)
   (show-all-childs))
@@ -497,7 +497,7 @@
 
 (defun toggle-show-root-group ()
   "Show/Hide the root group"
-  (hide-all-groups *current-root*)
+  (hide-all-childs *current-root*)
   (setf *show-root-group-p* (not *show-root-group-p*))
   (show-all-childs))
 
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/27 22:34:55	1.13
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/28 20:36:26	1.14
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Feb 27 21:09:58 2008
+;;; #Date#: Thu Feb 28 21:23:55 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -117,28 +117,23 @@
 
 (defun copy-current-child ()
   "Copy the current child to the selection"
-  (let ((child (get-current-child)))
-    (when child
-      (pushnew child *child-selection*)
-      (display-group-info *current-root*)
-      child)))
+  (pushnew *current-child* *child-selection*)
+  (display-group-info *current-root*))
+
 
 (defun cut-current-child ()
   "Cut the current child to the selection"
-  (let ((child (copy-current-child)))
-    (when child
-      (setf *current-child* *current-root*)
-      (hide-child child)
-      (remove-child-in-group child (find-father-group child *current-root*))
-      (show-all-childs))))
+  (copy-current-child)
+  (hide-all-childs *current-child*)
+  (remove-child-in-group *current-child* (find-father-group *current-child* *current-root*))
+  (setf *current-child* *current-root*)
+  (show-all-childs))
 
 (defun remove-current-child ()
   "Remove the current child from its father group"
-  (let ((child (get-current-child)))
-    (when child
-      (setf *current-child* *current-root*)
-      (hide-child child)
-      (remove-child-in-group child (find-father-group child *current-root*))))
+  (hide-all-childs *current-child*)
+  (remove-child-in-group *current-child* (find-father-group *current-child* *current-root*))
+  (setf *current-child* *current-root*)
   (leave-second-mode))
       
 
@@ -514,16 +509,16 @@
 
 (defun move-current-child-by-name ()
   "Move current child in a named group"
-  (let ((child (get-current-child)))
-    (move-current-child-by child (find-group-by-name
-				  (ask-group-name (format nil "Move '~A' to group" (child-name child))))))
+  (move-current-child-by *current-child*
+			 (find-group-by-name
+			  (ask-group-name (format nil "Move '~A' to group" (child-name *current-child*)))))
   (leave-second-mode))
 
 (defun move-current-child-by-number ()
   "Move current child in a numbered group"
-  (let ((child (get-current-child)))
-    (move-current-child-by child (find-group-by-number
-				  (query-number (format nil "Move '~A' to group numbered:" (child-name child))))))
+  (move-current-child-by *current-child*
+			 (find-group-by-number
+			  (query-number (format nil "Move '~A' to group numbered:" (child-name *current-child*)))))
   (leave-second-mode))
 
 
@@ -535,16 +530,16 @@
 
 (defun copy-current-child-by-name ()
   "Copy current child in a named group"
-  (let ((child (get-current-child)))
-    (copy-current-child-by child (find-group-by-name
-				  (ask-group-name (format nil "Copy '~A' to group" (child-name child))))))
+  (copy-current-child-by *current-child*
+			 (find-group-by-name
+			  (ask-group-name (format nil "Copy '~A' to group" (child-name *current-child*)))))
   (leave-second-mode))
 
 (defun copy-current-child-by-number ()
   "Copy current child in a numbered group"
-  (let ((child (get-current-child)))
-    (copy-current-child-by child (find-group-by-number
-				  (query-number (format nil "Copy '~A' to group numbered:" (child-name child))))))
+  (copy-current-child-by *current-child*
+			 (find-group-by-number
+			  (query-number (format nil "Copy '~A' to group numbered:" (child-name *current-child*)))))
   (leave-second-mode))