[clfswm-cvs] r78 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Thu Apr 17 14:32:47 UTC 2008
Author: pbrochard
Date: Thu Apr 17 10:32:43 2008
New Revision: 78
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/src/bindings-second-mode.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/package.lisp
Log:
Move the size computation outside the show-child part. Redisplay only the current child when needed. More TODO things
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Thu Apr 17 10:32:43 2008
@@ -1,3 +1,20 @@
+2008-04-17 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-internal.lisp (add-frame): Add frame return the
+ created frame.
+ (show-all-children): Move the size computation outside the
+ show-child part.
+
+ * src/bindings-second-mode.lisp (with-movement): Redisplay only
+ the current child.
+
+ * src/clfswm-util.lisp (mouse-click-to-focus-generic): Redisplay
+ only the current child.
+
+ * src/clfswm-internal.lisp (show-all-children): New display-child
+ parameter to display only the desired child and its children.
+ (select-next/previous-child): Only display the current child.
+
2008-04-14 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm.lisp (init-display): Move the default frame creation
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Thu Apr 17 10:32:43 2008
@@ -7,9 +7,9 @@
===============
Should handle these soon.
-- Add a show-all-children without recomputation of geometry (ie: use real coordinates
- and redisplay only the wanted child). *** REALLY URGENT ***
- Split computation of geometry outside of show-all-children. [Philippe]
+- Rethink the menu system to be able to change/add/remove entry. [Philippe]
+
+- Add a frame parameter to choose what window type to handle. [Philippe]
- Hook to open next window in named/numbered frame [Philippe]
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Thu Apr 17 10:32:43 2008
@@ -99,7 +99,7 @@
(defmacro with-movement (&body body)
`(when (frame-p *current-child*)
, at body
- (show-all-children)
+ (show-all-children *current-child*)
(draw-second-mode-window)
(frame-movement-menu)))
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Thu Apr 17 10:32:43 2008
@@ -221,7 +221,8 @@
(defun add-frame (frame father)
- (push frame (frame-child father)))
+ (push frame (frame-child father))
+ frame)
(defun place-frame (frame father prx pry prw prh)
@@ -365,18 +366,20 @@
(defmethod adapt-child-to-father ((window xlib:window) father)
(with-xlib-protect
- (multiple-value-bind (nx ny nw nh raise-p)
- (get-father-layout window father)
- (setf nw (max nw 1) nh (max nh 1))
- (let ((change (or (/= (xlib:drawable-x window) nx)
- (/= (xlib:drawable-y window) ny)
- (/= (xlib:drawable-width window) nw)
- (/= (xlib:drawable-height window) nh))))
- (setf (xlib:drawable-x window) nx
- (xlib:drawable-y window) ny
- (xlib:drawable-width window) nw
- (xlib:drawable-height window) nh)
- (values raise-p change)))))
+ (if (eql (window-type window) :normal)
+ (multiple-value-bind (nx ny nw nh raise-p)
+ (get-father-layout window father)
+ (setf nw (max nw 1) nh (max nh 1))
+ (let ((change (or (/= (xlib:drawable-x window) nx)
+ (/= (xlib:drawable-y window) ny)
+ (/= (xlib:drawable-width window) nw)
+ (/= (xlib:drawable-height window) nh))))
+ (setf (xlib:drawable-x window) nx
+ (xlib:drawable-y window) ny
+ (xlib:drawable-width window) nw
+ (xlib:drawable-height window) nh)
+ (values raise-p change)))
+ (values nil nil))))
(defmethod adapt-child-to-father ((frame frame) father)
(with-xlib-protect
@@ -405,34 +408,22 @@
(and (eql raise-p :first-only) first-p))
(raise-window window)))
-(defgeneric show-child (child father first-p))
+(defgeneric show-child (child raise-p first-p))
-(defmethod show-child ((frame frame) father first-p)
+(defmethod show-child ((frame frame) raise-p first-p)
(with-xlib-protect
(with-slots (window) frame
- (multiple-value-bind (raise-p geometry-change)
- (adapt-child-to-father frame father)
(when (or *show-root-frame-p* (not (equal frame *current-root*)))
(setf (xlib:window-background window) (get-color "Black"))
(xlib:map-window window)
(raise-if-needed window raise-p first-p)
- (display-frame-info frame))
- geometry-change))))
+ (display-frame-info frame)))))
-(defmethod show-child ((window xlib:window) father first-p)
+(defmethod show-child ((window xlib:window) raise-p first-p)
(with-xlib-protect
- (let ((raise-p nil)
- (geometry-change nil))
- (when (eql (window-type window) :normal)
- (multiple-value-bind (to-raise change)
- (adapt-child-to-father window father)
- (setf raise-p to-raise
- geometry-change change)))
(xlib:map-window window)
- (raise-if-needed window raise-p first-p)
- geometry-change)))
-
+ (raise-if-needed window raise-p first-p)))
(defgeneric hide-child (child))
@@ -484,19 +475,24 @@
-(defun show-all-children ()
- "Show all children from *current-root*"
+(defun show-all-children (&optional (display-child *current-root*))
+ "Show all children from *current-root*. Start the effective display
+only for display-child and its children"
(let ((geometry-change nil))
- (labels ((rec (root father first-p first-father)
- (when (show-child root father first-p)
- (setf geometry-change t))
+ (labels ((rec (root father first-p first-father display-p)
+ (multiple-value-bind (raise-p change)
+ (adapt-child-to-father root father)
+ (when change (setf geometry-change change))
+ (when display-p
+ (show-child root raise-p first-p)))
(select-child root (if (equal root *current-child*) t
(if (and first-p first-father) :maybe nil)))
(when (frame-p root)
(let ((first-child (first (frame-child root))))
(dolist (child (reverse (frame-child root)))
- (rec child root (equal child first-child) first-p))))))
- (rec *current-root* nil t t)
+ (rec child root (equal child first-child) first-p
+ (or display-p (equal root display-child))))))))
+ (rec *current-root* nil t t (equal display-child *current-root*))
(set-focus-to-current-child)
geometry-change)))
@@ -565,7 +561,7 @@
(when (frame-p *current-child*)
(with-slots (child) *current-child*
(setf child (funcall fun-rotate child)))
- (show-all-children)))
+ (show-all-children *current-child*)))
(defun select-next-child ()
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Thu Apr 17 10:32:43 2008
@@ -523,8 +523,7 @@
(xlib:display-finish-output *display*)
(xlib:process-event *display* :handler #'handle-event))))
(setf (frame-x frame) (x-px->fl (xlib:drawable-x window) father)
- (frame-y frame) (y-px->fl (xlib:drawable-y window) father))
- (show-all-children)))))
+ (frame-y frame) (y-px->fl (xlib:drawable-y window) father))))))
(defun resize-frame (frame father orig-x orig-y)
@@ -565,8 +564,7 @@
(xlib:display-finish-output *display*)
(xlib:process-event *display* :handler #'handle-event))))
(setf (frame-w frame) (w-px->fl (xlib:drawable-width window) father)
- (frame-h frame) (h-px->fl (xlib:drawable-height window) father))
- (show-all-children)))))
+ (frame-h frame) (h-px->fl (xlib:drawable-height window) father))))))
@@ -593,7 +591,7 @@
(when child
(funcall mouse-fn child father root-x root-y)))
(when (and child father (focus-all-children child father))
- (when (show-all-children)
+ (when (show-all-children *current-child*)
(setf to-replay nil))))
(if to-replay
(replay-button-event)
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Thu Apr 17 10:32:43 2008
@@ -133,7 +133,7 @@
(let ((frame (add-frame (create-frame :name "Default"
:layout nil :x 0.05 :y 0.05
:w 0.9 :h 0.9) *root-frame*)))
- (setf *current-child* (first (frame-child *current-root*)))))
+ (setf *current-child* frame)))
(defparameter *init-hook* #'default-init-hook)
More information about the clfswm-cvs
mailing list