[clfswm-cvs] r71 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Mon Apr 7 21:38:44 UTC 2008
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)
More information about the clfswm-cvs
mailing list