From pbrochard at common-lisp.net Wed Apr 18 19:52:04 2012 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Wed, 18 Apr 2012 12:52:04 -0700 Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-24-g9a295e7 Message-ID: This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager". The branch, master has been updated via 9a295e721720d5e8485e9bd10ebd049627f9b1b1 (commit) from 8f23f83012bba1b87afea860370fd5eaed2e869c (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 9a295e721720d5e8485e9bd10ebd049627f9b1b1 Author: Philippe Brochard Date: Mon Apr 16 23:41:59 2012 +0200 src/clfswm-corner.lisp (wait-window-in-query-tree): Add a limit of try to wait the command window. diff --git a/ChangeLog b/ChangeLog index 123bd91..b1ba271 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-04-16 Philippe Brochard + + * src/clfswm-corner.lisp (wait-window-in-query-tree): Add a limit + of try to wait the command window. + 2012-02-25 Philippe Brochard * src/clfswm-util.lisp (place-frames-from-xrandr) diff --git a/src/clfswm-corner.lisp b/src/clfswm-corner.lisp index 9ec9ca1..2e50f7a 100644 --- a/src/clfswm-corner.lisp +++ b/src/clfswm-corner.lisp @@ -76,15 +76,17 @@ stop the button event" ;;; CONFIG - Corner actions definitions: ;;; ;;;***************************************;;; (defun find-window-in-query-tree (target-win) - (dolist (win (xlib:query-tree *root*)) - (when (child-equal-p win target-win) - (return t)))) + (when target-win + (dolist (win (xlib:query-tree *root*)) + (when (child-equal-p win target-win) + (return t))))) (defun wait-window-in-query-tree (wait-test) - (loop + (dotimes (try *corner-command-try-number*) (dolist (win (xlib:query-tree *root*)) (when (funcall wait-test win) - (return-from wait-window-in-query-tree win))))) + (return-from wait-window-in-query-tree win))) + (sleep *corner-command-try-delay*))) (defun generic-present-body (cmd wait-test win &optional focus-p) @@ -92,15 +94,21 @@ stop the button event" (unless (find-window-in-query-tree win) (do-shell cmd) (setf win (wait-window-in-query-tree wait-test)) - (grab-all-buttons win) - (hide-window win)) - (cond ((window-hidden-p win) - (unhide-window win) - (when focus-p - (focus-window win)) - (raise-window win)) - (t (hide-window win) - (show-all-children))) + (if win + (progn + (grab-all-buttons win) + (hide-window win)) + (notify-message *corner-error-message-delay* + (list (format nil "Error with command ~S" cmd) + *corner-error-message-color*)))) + (when win + (cond ((window-hidden-p win) + (unhide-window win) + (when focus-p + (focus-window win)) + (raise-window win)) + (t (hide-window win) + (show-all-children)))) win) diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp index 024f823..06af769 100644 --- a/src/clfswm-util.lisp +++ b/src/clfswm-util.lisp @@ -1598,11 +1598,16 @@ For window: set current child to window or its parent according to window-parent (refresh-notify-window) (xlib:display-finish-output *display*)))))) +(defun notify-message (delay &rest messages) + (erase-timer :close-notify-window) + (funcall #'open-notify-window messages) + (add-timer delay #'close-notify-window :close-notify-window)) + (defun display-hello-window () - (open-notify-window '(("Welcome to CLFSWM" "yellow") - "Press Alt+F1 for help")) - (add-timer *notify-window-delay* #'close-notify-window)) + (notify-message *notify-window-delay* + '("Welcome to CLFSWM" "yellow") + "Press Alt+F1 for help")) ;;; Run or raise functions diff --git a/src/config.lisp b/src/config.lisp index 163becf..a7481ce 100644 --- a/src/config.lisp +++ b/src/config.lisp @@ -151,7 +151,14 @@ You can tweak this to what you want" 'Corner "The clfswm terminal command. This command must set the window title to *clfswm-terminal-name*") - +(defconfig *corner-error-message-color* "red" + 'Corner "Error message color") +(defconfig *corner-error-message-delay* 5 + 'Corner "Time to display the error message on commad error") +(defconfig *corner-command-try-delay* 0.2 + 'Corner "Time to wait before checking window in query tree") +(defconfig *corner-command-try-number* 10 + 'Corner "Number of try to wait the window in query tree") ;;; Hook definitions ----------------------------------------------------------------------- Summary of changes: ChangeLog | 5 +++++ src/clfswm-corner.lisp | 36 ++++++++++++++++++++++-------------- src/clfswm-util.lisp | 11 ++++++++--- src/config.lisp | 9 ++++++++- 4 files changed, 43 insertions(+), 18 deletions(-) hooks/post-receive -- CLFSWM - A(nother) Common Lisp FullScreen Window Manager From pbrochard at common-lisp.net Wed Apr 18 20:35:47 2012 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Wed, 18 Apr 2012 13:35:47 -0700 Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-25-gdc020bc Message-ID: This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager". The branch, master has been updated via dc020bc9d3df37ce55936bbe4f18d9ad0bde4f42 (commit) from 9a295e721720d5e8485e9bd10ebd049627f9b1b1 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit dc020bc9d3df37ce55936bbe4f18d9ad0bde4f42 Author: Philippe Brochard Date: Wed Apr 18 22:35:42 2012 +0200 src/tools.lisp (add-new-hook, add-hook): New macro. Do not duplicate hooks by default. Use add-new-hook if you want to duplicate them. diff --git a/ChangeLog b/ChangeLog index b1ba271..68af51b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-04-18 Philippe Brochard + + * src/tools.lisp (add-new-hook, add-hook): New macro. Do not + duplicate hooks by default. Use add-new-hook if you want to + duplicate them. + 2012-04-16 Philippe Brochard * src/clfswm-corner.lisp (wait-window-in-query-tree): Add a limit diff --git a/TODO b/TODO index 89275af..e615c5c 100644 --- a/TODO +++ b/TODO @@ -7,13 +7,14 @@ URGENT PROBLEMS =============== Should handle these soon. --> Nothing here yet. FOR THE NEXT RELEASE ==================== -- Implement a save/restore root-frame system. And use it on error reset. +- Implement a save/restore root-frame system. And use it on error reset or for undo/redo. + +- Add a modeline in contrib/ MAYBE ===== diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp index 06af769..553cdfb 100644 --- a/src/clfswm-util.lisp +++ b/src/clfswm-util.lisp @@ -1661,8 +1661,8 @@ For window: set current child to window or its parent according to window-parent (with-current-window (decf (child-transparency window) 0.1))) -;;; Multiple physical screen helper +;;; Multiple physical screen helper (defun get-xrandr-connected-size () (let ((output (do-shell "xrandr")) (sizes '())) diff --git a/src/tools.lisp b/src/tools.lisp index f4587f1..63678d0 100644 --- a/src/tools.lisp +++ b/src/tools.lisp @@ -42,6 +42,7 @@ :symbol-search :create-symbol :create-symbol-in-package :call-hook + :add-new-hook :add-hook :remove-hook :clear-timers @@ -232,15 +233,25 @@ Return the result of the last hook" result))) -(defmacro add-hook (hook &rest value) +(defmacro add-new-hook (hook &rest value) + "Add a hook. Duplicate it if needed" `(setf ,hook (append (typecase ,hook (list ,hook) (t (list ,hook))) (list , at value)))) +(defmacro add-hook (hook &rest value) + "Add a hook only if not duplicated" + (let ((i (gensym))) + `(dolist (,i (list , at value) ,hook) + (unless (member ,i (typecase ,hook + (list ,hook) + (t (list ,hook)))) + (add-new-hook ,hook ,i))))) + (defmacro remove-hook (hook &rest value) (let ((i (gensym))) - `(dolist (,i (list , at value)) + `(dolist (,i (list , at value) ,hook) (setf ,hook (remove ,i ,hook))))) ----------------------------------------------------------------------- Summary of changes: ChangeLog | 6 ++++++ TODO | 5 +++-- src/clfswm-util.lisp | 2 +- src/tools.lisp | 15 +++++++++++++-- 4 files changed, 23 insertions(+), 5 deletions(-) hooks/post-receive -- CLFSWM - A(nother) Common Lisp FullScreen Window Manager From pbrochard at common-lisp.net Mon Apr 30 20:39:16 2012 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Mon, 30 Apr 2012 13:39:16 -0700 Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-31-g4f9a389 Message-ID: This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager". The branch, master has been updated via 4f9a389cc04f1ed6358b1b7d782b4eceb045452d (commit) via f53a1ad3bbffb633bd9d94bd35d16142e2cd74d2 (commit) via f28ae04ded1d40b5229de45228c9127a984953f7 (commit) via 0f9c05ecad39ded0dbbc94e068a118aae919b7c7 (commit) via a1d04c54489f341f4762921fa361a5c26d55bfea (commit) via d04fb387dad72bd36f0b2501027fe6797c33db66 (commit) from dc020bc9d3df37ce55936bbe4f18d9ad0bde4f42 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 4f9a389cc04f1ed6358b1b7d782b4eceb045452d Author: Philippe Brochard Date: Mon Apr 30 22:34:59 2012 +0200 src/clfswm-internal.lisp: TODO update diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp index 7e10483..d99ea03 100644 --- a/src/clfswm-internal.lisp +++ b/src/clfswm-internal.lisp @@ -616,6 +616,8 @@ ;;; Multiple roots support (replace the old *current-root* variable) (let ((root-list nil) (original-root-list nil)) + ;; TODO: Add find-root-by-coordinates, change-root-geometry + (defun define-as-root (child x y width height) (push (make-root :child child :x x :y y :w width :h height) root-list) (push (make-root :child child :x x :y y :w width :h height) original-root-list)) commit f53a1ad3bbffb633bd9d94bd35d16142e2cd74d2 Author: Philippe Brochard Date: Mon Apr 30 22:26:06 2012 +0200 src/config.lisp: Do not use get-fullscreen-size anymore diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp index 3dbe83c..7e10483 100644 --- a/src/clfswm-internal.lisp +++ b/src/clfswm-internal.lisp @@ -838,16 +838,17 @@ (defun get-parent-layout (child parent) (aif (child-root-p child) - ;;(values-list (rest (child-root-p child))) - (values (root-x it) (root-y it) (root-w it) (root-h it)) - (if (or (frame-p child) (managed-window-p child parent)) - (if (frame-p parent) - (aif (frame-layout parent) - (funcall it child parent) - (no-layout child parent)) - (get-fullscreen-size)) - (values (x-drawable-x child) (x-drawable-y child) - (x-drawable-width child) (x-drawable-height child))))) + (values (root-x it) (root-y it) (root-w it) (root-h it)) + (if (or (frame-p child) (managed-window-p child parent)) + (if (frame-p parent) + (aif (frame-layout parent) + (funcall it child parent) + (no-layout child parent)) + (values (- *border-size*) (- *border-size*) + (xlib:screen-width *screen*) + (xlib:screen-height *screen*))) + (values (x-drawable-x child) (x-drawable-y child) + (x-drawable-width child) (x-drawable-height child))))) diff --git a/src/config.lisp b/src/config.lisp index a7481ce..253b037 100644 --- a/src/config.lisp +++ b/src/config.lisp @@ -73,18 +73,6 @@ A list of (list match-function handle-function)") "Delay to display the new child after doing a spatial move") -;;; CONFIG - Screen size -(defun get-fullscreen-size () - "Return the size of root child (values rx ry rw rh) -You can tweak this to what you want" - (values (- *border-size*) (- *border-size*) - (xlib:screen-width *screen*) - (xlib:screen-height *screen*))) - ;;(values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*))) -;; (values -1 -1 1024 768)) -;; (values 100 100 800 600)) - - (defconfig *corner-size* 3 'Corner "The size of the corner square") commit f28ae04ded1d40b5229de45228c9127a984953f7 Author: Philippe Brochard Date: Mon Apr 30 22:16:36 2012 +0200 src/clfswm-internal.lisp: Adapt prevent-current-*-equal-child diff --git a/ChangeLog b/ChangeLog index 68af51b..eb14f2c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-04-30 Philippe Brochard + + * src/clfswm-internal.lisp: Big change to replace *current-root* + variable to support multiple root. + 2012-04-18 Philippe Brochard * src/tools.lisp (add-new-hook, add-hook): New macro. Do not diff --git a/clfswm.asd b/clfswm.asd index c908b3f..c11942d 100644 --- a/clfswm.asd +++ b/clfswm.asd @@ -7,7 +7,7 @@ (defsystem clfswm :description "CLFSWM: Fullscreen Window Manager" - :version "Please, see in src/version.lisp" + :version "1106" :author "Philippe Brochard " :licence "GNU Public License (GPL)" :components ((:module src diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp index 4e2c8e8..3dbe83c 100644 --- a/src/clfswm-internal.lisp +++ b/src/clfswm-internal.lisp @@ -1282,14 +1282,15 @@ For window: set current child to window or its parent according to window-parent (defun prevent-current-*-equal-child (child) " Prevent current-root and current-child equal to child" - (let* ((parent (find-parent-frame child)) - (parent-is-root-frame-p (child-equal-p parent *root-frame*))) - (when (and (child-root-p child) - (not parent-is-root-frame-p)) - (change-root child parent)) - (when (child-equal-p child *current-child*) - (setf *current-child* (find-current-root))) - (not parent-is-root-frame-p))) + (if (child-is-original-root-p child) + nil + (progn + (when (child-root-p child) + (change-root child (find-parent-frame child))) + (when (child-equal-p child *current-child*) + (setf *current-child* (find-current-root))) + t))) + (defun remove-child-in-frame (child frame) commit 0f9c05ecad39ded0dbbc94e068a118aae919b7c7 Author: Philippe Brochard Date: Mon Apr 30 21:24:46 2012 +0200 src/*: Use a structure instead of a list in root-list diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp index 442e742..c623e19 100644 --- a/src/clfswm-circulate-mode.lisp +++ b/src/clfswm-circulate-mode.lisp @@ -96,8 +96,8 @@ (setf (frame-child *circulate-parent*) (cons elem (child-remove elem *circulate-orig*)) (frame-selected-pos *circulate-parent*) 0 *current-child* (frame-selected-child *circulate-parent*)))) - (when (and (not (child-root *current-child*)) - (child-root old-child)) + (when (and (not (child-root-p *current-child*)) + (child-root-p old-child)) (change-root old-child *current-child*)))) (show-all-children t) (draw-circulate-mode-window))) @@ -294,7 +294,7 @@ (defun reorder-brother-simple (reorder-fun) - (unless (child-root *current-child*) + (unless (child-root-p *current-child*) (no-focus) (select-current-frame nil) (let ((parent-frame (find-parent-frame *current-child*))) @@ -318,7 +318,7 @@ ;;; Spatial move functions (defun select-brother-generic-spatial-move (fun-found) "Select the nearest brother of the current child based on the fun-found function" - (let ((is-root-p (child-root *current-child*))) + (let ((is-root-p (child-root-p *current-child*))) (when is-root-p (leave-frame) (sleep *spatial-move-delay-before*)) diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp index e962c70..eae9406 100644 --- a/src/clfswm-expose-mode.lisp +++ b/src/clfswm-expose-mode.lisp @@ -138,7 +138,7 @@ (defun expose-mode-display-accel-windows () (let ((n -1)) - (with-all-children-reversed (*current-root* child) + (with-all-children-reversed ((find-current-root) child) (if (or (frame-p child) (managed-window-p child (find-parent-frame child *root-frame*))) (when (< n 61) @@ -200,7 +200,7 @@ (defun expose-windows-mode () "Present all windows in the current frame (An expose like)" (stop-button-event) - (expose-windows-generic *current-root*)) + (expose-windows-generic (find-current-root))) (defun expose-all-windows-mode () "Present all windows in all frames (An expose like)" diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp index 47c6b71..4e2c8e8 100644 --- a/src/clfswm-internal.lisp +++ b/src/clfswm-internal.lisp @@ -617,41 +617,41 @@ (let ((root-list nil) (original-root-list nil)) (defun define-as-root (child x y width height) - (push (list child x y width height) root-list) - (setf original-root-list (copy-tree root-list))) + (push (make-root :child child :x x :y y :w width :h height) root-list) + (push (make-root :child child :x x :y y :w width :h height) original-root-list)) (defun all-root-child () (loop for root in root-list - collect (first root))) + collect (root-child root))) - (defun child-root (child) + (defun child-root-p (child) (dolist (root root-list) - (when (child-equal-p child (first root)) + (when (child-equal-p child (root-child root)) (return root)))) (defun change-root (old new) - (let ((root (child-root old))) + (let ((root (child-root-p old))) (when (and root new) - (setf (first root) new)))) + (setf (root-child root) new)))) (defun find-root (child) - (if (child-root child) + (if (child-root-p child) child (awhen (find-parent-frame child) (find-root it)))) (defun find-original-root (child) (dolist (root original-root-list) - (when (find-child child (first root)) + (when (find-child child (root-child root)) (return-from find-original-root root)))) (defun child-is-original-root-p (child) (dolist (root original-root-list) - (when (child-equal-p child (first root)) + (when (child-equal-p child (root-child root)) (return-from child-is-original-root-p t)))) (defun find-root-in-child (child) - (if (child-root child) + (if (child-root-p child) child (when (frame-p child) (dolist (c (frame-child child)) @@ -662,7 +662,7 @@ "Return a list of root in child" (let ((roots nil)) (labels ((rec (child) - (when (child-root child) + (when (child-root-p child) (push child roots)) (when (frame-p child) (dolist (c (frame-child child)) @@ -672,7 +672,7 @@ (defun find-child-in-all-root (child) (dolist (root root-list) - (when (find-child child (first root)) + (when (find-child child (root-child root)) (return-from find-child-in-all-root root)))) (defun only-one-root-in-p (child) @@ -683,7 +683,62 @@ (defun find-related-root (child) (or (find-root-in-child child) - (find-root-in-child (first (find-original-root child)))))) + (find-root-in-child (root-child (find-original-root child)))))) + + + +;;; Multiple physical screen helper +(defun get-xrandr-connected-size () + (let ((output (do-shell "xrandr")) + (sizes '())) + (loop for line = (read-line output nil nil) + while line + do + (awhen (search " connected " line) + (incf it (length " connected ")) + (destructuring-bind (w h x y) + (mapcar #'parse-integer + (split-string (substitute #\space #\x + (substitute #\space #\+ + (subseq line it (position #\space line :start it)))))) + (push (list (- x *border-size*) (- y *border-size*) w h) sizes)))) + (dbg sizes) + sizes)) + ;;'((10 10 500 300) (520 20 480 300) (310 330 600 250)))) ;;; For test + +(defun add-placed-frame-tmp (frame n) + (add-frame (create-frame :x 0.01 :y 0.01 :w 0.4 :h 0.4) frame) + (add-frame (create-frame :x 0.55 :y 0.01 :w 0.4 :h 0.4) frame) + (add-frame (create-frame :x 0.03 :y 0.5 :w 0.64 :h 0.44) frame) + (when (plusp n) + (add-placed-frame-tmp (first (frame-child frame)) (1- n)))) + + +(defun place-frames-from-xrandr () + "Place frames according to xrandr informations" + (let ((sizes (get-xrandr-connected-size)) + (width (xlib:screen-width *screen*)) + (height (xlib:screen-height *screen*))) + ;;(add-placed-frame-tmp (first (frame-child *root-frame*)) 2) + (if (<= (length sizes) 1) + (define-as-root *root-frame* (- *border-size*) (- *border-size*) width height) + (progn + (loop while (< (length (frame-child *root-frame*)) (length sizes)) + do (let ((frame (create-frame))) + (add-frame frame *root-frame*))) + ;;(add-placed-frame-tmp frame 2))) + (loop for size in sizes + for frame in (frame-child *root-frame*) + do (destructuring-bind (x y w h) size + (setf (frame-x frame) (float (/ x width)) + (frame-y frame) (float (/ y height)) + (frame-w frame) (float (/ w width)) + (frame-h frame) (float (/ h height))) + (add-frame (create-frame) frame) + (define-as-root frame x y w h))) + (setf *current-child* (first (frame-child (first (frame-child *root-frame*))))))))) + + (defun get-all-windows (&optional (root *root-frame*)) @@ -732,7 +787,7 @@ (setf (xlib:gcontext-background gc) (get-color *frame-background*) (xlib:window-background window) (get-color *frame-background*)) (clear-pixmap-buffer window gc) - (setf (xlib:gcontext-foreground gc) (get-color (if (and (child-root frame) + (setf (xlib:gcontext-foreground gc) (get-color (if (and (child-root-p frame) (child-equal-p frame *current-child*)) *frame-foreground-root* *frame-foreground*))) (xlib:draw-glyphs *pixmap-buffer* gc 5 dy @@ -740,7 +795,7 @@ number (if name (format nil " - ~A" name) ""))) (let ((pos dy)) - (when (child-root frame) + (when (child-root-p frame) (when *child-selection* (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy) (with-output-to-string (str) @@ -782,8 +837,9 @@ (defun get-parent-layout (child parent) - (if (child-root child) - (values-list (rest (child-root child))) + (aif (child-root-p child) + ;;(values-list (rest (child-root-p child))) + (values (root-x it) (root-y it) (root-w it) (root-h it)) (if (or (frame-p child) (managed-window-p child parent)) (if (frame-p parent) (aif (frame-layout parent) @@ -856,7 +912,7 @@ (declare (ignore parent)) (with-slots (window show-window-p) frame (if (and show-window-p - (or *show-root-frame-p* (not (child-root frame)))) + (or *show-root-frame-p* (not (child-root-p frame)))) (progn (map-window window) (set-child-stack-order window previous) @@ -1022,7 +1078,7 @@ (setf previous (child-rect-child rect))))) (rec (child parent selected-p in-current-root) - (let ((child-current-root-p (child-root child))) + (let ((child-current-root-p (child-root-p child))) (unless (in-displayed-list child) (set-geometry child parent in-current-root child-current-root-p)) (when (frame-p child) @@ -1031,7 +1087,7 @@ (not (in-displayed-list child))) (select-and-display child parent selected-p))))) - (rec *root-frame* nil t (child-root *root-frame*)) + (rec *root-frame* nil t (child-root-p *root-frame*)) (display-displayed-child) (dolist (child hidden-child) (hide-child child)) @@ -1102,7 +1158,7 @@ "Set current root if parent is not in current root" (let ((root (find-root child))) (when (and window-parent - (not (child-root child)) + (not (child-root-p child)) (not (find-child parent root))) (change-root root parent) t))) @@ -1129,7 +1185,7 @@ For window: set current child to window or its parent according to window-parent (defun select-previous-level () "Select the previous level in frame" - (unless (child-root *current-child*) + (unless (child-root-p *current-child*) (select-current-frame :maybe) (awhen (find-parent-frame *current-child*) (setf *current-child* it)) @@ -1204,13 +1260,13 @@ For window: set current child to window or its parent according to window-parent (defun switch-to-root-frame (&key (show-later nil)) "Switch to the root frame" - (change-root (find-root *current-child*) (first (find-original-root *current-child*))) + (change-root (find-root *current-child*) (root-child (find-original-root *current-child*))) (unless show-later (show-all-children t))) (defun switch-and-select-root-frame (&key (show-later nil)) "Switch and select the root frame" - (let ((new-root (first (find-original-root *current-child*)))) + (let ((new-root (root-child (find-original-root *current-child*)))) (change-root (find-root *current-child*) new-root) (setf *current-child* new-root)) (unless show-later @@ -1228,7 +1284,7 @@ For window: set current child to window or its parent according to window-parent " Prevent current-root and current-child equal to child" (let* ((parent (find-parent-frame child)) (parent-is-root-frame-p (child-equal-p parent *root-frame*))) - (when (and (child-root child) + (when (and (child-root-p child) (not parent-is-root-frame-p)) (change-root child parent)) (when (child-equal-p child *current-child*) diff --git a/src/clfswm-nw-hooks.lisp b/src/clfswm-nw-hooks.lisp index 0559843..99355a2 100644 --- a/src/clfswm-nw-hooks.lisp +++ b/src/clfswm-nw-hooks.lisp @@ -46,7 +46,6 @@ (let ((frame (if (xlib:window-p *current-child*) (find-parent-frame *current-child*) *current-child*))) - (dbg (child-is-original-root-p frame)) (unless (or (child-member frame *permanent-nw-hook-frames*) (child-is-original-root-p frame)) (setf (frame-nw-hook frame) hook) diff --git a/src/clfswm-pack.lisp b/src/clfswm-pack.lisp index 8dbabe0..cf525ef 100644 --- a/src/clfswm-pack.lisp +++ b/src/clfswm-pack.lisp @@ -240,7 +240,7 @@ (frame-w child) (w-px->fl (anti-adj-border-wh (x-drawable-width (frame-window child)) parent) parent) (frame-h child) (h-px->fl (anti-adj-border-wh (x-drawable-height (frame-window child)) parent) parent)))))) (defun move-frame-constrained (frame parent orig-x orig-y) - (when (and frame parent (not (child-root frame))) + (when (and frame parent (not (child-root-p frame))) (hide-all-children frame) (with-slots (window) frame (let ((lx orig-x) @@ -285,7 +285,7 @@ (defun resize-frame-constrained (frame parent orig-x orig-y) - (when (and frame parent (not (child-root frame))) + (when (and frame parent (not (child-root-p frame))) (hide-all-children frame) (with-slots (window) frame (let ((lx orig-x) diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp index e873ec2..1d48e55 100644 --- a/src/clfswm-util.lisp +++ b/src/clfswm-util.lisp @@ -118,7 +118,7 @@ (parent (find-parent-frame *current-child*))) (when (and parent (only-one-root-in-p parent)) (pushnew new-frame (frame-child parent)) - (when (child-root *current-child*) + (when (child-root-p *current-child*) (change-root *current-child* parent)) (setf *current-child* parent) (set-layout-once #'tile-space-layout) @@ -244,7 +244,7 @@ (defun cut-current-child (&optional (show-now t)) "Cut the current child to the selection" - (unless (child-root *current-child*) + (unless (child-root-p *current-child*) (let ((parent (find-parent-frame *current-child*))) (hide-all *current-child*) (copy-current-child) @@ -257,7 +257,7 @@ (defun remove-current-child () "Remove the current child from its parent frame" - (unless (child-root *current-child*) + (unless (child-root-p *current-child*) (let ((parent (find-parent-frame *current-child*))) (hide-all *current-child*) (remove-child-in-frame *current-child* (find-parent-frame *current-child* (find-current-root))) @@ -268,7 +268,7 @@ (defun delete-current-child () "Delete the current child and its children in all frames" - (unless (child-root *current-child*) + (unless (child-root-p *current-child*) (hide-all *current-child*) (delete-child-and-children-in-all-frames *current-child*) (show-all-children t) @@ -492,7 +492,7 @@ ;;; Delete by functions (defun delete-frame-by (frame) (unless (or (child-equal-p frame *root-frame*) - (child-root frame)) + (child-root-p frame)) (when (child-equal-p frame *current-child*) (setf *current-child* (find-current-root))) (remove-child-in-frame frame (find-parent-frame frame))) @@ -579,7 +579,7 @@ (defun move-frame (frame parent orig-x orig-y) - (when (and frame parent (not (child-root frame))) + (when (and frame parent (not (child-root-p frame))) (hide-all-children frame) (with-slots (window) frame (move-window window orig-x orig-y #'display-frame-info (list frame)) @@ -588,7 +588,7 @@ (show-all-children))) (defun resize-frame (frame parent orig-x orig-y) - (when (and frame parent (not (child-root frame))) + (when (and frame parent (not (child-root-p frame))) (hide-all-children frame) (with-slots (window) frame (resize-window window orig-x orig-y #'display-frame-info (list frame)) @@ -604,7 +604,7 @@ mouse-fun is #'move-frame or #'resize-frame" (let* ((to-replay t) (child (find-child-under-mouse root-x root-y)) (parent (find-parent-frame child)) - (root-p (child-root child))) + (root-p (child-root-p child))) (labels ((add-new-frame () (when (frame-p child) (setf parent child @@ -616,10 +616,10 @@ mouse-fun is #'move-frame or #'resize-frame" (pushnew child (frame-child parent))))) (when (and root-p *create-frame-on-root*) (add-new-frame)) - (when (and (frame-p child) (not (child-root child))) + (when (and (frame-p child) (not (child-root-p child))) (funcall mouse-fn child parent root-x root-y)) (when (and child parent - (focus-all-children child parent (not (child-root child)))) + (focus-all-children child parent (not (child-root-p child)))) (when (show-all-children) (setf to-replay nil))) (if to-replay @@ -659,7 +659,7 @@ For window: set current child to window or its parent according to window-parent (let ((parent (find-parent-frame child))) (when (and parent child (frame-p child) - (child-root child)) + (child-root-p child)) (setf parent child child (create-frame) mouse-fn #'resize-frame) @@ -1060,7 +1060,7 @@ For window: set current child to window or its parent according to window-parent "Move the child under the mouse cursor to another frame" (declare (ignore window)) (let ((child (find-child-under-mouse root-x root-y))) - (unless (child-root child) + (unless (child-root-p child) (hide-all child) (remove-child-in-frame child (find-parent-frame child)) (wait-mouse-button-release 50 51) @@ -1099,7 +1099,7 @@ For window: set current child to window or its parent according to window-parent ;;; Hide/Unhide current child (defun hide-current-child () "Hide the current child" - (unless (child-root *current-child*) + (unless (child-root-p *current-child*) (let ((parent (find-parent-frame *current-child*))) (when (frame-p parent) (with-slots (child hidden-children) parent @@ -1655,54 +1655,10 @@ For window: set current child to window or its parent according to window-parent (decf (child-transparency window) 0.1))) -;;; Multiple physical screen helper -(defun get-xrandr-connected-size () - (let ((output (do-shell "xrandr")) - (sizes '())) - (loop for line = (read-line output nil nil) - while line - do - (awhen (search " connected " line) - (incf it (length " connected ")) - (push (mapcar #'parse-integer - (split-string (substitute #\space #\x - (substitute #\space #\+ - (subseq line it (position #\space line :start it)))))) - sizes))) - sizes - '((10 10 500 300) (520 20 480 300) (310 330 600 250)))) - -(defun add-placed-frame-tmp (frame n) - (add-frame (create-frame :x 0.01 :y 0.01 :w 0.4 :h 0.4) frame) - (add-frame (create-frame :x 0.55 :y 0.01 :w 0.4 :h 0.4) frame) - (add-frame (create-frame :x 0.03 :y 0.5 :w 0.64 :h 0.44) frame) - (when (plusp n) - (add-placed-frame-tmp (first (frame-child frame)) (1- n)))) - - -(defun place-frames-from-xrandr () - "Place frames according to xrandr informations" - (let ((sizes (get-xrandr-connected-size)) - (width (xlib:screen-width *screen*)) - (height (xlib:screen-height *screen*))) - (add-placed-frame-tmp (first (frame-child *root-frame*)) 2) - (loop while (< (length (frame-child *root-frame*)) (length sizes)) - do (let ((frame (create-frame))) - (add-frame frame *root-frame*) - (add-placed-frame-tmp frame 2))) - (setf *current-child* (first (frame-child *root-frame*))) - (loop for size in sizes - for frame in (frame-child *root-frame*) - do (destructuring-bind (x y w h) size - (setf (frame-x frame) (float (/ x width)) - (frame-y frame) (float (/ y height)) - (frame-w frame) (float (/ w width)) - (frame-h frame) (float (/ h height))) - (define-as-root frame x y w h))))) - +;;; Geometry change functions (defun swap-frame-geometry () "Swap current brother frame geometry" (when (frame-p *current-child*) diff --git a/src/clfswm.lisp b/src/clfswm.lisp index 1df7bf7..bb642e3 100644 --- a/src/clfswm.lisp +++ b/src/clfswm.lisp @@ -121,7 +121,7 @@ (focus-window window))) (:sloppy-select (let* ((child (find-child-under-mouse root-x root-y)) (parent (find-parent-frame child))) - (unless (or (child-root child) + (unless (or (child-root-p child) (equal (typecase child (xlib:window parent) (t child)) diff --git a/src/package.lisp b/src/package.lisp index b3c82e8..d25600d 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -51,7 +51,7 @@ It is particulary useful with CLISP/MIT-CLX.") (defconfig *default-transparency* 0.6 nil "Default transparency for all windows when in xcompmgr transparency mode") -(defconfig *show-root-frame-p* t nil +(defconfig *show-root-frame-p* nil nil "Show the root frame information or not") @@ -118,6 +118,7 @@ It is particulary useful with CLISP/MIT-CLX.") (defstruct child-rect child parent selected-p x y w h) +(defstruct root child x y w h) (defclass frame () ((name :initarg :name :accessor frame-name :initform nil) commit a1d04c54489f341f4762921fa361a5c26d55bfea Author: Philippe Brochard Date: Sat Apr 28 23:18:41 2012 +0200 Replace the *current-root* variable in clfswm-nw-hooks.lisp diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp index cdad772..47c6b71 100644 --- a/src/clfswm-internal.lisp +++ b/src/clfswm-internal.lisp @@ -645,6 +645,11 @@ (when (find-child child (first root)) (return-from find-original-root root)))) + (defun child-is-original-root-p (child) + (dolist (root original-root-list) + (when (child-equal-p child (first root)) + (return-from child-is-original-root-p t)))) + (defun find-root-in-child (child) (if (child-root child) child diff --git a/src/clfswm-nw-hooks.lisp b/src/clfswm-nw-hooks.lisp index 327dcd6..0559843 100644 --- a/src/clfswm-nw-hooks.lisp +++ b/src/clfswm-nw-hooks.lisp @@ -46,7 +46,9 @@ (let ((frame (if (xlib:window-p *current-child*) (find-parent-frame *current-child*) *current-child*))) - (unless (child-member frame *permanent-nw-hook-frames*) + (dbg (child-is-original-root-p frame)) + (unless (or (child-member frame *permanent-nw-hook-frames*) + (child-is-original-root-p frame)) (setf (frame-nw-hook frame) hook) (leave-second-mode)))) @@ -105,10 +107,11 @@ (defun open-in-current-root-nw-hook (frame window) "Open the next window in the current root" (clear-nw-hook frame) - (leave-if-not-frame *current-root*) - (pushnew window (frame-child *current-root*)) - (setf *current-child* (frame-selected-child *current-root*)) - (default-window-placement *current-root* window) + (leave-if-not-frame (find-current-root)) + (let ((root (find-current-root))) + (pushnew window (frame-child root)) + (setf *current-child* (frame-selected-child root)) + (default-window-placement root window)) t) (defun set-open-in-current-root-nw-hook () @@ -122,9 +125,10 @@ (defun open-in-new-frame-in-current-root-nw-hook (frame window) "Open the next window in a new frame in the current root" (clear-nw-hook frame) - (leave-if-not-frame *current-root*) - (let ((new-frame (create-frame))) - (pushnew new-frame (frame-child *current-root*)) + (leave-if-not-frame (find-current-root)) + (let ((new-frame (create-frame)) + (root (find-current-root))) + (pushnew new-frame (frame-child root)) (pushnew window (frame-child new-frame)) (setf *current-child* new-frame) (default-window-placement new-frame window)) @@ -141,11 +145,12 @@ (defun open-in-new-frame-in-root-frame-nw-hook (frame window) "Open the next window in a new frame in the root frame" (clear-nw-hook frame) - (let ((new-frame (create-frame))) - (pushnew new-frame (frame-child *root-frame*)) + (let ((new-frame (create-frame)) + (root (find-current-root))) + (pushnew new-frame (frame-child root)) (pushnew window (frame-child new-frame)) (switch-to-root-frame :show-later t) - (setf *current-child* *current-root*) + (setf *current-child* root) (set-layout-once #'tile-space-layout) (setf *current-child* new-frame) (default-window-placement new-frame window)) @@ -167,8 +172,8 @@ (when parent (pushnew new-frame (frame-child parent)) (pushnew window (frame-child new-frame)) - (setf *current-root* parent - *current-child* parent) + (change-root (find-related-root parent) parent) + (setf *current-child* parent) (set-layout-once #'tile-space-layout) (setf *current-child* new-frame) (default-window-placement new-frame window) @@ -209,8 +214,8 @@ (defun nw-hook-open-in-frame (window frame) (when (frame-p frame) (pushnew window (frame-child frame)) - (unless (find-child frame *current-root*) - (setf *current-root* frame)) + (unless (find-child-in-all-root frame) + (change-root (find-related-root frame) frame)) (setf *current-child* frame) (focus-all-children window frame) (default-window-placement frame window) @@ -255,8 +260,8 @@ (funcall absorb-nw-test window)) (pushnew window (frame-child frame)) (unless *in-process-existing-windows* - (unless (find-child frame *current-root*) - (setf *current-root* frame)) + (unless (find-child-in-all-root frame) + (change-root (find-related-root frame) frame)) (setf *current-child* frame) (focus-all-children window frame) (default-window-placement frame window) commit d04fb387dad72bd36f0b2501027fe6797c33db66 Author: Philippe Brochard Date: Fri Apr 27 23:07:26 2012 +0200 Big change to replace *current-root* variable to support multiple root diff --git a/TODO b/TODO index e615c5c..536ce34 100644 --- a/TODO +++ b/TODO @@ -16,6 +16,8 @@ FOR THE NEXT RELEASE - Add a modeline in contrib/ +- Add completion in query input. + MAYBE ===== diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp index 618568a..442e742 100644 --- a/src/clfswm-circulate-mode.lisp +++ b/src/clfswm-circulate-mode.lisp @@ -85,8 +85,7 @@ (defun reorder-brother (direction) (no-focus) - (let ((frame-is-root? (and (child-equal-p *current-root* *current-child*) - (not (child-equal-p *current-root* *root-frame*))))) + (let ((old-child *current-child*)) (select-current-frame nil) (unless (and *circulate-orig* *circulate-parent*) (reset-circulate-brother)) @@ -97,8 +96,9 @@ (setf (frame-child *circulate-parent*) (cons elem (child-remove elem *circulate-orig*)) (frame-selected-pos *circulate-parent*) 0 *current-child* (frame-selected-child *circulate-parent*)))) - (when frame-is-root? - (setf *current-root* *current-child*)))) + (when (and (not (child-root *current-child*)) + (child-root old-child)) + (change-root old-child *current-child*)))) (show-all-children t) (draw-circulate-mode-window))) @@ -294,7 +294,7 @@ (defun reorder-brother-simple (reorder-fun) - (unless (child-equal-p *current-child* *current-root*) + (unless (child-root *current-child*) (no-focus) (select-current-frame nil) (let ((parent-frame (find-parent-frame *current-child*))) @@ -318,8 +318,8 @@ ;;; Spatial move functions (defun select-brother-generic-spatial-move (fun-found) "Select the nearest brother of the current child based on the fun-found function" - (let ((is-root? (child-equal-p *current-child* *current-root*))) - (when is-root? + (let ((is-root-p (child-root *current-child*))) + (when is-root-p (leave-frame) (sleep *spatial-move-delay-before*)) (no-focus) @@ -342,7 +342,7 @@ selected-pos 0 child (cons found (child-remove found child))))))) (show-all-children t) - (when is-root? + (when is-root-p (sleep *spatial-move-delay-after*) (enter-frame))))) diff --git a/src/clfswm-corner.lisp b/src/clfswm-corner.lisp index 2e50f7a..5364a54 100644 --- a/src/clfswm-corner.lisp +++ b/src/clfswm-corner.lisp @@ -61,7 +61,7 @@ Corner is one of :bottom-right :bottom-left :top-right :top-left" (defun do-corner-action (x y corner-list) "Do the action associated with corner. The corner function must return T to stop the button event" - (when (frame-p *current-root*) + (when (frame-p (find-current-root)) (let ((corner (find-corner x y))) (when corner (let ((fun (second (assoc corner corner-list)))) diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp index 2331401..cdad772 100644 --- a/src/clfswm-internal.lisp +++ b/src/clfswm-internal.lisp @@ -132,6 +132,8 @@ nil) + + (declaim (inline child-member child-remove child-position)) (defun child-member (child list) @@ -368,19 +370,6 @@ , at body))) -(defgeneric rename-child (child name)) - -(defmethod rename-child ((child frame) name) - (setf (frame-name child) name) - (display-frame-info child)) - -(defmethod rename-child ((child xlib:window) name) - (setf (xlib:wm-name child) name)) - -(defmethod rename-child (child name) - (declare (ignore child name))) - - (defun is-in-current-child-p (child) (and (frame-p *current-child*) (child-member child (frame-child *current-child*)))) @@ -624,6 +613,72 @@ (rec base))) +;;; Multiple roots support (replace the old *current-root* variable) +(let ((root-list nil) + (original-root-list nil)) + (defun define-as-root (child x y width height) + (push (list child x y width height) root-list) + (setf original-root-list (copy-tree root-list))) + + (defun all-root-child () + (loop for root in root-list + collect (first root))) + + (defun child-root (child) + (dolist (root root-list) + (when (child-equal-p child (first root)) + (return root)))) + + (defun change-root (old new) + (let ((root (child-root old))) + (when (and root new) + (setf (first root) new)))) + + (defun find-root (child) + (if (child-root child) + child + (awhen (find-parent-frame child) + (find-root it)))) + + (defun find-original-root (child) + (dolist (root original-root-list) + (when (find-child child (first root)) + (return-from find-original-root root)))) + + (defun find-root-in-child (child) + (if (child-root child) + child + (when (frame-p child) + (dolist (c (frame-child child)) + (awhen (find-root-in-child c) + (return-from find-root-in-child it)))))) + + (defun find-all-root (child) + "Return a list of root in child" + (let ((roots nil)) + (labels ((rec (child) + (when (child-root child) + (push child roots)) + (when (frame-p child) + (dolist (c (frame-child child)) + (rec c))))) + (rec child) + roots))) + + (defun find-child-in-all-root (child) + (dolist (root root-list) + (when (find-child child (first root)) + (return-from find-child-in-all-root root)))) + + (defun only-one-root-in-p (child) + (<= (length (find-all-root child)) 1)) + + (defun find-current-root () + (find-root *current-child*)) + + (defun find-related-root (child) + (or (find-root-in-child child) + (find-root-in-child (first (find-original-root child)))))) (defun get-all-windows (&optional (root *root-frame*)) @@ -672,7 +727,7 @@ (setf (xlib:gcontext-background gc) (get-color *frame-background*) (xlib:window-background window) (get-color *frame-background*)) (clear-pixmap-buffer window gc) - (setf (xlib:gcontext-foreground gc) (get-color (if (and (child-equal-p frame *current-root*) + (setf (xlib:gcontext-foreground gc) (get-color (if (and (child-root frame) (child-equal-p frame *current-child*)) *frame-foreground-root* *frame-foreground*))) (xlib:draw-glyphs *pixmap-buffer* gc 5 dy @@ -680,7 +735,7 @@ number (if name (format nil " - ~A" name) ""))) (let ((pos dy)) - (when (child-equal-p frame *current-root*) + (when (child-root frame) (when *child-selection* (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy) (with-output-to-string (str) @@ -697,17 +752,33 @@ (values t t))))) -(defun display-all-frame-info (&optional (root *current-root*)) - (with-all-frames (root frame) +(defun display-all-frame-info () + (with-all-frames (*root-frame* frame) (display-frame-info frame))) +(defun display-all-root-frame-info () + (dolist (root (all-root-child)) + (display-frame-info root))) + + +(defgeneric rename-child (child name)) + +(defmethod rename-child ((child frame) name) + (setf (frame-name child) name) + (display-frame-info child)) + +(defmethod rename-child ((child xlib:window) name) + (setf (xlib:wm-name child) name)) + +(defmethod rename-child (child name) + (declare (ignore child name))) (defun get-parent-layout (child parent) - (if (child-equal-p child *current-root*) - (get-fullscreen-size) + (if (child-root child) + (values-list (rest (child-root child))) (if (or (frame-p child) (managed-window-p child parent)) (if (frame-p parent) (aif (frame-layout parent) @@ -780,7 +851,7 @@ (declare (ignore parent)) (with-slots (window show-window-p) frame (if (and show-window-p - (or *show-root-frame-p* (not (child-equal-p frame *current-root*)))) + (or *show-root-frame-p* (not (child-root frame)))) (progn (map-window window) (set-child-stack-order window previous) @@ -849,7 +920,7 @@ (select-child *current-child* selected)) (defun unselect-all-frames () - (with-all-children (*current-root* child) + (with-all-children (*root-frame* child) (select-child child nil))) @@ -895,8 +966,7 @@ (defun show-all-children (&optional (from-root-frame nil)) - "Show all children from *current-root*. When from-root-frame is true -Display all children from root frame and hide those not in *current-root*" + "Show all children and hide those not in a root frame" (let ((geometry-change nil) (displayed-child nil) (hidden-child nil)) @@ -947,7 +1017,7 @@ Display all children from root frame and hide those not in *current-root*" (setf previous (child-rect-child rect))))) (rec (child parent selected-p in-current-root) - (let ((child-current-root-p (child-equal-p child *current-root*))) + (let ((child-current-root-p (child-root child))) (unless (in-displayed-list child) (set-geometry child parent in-current-root child-current-root-p)) (when (frame-p child) @@ -956,8 +1026,7 @@ Display all children from root frame and hide those not in *current-root*" (not (in-displayed-list child))) (select-and-display child parent selected-p))))) - (rec (if from-root-frame *root-frame* *current-root*) - nil t (child-equal-p *current-root* *root-frame*)) + (rec *root-frame* nil t (child-root *root-frame*)) (display-displayed-child) (dolist (child hidden-child) (hide-child child)) @@ -968,8 +1037,6 @@ Display all children from root frame and hide those not in *current-root*" - - (defun hide-all-children (root &optional except) "Hide all root children" (when (and (frame-p root) (not (child-equal-p root except))) @@ -1028,19 +1095,20 @@ Display all children from root frame and hide those not in *current-root*" (defun set-current-root (child parent window-parent) "Set current root if parent is not in current root" - (when (and window-parent - (not (child-equal-p child *current-root*)) - (not (find-child parent *current-root*))) - (setf *current-root* parent) - t)) + (let ((root (find-root child))) + (when (and window-parent + (not (child-root child)) + (not (find-child parent root))) + (change-root root parent) + t))) (defun focus-all-children (child parent &optional (window-parent t)) "Focus child and its parents - For window: set current child to window or its parent according to window-parent" (let ((new-focus (focus-child-rec child parent)) - (new-current-child (set-current-child child parent window-parent)) - (new-root (set-current-root child parent window-parent))) + (new-current-child (set-current-child child parent window-parent)) + (new-root (set-current-root child parent window-parent))) (or new-focus new-current-child new-root))) @@ -1056,27 +1124,29 @@ For window: set current child to window or its parent according to window-parent (defun select-previous-level () "Select the previous level in frame" - (unless (child-equal-p *current-child* *current-root*) + (unless (child-root *current-child*) (select-current-frame :maybe) (awhen (find-parent-frame *current-child*) (setf *current-child* it)) (show-all-children))) - (defun enter-frame () "Enter in the selected frame - ie make it the root frame" - (setf *current-root* *current-child*) - (show-all-children t)) + (let ((root (find-root *current-child*))) + (unless (child-equal-p root *current-child*) + (change-root root *current-child*)) + (show-all-children t))) (defun leave-frame () "Leave the selected frame - ie make its parent the root frame" - (unless (child-equal-p *current-root* *root-frame*) - (hide-all *current-root* (get-first-window)) - (awhen (find-parent-frame *current-root*) - (when (frame-p it) - (setf *current-root* it))) - (show-all-children))) + (let ((root (find-root *current-child*))) + (unless (child-equal-p root *root-frame*) + (awhen (find-parent-frame root) + (when (and (frame-p it) + (only-one-root-in-p it)) + (change-root root it))) + (show-all-children)))) ;;; Other actions (select-next-child, select-next-brother...) are in @@ -1129,14 +1199,15 @@ For window: set current child to window or its parent according to window-parent (defun switch-to-root-frame (&key (show-later nil)) "Switch to the root frame" - (setf *current-root* *root-frame*) + (change-root (find-root *current-child*) (first (find-original-root *current-child*))) (unless show-later (show-all-children t))) (defun switch-and-select-root-frame (&key (show-later nil)) "Switch and select the root frame" - (setf *current-root* *root-frame*) - (setf *current-child* *current-root*) + (let ((new-root (first (find-original-root *current-child*)))) + (change-root (find-root *current-child*) new-root) + (setf *current-child* new-root)) (unless show-later (show-all-children t))) @@ -1150,10 +1221,14 @@ For window: set current child to window or its parent according to window-parent (defun prevent-current-*-equal-child (child) " Prevent current-root and current-child equal to child" - (when (child-equal-p child *current-root*) - (setf *current-root* (find-parent-frame child))) - (when (child-equal-p child *current-child*) - (setf *current-child* *current-root*))) + (let* ((parent (find-parent-frame child)) + (parent-is-root-frame-p (child-equal-p parent *root-frame*))) + (when (and (child-root child) + (not parent-is-root-frame-p)) + (change-root child parent)) + (when (child-equal-p child *current-child*) + (setf *current-child* (find-current-root))) + (not parent-is-root-frame-p))) (defun remove-child-in-frame (child frame) @@ -1169,8 +1244,8 @@ For window: set current child to window or its parent according to window-parent (defun remove-child-in-all-frames (child) "Remove child in all frames from *root-frame*" - (prevent-current-*-equal-child child) - (remove-child-in-frames child *root-frame*)) + (when (prevent-current-*-equal-child child) + (remove-child-in-frames child *root-frame*))) (defun delete-child-in-frames (child root) @@ -1187,8 +1262,8 @@ Warning:frame window and gc are freeed." (defun delete-child-in-all-frames (child) "Delete child in all frames from *root-frame*" - (prevent-current-*-equal-child child) - (delete-child-in-frames child *root-frame*)) + (when (prevent-current-*-equal-child child) + (delete-child-in-frames child *root-frame*))) (defun delete-child-and-children-in-frames (child root) "Delete child and its children in the frame root and in all its children @@ -1200,11 +1275,11 @@ Warning:frame window and gc are freeed." (defun delete-child-and-children-in-all-frames (child &optional (close-methode 'delete-window)) "Delete child and its children in all frames from *root-frame*" - (prevent-current-*-equal-child child) - (delete-child-and-children-in-frames child *root-frame*) - (when (xlib:window-p child) - (funcall close-methode child)) - (show-all-children)) + (when (prevent-current-*-equal-child child) + (delete-child-and-children-in-frames child *root-frame*) + (when (xlib:window-p child) + (funcall close-methode child)) + (show-all-children))) (defun clean-windows-in-all-frames () @@ -1214,9 +1289,9 @@ Warning:frame window and gc are freeed." (dolist (child (frame-child frame)) (when (xlib:window-p child) (unless (member child x-tree :test #'xlib:window-equal) - (prevent-current-*-equal-child child) - (setf (frame-child frame) - (child-remove child (frame-child frame))))))))) + (when (prevent-current-*-equal-child child) + (setf (frame-child frame) + (child-remove child (frame-child frame)))))))))) diff --git a/src/clfswm-pack.lisp b/src/clfswm-pack.lisp index 16434b7..8dbabe0 100644 --- a/src/clfswm-pack.lisp +++ b/src/clfswm-pack.lisp @@ -240,7 +240,7 @@ (frame-w child) (w-px->fl (anti-adj-border-wh (x-drawable-width (frame-window child)) parent) parent) (frame-h child) (h-px->fl (anti-adj-border-wh (x-drawable-height (frame-window child)) parent) parent)))))) (defun move-frame-constrained (frame parent orig-x orig-y) - (when (and frame parent (not (child-equal-p frame *current-root*))) + (when (and frame parent (not (child-root frame))) (hide-all-children frame) (with-slots (window) frame (let ((lx orig-x) @@ -285,7 +285,7 @@ (defun resize-frame-constrained (frame parent orig-x orig-y) - (when (and frame parent (not (child-equal-p frame *current-root*))) + (when (and frame parent (not (child-root frame))) (hide-all-children frame) (with-slots (window) frame (let ((lx orig-x) diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp index 553cdfb..e873ec2 100644 --- a/src/clfswm-util.lisp +++ b/src/clfswm-util.lisp @@ -116,10 +116,10 @@ "Add a frame in the parent frame (and reorganize parent frame)" (let ((new-frame (create-frame)) (parent (find-parent-frame *current-child*))) - (when parent + (when (and parent (only-one-root-in-p parent)) (pushnew new-frame (frame-child parent)) - (when (child-equal-p *current-child* *current-root*) - (setf *current-root* parent)) + (when (child-root *current-child*) + (change-root *current-child* parent)) (setf *current-child* parent) (set-layout-once #'tile-space-layout) (setf *current-child* new-frame) @@ -145,7 +145,7 @@ (defun delete-focus-window-generic (close-fun) (with-focus-window (window) (when (child-equal-p window *current-child*) - (setf *current-child* *current-root*)) + (setf *current-child* (find-current-root))) (delete-child-and-children-in-all-frames window close-fun))) (defun delete-focus-window () @@ -159,7 +159,7 @@ (defun remove-focus-window () "Remove the focus window from the current frame" (with-focus-window (window) - (setf *current-child* *current-root*) + (setf *current-child* (find-current-root)) (hide-child window) (remove-child-in-frame window (find-parent-frame window)) (show-all-children))) @@ -179,8 +179,9 @@ (defun find-window-under-mouse (x y) "Return the child window under the mouse" (let ((win *root*)) - (with-all-windows-frames-and-parent (*current-root* child parent) + (with-all-windows-frames-and-parent (*root-frame* child parent) (when (and (or (managed-window-p child parent) (child-equal-p parent *current-child*)) + (not (window-hidden-p child)) (in-window child x y)) (setf win child)) (when (in-frame child x y) @@ -205,7 +206,7 @@ (defun find-child-under-mouse-in-child-tree (x y &optional first-foundp) "Return the child under the mouse" (let ((ret nil)) - (with-all-windows-frames-and-parent (*current-root* child parent) + (with-all-windows-frames-and-parent (*root-frame* child parent) (when (and (not (window-hidden-p child)) (or (managed-window-p child parent) (child-equal-p parent *current-child*)) (in-window child x y)) @@ -233,21 +234,21 @@ (defun clear-selection () "Clear the current selection" (setf *child-selection* nil) - (display-frame-info *current-root*)) + (display-all-root-frame-info)) (defun copy-current-child () "Copy the current child to the selection" (pushnew *current-child* *child-selection*) - (display-frame-info *current-root*)) + (display-all-root-frame-info)) (defun cut-current-child (&optional (show-now t)) "Cut the current child to the selection" - (unless (child-equal-p *current-child* *current-root*) + (unless (child-root *current-child*) (let ((parent (find-parent-frame *current-child*))) (hide-all *current-child*) (copy-current-child) - (remove-child-in-frame *current-child* (find-parent-frame *current-child* *current-root*)) + (remove-child-in-frame *current-child* (find-parent-frame *current-child* (find-current-root))) (when parent (setf *current-child* parent)) (when show-now @@ -256,10 +257,10 @@ (defun remove-current-child () "Remove the current child from its parent frame" - (unless (child-equal-p *current-child* *current-root*) + (unless (child-root *current-child*) (let ((parent (find-parent-frame *current-child*))) (hide-all *current-child*) - (remove-child-in-frame *current-child* (find-parent-frame *current-child* *current-root*)) + (remove-child-in-frame *current-child* (find-parent-frame *current-child* (find-current-root))) (when parent (setf *current-child* parent)) (show-all-children t) @@ -267,10 +268,11 @@ (defun delete-current-child () "Delete the current child and its children in all frames" - (hide-all *current-child*) - (delete-child-and-children-in-all-frames *current-child*) - (show-all-children t) - (leave-second-mode)) + (unless (child-root *current-child*) + (hide-all *current-child*) + (delete-child-and-children-in-all-frames *current-child*) + (show-all-children t) + (leave-second-mode))) (defun paste-selection-no-clear () @@ -286,7 +288,7 @@ (when (frame-p *current-child*) (paste-selection-no-clear) (setf *child-selection* nil) - (display-frame-info *current-root*))) + (display-all-root-frame-info))) (defun copy-focus-window () @@ -451,7 +453,7 @@ ;;; Focus by functions (defun focus-frame-by (frame) (when (frame-p frame) - (focus-all-children frame (or (find-parent-frame frame *current-root*) + (focus-all-children frame (or (find-parent-frame frame (find-current-root)) (find-parent-frame frame) *root-frame*)) (show-all-children t))) @@ -489,11 +491,10 @@ ;;; Delete by functions (defun delete-frame-by (frame) - (unless (child-equal-p frame *root-frame*) - (when (child-equal-p frame *current-root*) - (setf *current-root* *root-frame*)) + (unless (or (child-equal-p frame *root-frame*) + (child-root frame)) (when (child-equal-p frame *current-child*) - (setf *current-child* *current-root*)) + (setf *current-child* (find-current-root))) (remove-child-in-frame frame (find-parent-frame frame))) (show-all-children t)) @@ -561,15 +562,13 @@ "Show all frames info windows" (let ((*show-root-frame-p* t)) (show-all-children) - (with-all-frames (*current-root* frame) - (raise-window (frame-window frame)) - (display-frame-info frame)))) + (dolist (root (all-root-child)) + (with-all-frames (root frame) + (raise-window (frame-window frame)) + (display-frame-info frame))))) (defun hide-all-frames-info () "Hide all frames info windows" - (with-all-windows (*current-root* window) - (raise-window window)) - (hide-child *current-root*) (show-all-children)) (defun show-all-frames-info-key () @@ -580,7 +579,7 @@ (defun move-frame (frame parent orig-x orig-y) - (when (and frame parent (not (child-equal-p frame *current-root*))) + (when (and frame parent (not (child-root frame))) (hide-all-children frame) (with-slots (window) frame (move-window window orig-x orig-y #'display-frame-info (list frame)) @@ -589,7 +588,7 @@ (show-all-children))) (defun resize-frame (frame parent orig-x orig-y) - (when (and frame parent (not (child-equal-p frame *current-root*))) + (when (and frame parent (not (child-root frame))) (hide-all-children frame) (with-slots (window) frame (resize-window window orig-x orig-y #'display-frame-info (list frame)) @@ -605,28 +604,24 @@ mouse-fun is #'move-frame or #'resize-frame" (let* ((to-replay t) (child (find-child-under-mouse root-x root-y)) (parent (find-parent-frame child)) - (root-p (child-equal-p child *current-root*))) + (root-p (child-root child))) (labels ((add-new-frame () (when (frame-p child) - (setf child (create-frame) - parent *current-root* + (setf parent child + child (create-frame) mouse-fn #'resize-frame *current-child* child) (place-frame child parent root-x root-y 10 10) (map-window (frame-window child)) - (pushnew child (frame-child *current-root*))))) - (when (or (not root-p) *create-frame-on-root*) - (when root-p - (add-new-frame)) - (when (and (frame-p child) (not (child-equal-p child *current-root*))) - (funcall mouse-fn child parent root-x root-y)) - (when (and child parent - (not root-p) - (focus-all-children child parent - (not (and (child-equal-p *current-child* *current-root*) - (xlib:window-p *current-root*))))) - (when (show-all-children) - (setf to-replay nil)))) + (pushnew child (frame-child parent))))) + (when (and root-p *create-frame-on-root*) + (add-new-frame)) + (when (and (frame-p child) (not (child-root child))) + (funcall mouse-fn child parent root-x root-y)) + (when (and child parent + (focus-all-children child parent (not (child-root child)))) + (when (show-all-children) + (setf to-replay nil))) (if to-replay (replay-button-event) (stop-button-event))))) @@ -662,15 +657,16 @@ Focus child and its parents - For window: set current child to window or its parent according to window-parent" (labels ((move/resize-managed (child) (let ((parent (find-parent-frame child))) - (when (and (child-equal-p child *current-root*) - (frame-p *current-root*)) - (setf child (create-frame) - parent *current-root* + (when (and parent child + (frame-p child) + (child-root child)) + (setf parent child + child (create-frame) mouse-fn #'resize-frame) (place-frame child parent root-x root-y 10 10) (map-window (frame-window child)) - (pushnew child (frame-child *current-root*))) - (focus-all-children child parent window-parent) + (push child (frame-child parent))) + (focus-all-children child parent window-parent) (show-all-children) (typecase child (xlib:window @@ -698,9 +694,6 @@ For window: set current child to window or its parent according to window-parent (move/resize-managed child)))))) - - - (defun test-mouse-binding (window root-x root-y) (dbg window root-x root-y) (replay-button-event)) @@ -775,8 +768,8 @@ For window: set current child to window or its parent according to window-parent "Jump to slot" (let ((jump-child (aref key-slots current-slot))) (when (find-child jump-child *root-frame*) - (unless (find-child jump-child *current-root*) - (setf *current-root* jump-child)) + (unless (find-child-in-all-root jump-child) + (change-root (find-related-root jump-child) jump-child)) (setf *current-child* jump-child) (focus-all-children *current-child* *current-child*) (show-all-children t)))) @@ -816,19 +809,19 @@ For window: set current child to window or its parent according to window-parent ;;; Pack (defun current-frame-pack-up () "Pack the current frame up" - (with-movement (pack-frame-up *current-child* (find-parent-frame *current-child* *current-root*)))) + (with-movement (pack-frame-up *current-child* (find-parent-frame *current-child* (find-current-root))))) (defun current-frame-pack-down () "Pack the current frame down" - (with-movement (pack-frame-down *current-child* (find-parent-frame *current-child* *current-root*)))) + (with-movement (pack-frame-down *current-child* (find-parent-frame *current-child* (find-current-root))))) (defun current-frame-pack-left () "Pack the current frame left" - (with-movement (pack-frame-left *current-child* (find-parent-frame *current-child* *current-root*)))) + (with-movement (pack-frame-left *current-child* (find-parent-frame *current-child* (find-current-root))))) (defun current-frame-pack-right () "Pack the current frame right" - (with-movement (pack-frame-right *current-child* (find-parent-frame *current-child* *current-root*)))) + (with-movement (pack-frame-right *current-child* (find-parent-frame *current-child* (find-current-root))))) ;;; Center (defun center-current-frame () @@ -838,24 +831,24 @@ For window: set current child to window or its parent according to window-parent ;;; Fill (defun current-frame-fill-up () "Fill the current frame up" - (with-movement (fill-frame-up *current-child* (find-parent-frame *current-child* *current-root*)))) + (with-movement (fill-frame-up *current-child* (find-parent-frame *current-child* (find-current-root))))) (defun current-frame-fill-down () "Fill the current frame down" - (with-movement (fill-frame-down *current-child* (find-parent-frame *current-child* *current-root*)))) + (with-movement (fill-frame-down *current-child* (find-parent-frame *current-child* (find-current-root))))) (defun current-frame-fill-left () "Fill the current frame left" - (with-movement (fill-frame-left *current-child* (find-parent-frame *current-child* *current-root*)))) + (with-movement (fill-frame-left *current-child* (find-parent-frame *current-child* (find-current-root))))) (defun current-frame-fill-right () "Fill the current frame right" - (with-movement (fill-frame-right *current-child* (find-parent-frame *current-child* *current-root*)))) + (with-movement (fill-frame-right *current-child* (find-parent-frame *current-child* (find-current-root))))) (defun current-frame-fill-all-dir () "Fill the current frame in all directions" (with-movement - (let ((parent (find-parent-frame *current-child* *current-root*))) + (let ((parent (find-parent-frame *current-child* (find-current-root)))) (fill-frame-up *current-child* parent) (fill-frame-down *current-child* parent) (fill-frame-left *current-child* parent) @@ -864,14 +857,14 @@ For window: set current child to window or its parent according to window-parent (defun current-frame-fill-vertical () "Fill the current frame vertically" (with-movement - (let ((parent (find-parent-frame *current-child* *current-root*))) + (let ((parent (find-parent-frame *current-child* (find-current-root)))) (fill-frame-up *current-child* parent) (fill-frame-down *current-child* parent)))) (defun current-frame-fill-horizontal () "Fill the current frame horizontally" (with-movement - (let ((parent (find-parent-frame *current-child* *current-root*))) + (let ((parent (find-parent-frame *current-child* (find-current-root)))) (fill-frame-left *current-child* parent) (fill-frame-right *current-child* parent)))) @@ -1067,7 +1060,7 @@ For window: set current child to window or its parent according to window-parent "Move the child under the mouse cursor to another frame" (declare (ignore window)) (let ((child (find-child-under-mouse root-x root-y))) - (unless (child-equal-p child *current-root*) + (unless (child-root child) (hide-all child) (remove-child-in-frame child (find-parent-frame child)) (wait-mouse-button-release 50 51) @@ -1106,7 +1099,7 @@ For window: set current child to window or its parent according to window-parent ;;; Hide/Unhide current child (defun hide-current-child () "Hide the current child" - (unless (child-equal-p *current-child* *current-root*) + (unless (child-root *current-child*) (let ((parent (find-parent-frame *current-child*))) (when (frame-p parent) (with-slots (child hidden-children) parent @@ -1183,8 +1176,8 @@ For window: set current child to window or its parent according to window-parent "Store the current child and switch to the previous one" (let ((current-child *current-child*)) (when last-child - (setf *current-root* last-child - *current-child* *current-root*) + (change-root (find-related-root last-child) last-child) + (setf *current-child* last-child) (focus-all-children *current-child* *current-child*) (show-all-children t)) (setf last-child current-child)) @@ -1592,8 +1585,8 @@ For window: set current child to window or its parent according to window-parent :line-style :solid)) (setf (window-transparency window) *notify-window-transparency*) (when (frame-p *current-child*) - (setf current-child *current-child*) - (push (list #'is-notify-window-p 'raise-window) *never-managed-window-list*)) + (setf current-child *current-child*)) + (push (list #'is-notify-window-p 'raise-window) *never-managed-window-list*) (map-window window) (refresh-notify-window) (xlib:display-finish-output *display*)))))) @@ -1620,7 +1613,7 @@ For window: set current child to window or its parent according to window-parent (setf *current-child* parent) (put-child-on-top window parent) (when maximized - (setf *current-root* parent)) + (change-root (find-related-root parent) parent)) (focus-all-children window parent) (show-all-children t)) (funcall run-fn)))) @@ -1676,7 +1669,15 @@ For window: set current child to window or its parent according to window-parent (substitute #\space #\+ (subseq line it (position #\space line :start it)))))) sizes))) - sizes)) + sizes + '((10 10 500 300) (520 20 480 300) (310 330 600 250)))) + +(defun add-placed-frame-tmp (frame n) + (add-frame (create-frame :x 0.01 :y 0.01 :w 0.4 :h 0.4) frame) + (add-frame (create-frame :x 0.55 :y 0.01 :w 0.4 :h 0.4) frame) + (add-frame (create-frame :x 0.03 :y 0.5 :w 0.64 :h 0.44) frame) + (when (plusp n) + (add-placed-frame-tmp (first (frame-child frame)) (1- n)))) (defun place-frames-from-xrandr () @@ -1684,14 +1685,20 @@ For window: set current child to window or its parent according to window-parent (let ((sizes (get-xrandr-connected-size)) (width (xlib:screen-width *screen*)) (height (xlib:screen-height *screen*))) + (add-placed-frame-tmp (first (frame-child *root-frame*)) 2) (loop while (< (length (frame-child *root-frame*)) (length sizes)) - do (add-frame (create-frame) *root-frame*)) + do (let ((frame (create-frame))) + (add-frame frame *root-frame*) + (add-placed-frame-tmp frame 2))) + (setf *current-child* (first (frame-child *root-frame*))) (loop for size in sizes for frame in (frame-child *root-frame*) - do (setf (frame-w frame) (float (/ (first size) width)) - (frame-h frame) (float (/ (second size) height)) - (frame-x frame) (float (/ (third size) width)) - (frame-y frame) (float (/ (fourth size) height)))))) + do (destructuring-bind (x y w h) size + (setf (frame-x frame) (float (/ x width)) + (frame-y frame) (float (/ y height)) + (frame-w frame) (float (/ w width)) + (frame-h frame) (float (/ h height))) + (define-as-root frame x y w h))))) diff --git a/src/clfswm.lisp b/src/clfswm.lisp index 9aa3844..1df7bf7 100644 --- a/src/clfswm.lisp +++ b/src/clfswm.lisp @@ -58,8 +58,8 @@ (xlib:with-state (window) (when (has-bw value-mask) (setf (x-drawable-border-width window) border-width)) - (if (find-child window *current-root*) - (let ((parent (find-parent-frame window *current-root*))) + (if (find-child window (find-current-root)) + (let ((parent (find-parent-frame window (find-current-root)))) (if (and parent (managed-window-p window parent)) (adapt-child-to-parent window parent) (adjust-from-request))) @@ -75,7 +75,7 @@ (is-in-current-child-p window)) (raise-window window) (focus-window window) - (focus-all-children window (find-parent-frame window *current-root*)))))))))) + (focus-all-children window (find-parent-frame window (find-current-root))))))))))) (define-handler main-mode :map-request (window send-event-p) @@ -121,7 +121,7 @@ (focus-window window))) (:sloppy-select (let* ((child (find-child-under-mouse root-x root-y)) (parent (find-parent-frame child))) - (unless (or (child-equal-p child *current-root*) + (unless (or (child-root child) (equal (typecase child (xlib:window parent) (t child)) @@ -130,7 +130,7 @@ (show-all-children))))))) (define-handler main-mode :exposure (window) - (awhen (find-frame-window window *current-root*) + (awhen (find-frame-window window) (display-frame-info it))) @@ -199,6 +199,9 @@ (clear-timers) (map-window *no-focus-window*) (dbg *display*) + (dbg (xlib:display-roots *display*)) + (dbg (xlib:display-plist *display*)) + (dbg (xlib:query-extension *display* "XINERAMA")) (setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect :substructure-notify :property-change @@ -211,8 +214,8 @@ (xlib:display-force-output *display*) (setf *child-selection* nil) (setf *root-frame* (create-frame :name "Root" :number 0) - *current-root* *root-frame* - *current-child* *current-root*) + *current-root* *root-frame* ;;; PHIL: TO REMOVE + *current-child* *root-frame*) (call-hook *init-hook*) (process-existing-windows *screen*) (show-all-children) diff --git a/src/package.lisp b/src/package.lisp index 068c09b..b3c82e8 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -51,7 +51,7 @@ It is particulary useful with CLISP/MIT-CLX.") (defconfig *default-transparency* 0.6 nil "Default transparency for all windows when in xcompmgr transparency mode") -(defconfig *show-root-frame-p* nil nil +(defconfig *show-root-frame-p* t nil "Show the root frame information or not") @@ -133,6 +133,8 @@ It is particulary useful with CLISP/MIT-CLX.") (ry :initarg :ry :accessor frame-ry :initform 0) (rw :initarg :rw :accessor frame-rw :initform 800) (rh :initarg :rh :accessor frame-rh :initform 600) +;; (root :initarg :root :accessor frame-root :initform nil +;; :documentation "A list a physical coordinates (x y w h) if frame is a root frame. Nil otherwise") (layout :initarg :layout :accessor frame-layout :initform nil :documentation "Layout to display windows on a frame") (nw-hook :initarg :nw-hook :accessor frame-nw-hook :initform nil @@ -166,7 +168,7 @@ It is particulary useful with CLISP/MIT-CLX.") (defparameter *root-frame* nil "Root of the root - ie the root frame") -(defparameter *current-root* nil +(defparameter *current-root* nil ;;; PHIL: TO REMOVE "The current fullscreen maximized child") (defparameter *current-child* nil "The current child with the focus") ----------------------------------------------------------------------- Summary of changes: ChangeLog | 5 + TODO | 2 + clfswm.asd | 2 +- src/clfswm-circulate-mode.lisp | 16 +- src/clfswm-corner.lisp | 2 +- src/clfswm-expose-mode.lisp | 4 +- src/clfswm-internal.lisp | 284 ++++++++++++++++++++++++++++++---------- src/clfswm-nw-hooks.lisp | 38 +++--- src/clfswm-pack.lisp | 4 +- src/clfswm-util.lisp | 177 ++++++++++--------------- src/clfswm.lisp | 17 ++- src/config.lisp | 12 -- src/package.lisp | 5 +- 13 files changed, 338 insertions(+), 230 deletions(-) hooks/post-receive -- CLFSWM - A(nother) Common Lisp FullScreen Window Manager From pbrochard at common-lisp.net Mon Apr 30 21:54:08 2012 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Mon, 30 Apr 2012 14:54:08 -0700 Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-32-g4b41ede Message-ID: This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager". The branch, master has been updated via 4b41ede4606956b7d072d5f9f1e92b01db4824f6 (commit) from 4f9a389cc04f1ed6358b1b7d782b4eceb045452d (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 4b41ede4606956b7d072d5f9f1e92b01db4824f6 Author: Philippe Brochard Date: Mon Apr 30 23:54:00 2012 +0200 src/clfswm-util.lisp (mouse-focus-move/resize-generic): Enable drawing new frame on all root window diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp index 1d48e55..45fdc22 100644 --- a/src/clfswm-util.lisp +++ b/src/clfswm-util.lisp @@ -657,7 +657,7 @@ Focus child and its parents - For window: set current child to window or its parent according to window-parent" (labels ((move/resize-managed (child) (let ((parent (find-parent-frame child))) - (when (and parent child + (when (and child (frame-p child) (child-root-p child)) (setf parent child ----------------------------------------------------------------------- Summary of changes: src/clfswm-util.lisp | 2 +- 1 files changed, 1 insertions(+), 1 deletions(-) hooks/post-receive -- CLFSWM - A(nother) Common Lisp FullScreen Window Manager