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

[pbrochard at common-lisp.net]

Author: pbrochard
Date: Tue Apr 22 15:42:15 2008
New Revision: 82

Modified:
   clfswm/ChangeLog
   clfswm/clfswm.asd
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/clfswm-second-mode.lisp
   clfswm/src/clfswm-util.lisp
Log:
Move with-movement, current-frame-fill/pack/resize-* from bindings-second-mode.lisp to clfswm-util.lisp.


Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Apr 22 15:42:15 2008
@@ -2,6 +2,9 @@
 
 	* src/clfswm-util.lisp (identify-key): Show the documentation for
 	the function bound on a key.
+	(with-movement): Move with-movement,
+	current-frame-fill/pack/resize-*  from bindings-second-mode.lisp
+	to clfswm-util.lisp.
 
 	* src/clfswm-menu.lisp: New menu system that let user change keys
 	or functions associated to keys.

Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd	(original)
+++ clfswm/clfswm.asd	Tue Apr 22 15:42:15 2008
@@ -38,8 +38,10 @@
 			  :depends-on ("package" "clfswm-internal"))
 			 (:file "clfswm-info"
 			  :depends-on ("package" "version" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"))
+			 (:file "clfswm-menu"
+			  :depends-on ("package" "clfswm-info"))
 			 (:file "clfswm-util"
-			  :depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query"))
+			  :depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query" "clfswm-menu"))
 			 (:file "clfswm-query"
 			  :depends-on ("package" "config"))
 			 (:file "clfswm-layout"
@@ -48,8 +50,6 @@
 			  :depends-on ("clfswm" "clfswm-util" "clfswm-second-mode"))
 			 (:file "clfswm-nw-hooks"
 			  :depends-on ("package" "clfswm-util" "clfswm-info"))
-			 (:file "clfswm-menu"
-			  :depends-on ("package" "clfswm-info"))
 			 (:file "bindings"
 			  :depends-on ("clfswm" "clfswm-internal" "clfswm-util"))
 			 (:file "bindings-second-mode"

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Tue Apr 22 15:42:15 2008
@@ -60,106 +60,6 @@
 
 
 
-
-(defmacro with-movement (&body body)
-  `(when (frame-p *current-child*)
-     , at body
-     (show-all-children)
-     (draw-second-mode-window)
-     (open-menu (find-menu 'frame-movement-menu))))
-
-
-;;; Pack
-(defun current-frame-pack-up ()
-  "Pack the current frame up"
-  (with-movement (pack-frame-up *current-child* (find-father-frame *current-child* *current-root*))))
-
-(defun current-frame-pack-down ()
-  "Pack the current frame down"
-  (with-movement (pack-frame-down *current-child* (find-father-frame *current-child* *current-root*))))
-
-(defun current-frame-pack-left ()
-  "Pack the current frame left"
-  (with-movement (pack-frame-left *current-child* (find-father-frame *current-child* *current-root*))))
-
-(defun current-frame-pack-right ()
-  "Pack the current frame right"
-  (with-movement (pack-frame-right *current-child* (find-father-frame *current-child* *current-root*))))
-
-;;; Center
-(defun center-current-frame ()
-  "Center the current frame"
-  (with-movement (center-frame *current-child*)))
-
-;;; Fill
-(defun current-frame-fill-up ()
-  "Fill the current frame up"
-  (with-movement (fill-frame-up *current-child* (find-father-frame *current-child* *current-root*))))
-
-(defun current-frame-fill-down ()
-  "Fill the current frame down"
-  (with-movement (fill-frame-down *current-child* (find-father-frame *current-child* *current-root*))))
-
-(defun current-frame-fill-left ()
-  "Fill the current frame left"
-  (with-movement (fill-frame-left *current-child* (find-father-frame *current-child* *current-root*))))
-
-(defun current-frame-fill-right ()
-  "Fill the current frame right"
-  (with-movement (fill-frame-right *current-child* (find-father-frame *current-child* *current-root*))))
-
-(defun current-frame-fill-all-dir ()
-  "Fill the current frame in all directions"
-  (with-movement
-    (let ((father (find-father-frame *current-child* *current-root*)))
-      (fill-frame-up *current-child* father)
-      (fill-frame-down *current-child* father)
-      (fill-frame-left *current-child* father)
-      (fill-frame-right *current-child* father))))
-
-(defun current-frame-fill-vertical ()
-  "Fill the current frame vertically"
-  (with-movement
-    (let ((father (find-father-frame *current-child* *current-root*)))
-      (fill-frame-up *current-child* father)
-      (fill-frame-down *current-child* father))))
-
-(defun current-frame-fill-horizontal ()
-  "Fill the current frame horizontally"
-  (with-movement
-    (let ((father (find-father-frame *current-child* *current-root*)))
-      (fill-frame-left *current-child* father)
-      (fill-frame-right *current-child* father))))
-    
-
-;;; Resize
-(defun current-frame-resize-up ()
-  "Resize the current frame up to its half height"
-  (with-movement (resize-half-height-up *current-child*)))
-
-(defun current-frame-resize-down ()
-  "Resize the current frame down to its half height"
-  (with-movement (resize-half-height-down *current-child*)))
-
-(defun current-frame-resize-left ()
-  "Resize the current frame left to its half width"
-  (with-movement (resize-half-width-left *current-child*)))
-
-(defun current-frame-resize-right ()
-  "Resize the current frame right to its half width"
-  (with-movement (resize-half-width-right *current-child*)))
-
-(defun current-frame-resize-all-dir ()
-  "Resize down the current frame"
-  (with-movement (resize-frame-down *current-child*)))
-
-(defun current-frame-resize-all-dir-minimal ()
-  "Resize down the current frame to its minimal size"
-  (with-movement (resize-minimal-frame *current-child*)))
-
-
-
-
 (defun frame-layout-menu ()
   "< Frame layout menu >"
   (info-mode-menu (keys-from-list *layout-list*)))

Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp	(original)
+++ clfswm/src/clfswm-second-mode.lisp	Tue Apr 22 15:42:15 2008
@@ -215,7 +215,3 @@
   "Leave second mode"
   (banish-pointer)
   (throw 'exit-second-loop nil))
-
-
-
-

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Tue Apr 22 15:42:15 2008
@@ -736,3 +736,104 @@
 									       (child-fullname it)
 									       "Not set - Please, bind it with Return"))))
 			   (list default-bind))))))
+
+
+
+
+;;; Useful function for the second mode
+
+(defmacro with-movement (&body body)
+  `(when (frame-p *current-child*)
+     , at body
+     (show-all-children)
+     (draw-second-mode-window)
+     (open-menu (find-menu 'frame-movement-menu))))
+
+
+;;; Pack
+(defun current-frame-pack-up ()
+  "Pack the current frame up"
+  (with-movement (pack-frame-up *current-child* (find-father-frame *current-child* *current-root*))))
+
+(defun current-frame-pack-down ()
+  "Pack the current frame down"
+  (with-movement (pack-frame-down *current-child* (find-father-frame *current-child* *current-root*))))
+
+(defun current-frame-pack-left ()
+  "Pack the current frame left"
+  (with-movement (pack-frame-left *current-child* (find-father-frame *current-child* *current-root*))))
+
+(defun current-frame-pack-right ()
+  "Pack the current frame right"
+  (with-movement (pack-frame-right *current-child* (find-father-frame *current-child* *current-root*))))
+
+;;; Center
+(defun center-current-frame ()
+  "Center the current frame"
+  (with-movement (center-frame *current-child*)))
+
+;;; Fill
+(defun current-frame-fill-up ()
+  "Fill the current frame up"
+  (with-movement (fill-frame-up *current-child* (find-father-frame *current-child* *current-root*))))
+
+(defun current-frame-fill-down ()
+  "Fill the current frame down"
+  (with-movement (fill-frame-down *current-child* (find-father-frame *current-child* *current-root*))))
+
+(defun current-frame-fill-left ()
+  "Fill the current frame left"
+  (with-movement (fill-frame-left *current-child* (find-father-frame *current-child* *current-root*))))
+
+(defun current-frame-fill-right ()
+  "Fill the current frame right"
+  (with-movement (fill-frame-right *current-child* (find-father-frame *current-child* *current-root*))))
+
+(defun current-frame-fill-all-dir ()
+  "Fill the current frame in all directions"
+  (with-movement
+    (let ((father (find-father-frame *current-child* *current-root*)))
+      (fill-frame-up *current-child* father)
+      (fill-frame-down *current-child* father)
+      (fill-frame-left *current-child* father)
+      (fill-frame-right *current-child* father))))
+
+(defun current-frame-fill-vertical ()
+  "Fill the current frame vertically"
+  (with-movement
+    (let ((father (find-father-frame *current-child* *current-root*)))
+      (fill-frame-up *current-child* father)
+      (fill-frame-down *current-child* father))))
+
+(defun current-frame-fill-horizontal ()
+  "Fill the current frame horizontally"
+  (with-movement
+    (let ((father (find-father-frame *current-child* *current-root*)))
+      (fill-frame-left *current-child* father)
+      (fill-frame-right *current-child* father))))
+    
+
+;;; Resize
+(defun current-frame-resize-up ()
+  "Resize the current frame up to its half height"
+  (with-movement (resize-half-height-up *current-child*)))
+
+(defun current-frame-resize-down ()
+  "Resize the current frame down to its half height"
+  (with-movement (resize-half-height-down *current-child*)))
+
+(defun current-frame-resize-left ()
+  "Resize the current frame left to its half width"
+  (with-movement (resize-half-width-left *current-child*)))
+
+(defun current-frame-resize-right ()
+  "Resize the current frame right to its half width"
+  (with-movement (resize-half-width-right *current-child*)))
+
+(defun current-frame-resize-all-dir ()
+  "Resize down the current frame"
+  (with-movement (resize-frame-down *current-child*)))
+
+(defun current-frame-resize-all-dir-minimal ()
+  "Resize down the current frame to its minimal size"
+  (with-movement (resize-minimal-frame *current-child*)))