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

[pbrochard at common-lisp.net]

Author: pbrochard
Date: Mon Apr  7 17:38:41 2008
New Revision: 71

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-layout.lisp
   clfswm/src/clfswm-nw-hooks.lisp
   clfswm/src/clfswm.lisp
Log:
Set the layout only one time and revert to no-layout to freely handle frames. Apply this with open-in-new-frame-in-root-frame-nw-hook


Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Mon Apr  7 17:38:41 2008
@@ -1,3 +1,17 @@
+2008-04-07  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/bindings-second-mode.lisp (frame-layout-once-menu): Set the
+	layout only one time and revert to no-layout to freely handle
+	frames.
+
+	* src/clfswm-nw-hooks.lisp
+	(open-in-new-frame-in-root-frame-nw-hook): Tile layout with spaces
+	with new created window.
+
+	* src/clfswm-layout.lisp (register-layout): Now register
+	automatically a once layout to set the layout only one time and
+	revert to no-layout to freely handle frames.
+
 2008-04-05  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-nw-hooks.lisp (leave-focus-frame-nw-hook): New

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Mon Apr  7 17:38:41 2008
@@ -11,6 +11,8 @@
   and redisplay only the wanted child).  *** REALLY URGENT ***
   Split computation of geometry outside of show-all-children. [Philippe]
 
+- Rethink the keysym part with shift+1/!.
+
 - Hook to open next window in named/numbered frame [Philippe]
 
 - Undo/redo (any idea to implement this is welcome)

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Mon Apr  7 17:38:41 2008
@@ -47,6 +47,11 @@
   "Frame layout menu"
   (info-mode-menu (keys-from-list *layout-list*)))
 
+(defun frame-layout-once-menu ()
+  "Frame layout menu (Set only once)"
+  (info-mode-menu (keys-from-list (loop :for l :in *layout-list*
+				     :collect (create-symbol (format nil "~A" l) "-ONCE")))))
+
 (defun frame-nw-hook-menu ()
   "Frame new window hook menu"
   (info-mode-menu (keys-from-list *nw-hook-list*)))
@@ -220,6 +225,7 @@
   "Frame menu"
   (info-mode-menu '((#\a frame-adding-menu)
 		    (#\l frame-layout-menu)
+		    (#\o frame-layout-once-menu)
 		    (#\n frame-nw-hook-menu)
 		    (#\m frame-movement-menu)
 		    (#\r rename-current-child)

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Mon Apr  7 17:38:41 2008
@@ -236,6 +236,23 @@
 	  w (w-px->fl prw father)
 	  h (h-px->fl prh father))))
 
+(defun fixe-real-size (frame father)
+  "Fixe real (pixel) coordinates in float coordinates"
+  (when (frame-p frame)
+    (with-slots (x y w h rx ry rw rh) frame
+      (setf x (x-px->fl rx father)
+	    y (y-px->fl ry father)
+	    w (w-px->fl rw father)
+	    h (h-px->fl rh father)))))
+
+(defun fixe-real-size-current-child ()
+  "Fixe real (pixel) coordinates in float coordinates for children in the current child"
+  (when (frame-p *current-child*)
+    (dolist (child (frame-child *current-child*))
+      (fixe-real-size child *current-child*))))
+
+
+
 
 
 (defun find-child (to-find root)

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Mon Apr  7 17:38:41 2008
@@ -47,6 +47,11 @@
     (setf (frame-layout *current-child*) layout)
     (leave-second-mode)))
 
+(defun set-layout-dont-leave (layout)
+  "Set the layout of the current child"
+  (when (frame-p *current-child*)
+    (setf (frame-layout *current-child*) layout)))
+
 
 (defun get-managed-child (father)
   "Return only window in normal mode who can be tiled"
@@ -55,8 +60,26 @@
 		   (and (xlib:window-p x) (not (eql (window-type x) :normal))))
 	       (frame-child father))))
 
-(defun register-layout (layout)
-  (setf *layout-list* (append *layout-list* (list layout))))
+
+
+
+(defmacro register-layout (layout)
+  `(progn
+     (setf *layout-list* (append *layout-list* (list ',layout)))
+     (defun ,(intern (format nil "~A-ONCE" layout)) ()
+       (set-layout-dont-leave #',(intern (subseq (format nil "~A" layout) 4)))
+       (show-all-children)
+       (fixe-real-size-current-child)
+       (set-layout-dont-leave #'no-layout))))
+
+
+(defun set-layout-once-documentation ()
+  (loop :for l :in *layout-list*
+     :do (setf (documentation (create-symbol (format nil "~A" l) "-ONCE") 'function)
+	       (documentation l 'function))))
+
+
+
 
 (defun layout-ask-size (msg slot &optional (min 80))
   (when (frame-p *current-child*)
@@ -91,7 +114,7 @@
   "Maximize windows in there frame - leave frame to there size (no layout)"
   (set-layout #'no-layout))
 
-(register-layout 'set-no-layout)
+(register-layout set-no-layout)
 
 
 
@@ -117,7 +140,7 @@
   "Tile child in its frame"
   (set-layout #'tile-layout))
 
-(register-layout 'set-tile-layout)
+(register-layout set-tile-layout)
 
 
 ;;; Tile Left
@@ -149,7 +172,7 @@
   (layout-ask-size "Tile size in percent (%)" :tile-size)
   (set-layout #'tile-left-layout))
 
-(register-layout 'set-tile-left-layout)
+(register-layout set-tile-left-layout)
 
 
 
@@ -183,7 +206,7 @@
   (set-layout #'tile-right-layout))
 
 
-(register-layout 'set-tile-right-layout)
+(register-layout set-tile-right-layout)
 
 
 
@@ -217,7 +240,7 @@
   (layout-ask-size "Tile size in percent (%)" :tile-size)
   (set-layout #'tile-top-layout))
 
-(register-layout 'set-tile-top-layout)
+(register-layout set-tile-top-layout)
 
 
 
@@ -252,7 +275,7 @@
   (set-layout #'tile-bottom-layout))
 
 
-(register-layout 'set-tile-bottom-layout)
+(register-layout set-tile-bottom-layout)
 
 
 
@@ -278,9 +301,9 @@
 	      (round (- dy (* dy size 2) 2))
 	      t))))
 
-(defun set-space-tile-layout ()
+(defun set-tile-space-layout ()
   "Tile Space: tile child in its frame leaving spaces between them"
   (layout-ask-size "Space size in percent (%)" :tile-space-size 10)
   (set-layout #'tile-space-layout))
 
-(register-layout 'set-space-tile-layout)
+(register-layout set-tile-space-layout)

Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp	(original)
+++ clfswm/src/clfswm-nw-hooks.lisp	Mon Apr  7 17:38:41 2008
@@ -120,6 +120,8 @@
     (pushnew new-frame (frame-child *root-frame*))
     (pushnew window (frame-child new-frame))
     (switch-to-root-frame)
+    (setf *current-child* *current-root*)
+    (set-tile-space-layout-once)
     (setf *current-child* new-frame)
     (default-window-placement new-frame window))
   (setf (frame-nw-hook frame) nil))

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Mon Apr  7 17:38:41 2008
@@ -217,6 +217,7 @@
 							      :pointer-motion))
   ;;(intern-atoms *display*)
   (netwm-set-properties)
+  (set-layout-once-documentation)
   (xlib:display-force-output *display*)
   (setf *child-selection* nil)
   (setf *root-frame* (create-frame :name "Root" :number 0) ;; :layout #'tile-space-layout)