[clfswm-cvs] r79 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Fri Apr 18 20:55:29 UTC 2008
Author: pbrochard
Date: Fri Apr 18 16:55:26 2008
New Revision: 79
Modified:
clfswm/ChangeLog
clfswm/src/bindings-second-mode.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-layout.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
Log:
Display-child is the first child by default -> less flickering. Solve a bug with father-p in show-all-children.
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Fri Apr 18 16:55:26 2008
@@ -1,3 +1,8 @@
+2008-04-18 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-internal.lisp (show-all-children): Display-child is
+ the first child by default. Solve a bug with father-p.
+
2008-04-17 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-internal.lisp (add-frame): Add frame return the
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Fri Apr 18 16:55:26 2008
@@ -99,7 +99,7 @@
(defmacro with-movement (&body body)
`(when (frame-p *current-child*)
, at body
- (show-all-children *current-child*)
+ (show-all-children) ;; PLOP
(draw-second-mode-window)
(frame-movement-menu)))
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Fri Apr 18 16:55:26 2008
@@ -196,7 +196,7 @@
(defun frame-find-free-number ()
(let ((all-numbers nil))
(with-all-frames (*root-frame* frame)
- (push (frame-number frame) all-numbers))
+ (pushnew (frame-number frame) all-numbers))
(find-free-number all-numbers)))
@@ -461,6 +461,10 @@
(defun select-current-frame (selected)
(select-child *current-child* selected))
+(defun unselect-all-frames ()
+ (with-all-children (*current-root* child)
+ (select-child child nil)))
+
(defun set-focus-to-current-child ()
@@ -475,7 +479,7 @@
-(defun show-all-children (&optional (display-child *current-root*))
+(defun show-all-children (&optional (display-child *current-child*))
"Show all children from *current-root*. Start the effective display
only for display-child and its children"
(let ((geometry-change nil))
@@ -490,7 +494,7 @@
(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 child root (equal child first-child) (and first-p first-father)
(or display-p (equal root display-child))))))))
(rec *current-root* nil t t (equal display-child *current-root*))
(set-focus-to-current-child)
@@ -512,6 +516,63 @@
+
+
+(defun focus-child (child father)
+ "Focus child - Return true if something has change"
+ (when (and (frame-p father)
+ (member child (frame-child father)))
+ (when (not (equal child (first (frame-child father))))
+ (loop until (equal child (first (frame-child father)))
+ do (setf (frame-child father) (rotate-list (frame-child father))))
+ t)))
+
+(defun focus-child-rec (child father)
+ "Focus child and its fathers - Return true if something has change"
+ (let ((change nil))
+ (labels ((rec (child father)
+ (when (focus-child child father)
+ (setf change t))
+ (when father
+ (rec father (find-father-frame father)))))
+ (rec child father))
+ change))
+
+
+(defun set-current-child-generic (child)
+ (unless (equal *current-child* child)
+ (setf *current-child* child)
+ t))
+
+(defgeneric set-current-child (child father window-father))
+
+(defmethod set-current-child ((child xlib:window) father window-father)
+ (set-current-child-generic (if window-father father child)))
+
+(defmethod set-current-child ((child frame) father window-father)
+ (declare (ignore father window-father))
+ (set-current-child-generic child))
+
+
+(defun set-current-root (father)
+ "Set current root if father is not in current root"
+ (unless (find-child father *current-root*)
+ (setf *current-root* father)))
+
+
+(defun focus-all-children (child father &optional (window-father t))
+ "Focus child and its fathers -
+For window: set current child to window or its father according to window-father"
+ (let ((new-focus (focus-child-rec child father))
+ (new-current-child (set-current-child child father window-father))
+ (new-root (set-current-root father)))
+ (or new-focus new-current-child new-root)))
+
+
+
+
+
+
(defun select-next/previous-brother (fun-rotate)
"Select the next/previous brother frame"
(let ((frame-is-root? (and (equal *current-root* *current-child*)
@@ -526,7 +587,7 @@
(setf *current-child* (first child)))))
(when frame-is-root?
(setf *current-root* *current-child*))
- (show-all-children)))
+ (show-all-children *current-root*))) ;; PLOP
(defun select-next-brother ()
@@ -559,9 +620,10 @@
(defun select-next/previous-child (fun-rotate)
"Select the next/previous child"
(when (frame-p *current-child*)
+ (unselect-all-frames)
(with-slots (child) *current-child*
(setf child (funcall fun-rotate child)))
- (show-all-children *current-child*)))
+ (show-all-children))) ;; PLOP
(defun select-next-child ()
@@ -578,7 +640,7 @@
"Enter in the selected frame - ie make it the root frame"
(hide-all *current-root*)
(setf *current-root* *current-child*)
- (show-all-children))
+ (show-all-children *current-root*)) ;; PLOP
(defun leave-frame ()
"Leave the selected frame - ie make its father the root frame"
@@ -586,7 +648,7 @@
(awhen (find-father-frame *current-root*)
(when (frame-p it)
(setf *current-root* it)))
- (show-all-children))
+ (show-all-children *current-root*)) ;; PLOP
(defun switch-to-root-frame (&key (show-later nil))
@@ -594,7 +656,7 @@
(hide-all *current-root*)
(setf *current-root* *root-frame*)
(unless show-later
- (show-all-children)))
+ (show-all-children *current-root*))) ;; PLOP
(defun switch-and-select-root-frame (&key (show-later nil))
"Switch and select the root frame"
@@ -602,66 +664,14 @@
(setf *current-root* *root-frame*)
(setf *current-child* *current-root*)
(unless show-later
- (show-all-children)))
+ (show-all-children *current-root*))) ;; PLOP
(defun toggle-show-root-frame ()
"Show/Hide the root frame"
(hide-all *current-root*)
(setf *show-root-frame-p* (not *show-root-frame-p*))
- (show-all-children))
-
-
-(defun focus-child (child father)
- "Focus child - Return true if something has change"
- (when (and (frame-p father)
- (member child (frame-child father)))
- (when (not (equal child (first (frame-child father))))
- (loop until (equal child (first (frame-child father)))
- do (setf (frame-child father) (rotate-list (frame-child father))))
- t)))
-
-(defun focus-child-rec (child father)
- "Focus child and its fathers - Return true if something has change"
- (let ((change nil))
- (labels ((rec (child father)
- (when (focus-child child father)
- (setf change t))
- (when father
- (rec father (find-father-frame father)))))
- (rec child father))
- change))
-
-
-(defun set-current-child-generic (child)
- (unless (equal *current-child* child)
- (setf *current-child* child)
- t))
-
-(defgeneric set-current-child (child father window-father))
-
-(defmethod set-current-child ((child xlib:window) father window-father)
- (set-current-child-generic (if window-father father child)))
-
-(defmethod set-current-child ((child frame) father window-father)
- (declare (ignore father window-father))
- (set-current-child-generic child))
-
-
-(defun set-current-root (father)
- "Set current root if father is not in current root"
- (unless (find-child father *current-root*)
- (setf *current-root* father)))
-
-
-(defun focus-all-children (child father &optional (window-father t))
- "Focus child and its fathers -
-For window: set current child to window or its father according to window-father"
- (let ((new-focus (focus-child-rec child father))
- (new-current-child (set-current-child child father window-father))
- (new-root (set-current-root father)))
- (or new-focus new-current-child new-root)))
-
+ (show-all-children *current-root*)) ;; PLOP
(defun remove-child-in-frame (child frame)
Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp (original)
+++ clfswm/src/clfswm-layout.lisp Fri Apr 18 16:55:26 2008
@@ -68,7 +68,7 @@
(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)
+ (show-all-children *current-root*)
(fixe-real-size-current-child)
(set-layout-dont-leave #'no-layout))))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Fri Apr 18 16:55:26 2008
@@ -591,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 *current-child*)
+ (when (show-all-children) ;; PLOP
(setf to-replay nil))))
(if to-replay
(replay-button-event)
@@ -714,7 +714,7 @@
(setf *current-root* (aref key-slots current-slot)
*current-child* *current-root*)
(focus-all-children *current-child* *current-child*)
- (show-all-children))
+ (show-all-children *current-root*)) ;; PLOP
(defun bind-or-jump (n)
"Bind or jump to a slot"
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Fri Apr 18 16:55:26 2008
@@ -219,7 +219,7 @@
*current-child* *current-root*)
(call-hook *init-hook*)
(process-existing-windows *screen*)
- (show-all-children)
+ (show-all-children *current-root*)
(grab-main-keys)
(xlib:display-finish-output *display*))
More information about the clfswm-cvs
mailing list