[clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1212-25-g7e2726f
Philippe Brochard
pbrochard at alpha-cl-net.common-lisp.net
Mon Apr 22 18:49:59 UTC 2013
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 7e2726f3a0e34066352db72134c2a5d1150f47f4 (commit)
via 29b3dd3e5a9b59100a89bd221162d42c1ddd5b1c (commit)
via b5a6f441b15afa75bd6b01e64a8687b253c78d41 (commit)
from 316a299e213378cde64bd947e7b380aacfa183d5 (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 7e2726f3a0e34066352db72134c2a5d1150f47f4
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Mon Apr 22 20:49:52 2013 +0200
Allow to move the current focused child when circulating over brothers (new bindings)
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index c2e76b3..93620a2 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -112,12 +112,23 @@
(define-second-key ("Home" :mod-1 :control :shift) 'exit-clfswm)
(define-second-key ("Right" :mod-1) 'select-next-brother)
(define-second-key ("Left" :mod-1) 'select-previous-brother)
+
+ (define-second-key ("Right" :mod-1 :shift) 'select-next-brother-take-current)
+ (define-second-key ("Left" :mod-1 :shift) 'select-previous-brother-take-current)
+
(define-second-key ("Down" :mod-1) 'select-previous-level)
(define-second-key ("Up" :mod-1) 'select-next-level)
+
(define-second-key ("Left" :control :mod-1) 'select-brother-spatial-move-left)
(define-second-key ("Right" :control :mod-1) 'select-brother-spatial-move-right)
(define-second-key ("Up" :control :mod-1) 'select-brother-spatial-move-up)
(define-second-key ("Down" :control :mod-1) 'select-brother-spatial-move-down)
+
+ (define-second-key ("Left" :control :mod-1 :shift) 'select-brother-spatial-move-left-take-current)
+ (define-second-key ("Right" :control :mod-1 :shift) 'select-brother-spatial-move-right-take-current)
+ (define-second-key ("Up" :control :mod-1 :shift) 'select-brother-spatial-move-up-take-current)
+ (define-second-key ("Down" :control :mod-1 :shift) 'select-brother-spatial-move-down-take-current)
+
(define-second-key ("j") 'swap-frame-geometry)
(define-second-key ("h") 'rotate-frame-geometry)
(define-second-key ("h" :shift) 'anti-rotate-frame-geometry)
diff --git a/src/bindings.lisp b/src/bindings.lisp
index 106ae9a..45d40d6 100644
--- a/src/bindings.lisp
+++ b/src/bindings.lisp
@@ -47,10 +47,20 @@
(define-main-key ("Left" :mod-1) 'select-previous-brother)
(define-main-key ("Down" :mod-1) 'select-previous-level)
(define-main-key ("Up" :mod-1) 'select-next-level)
+
+ (define-main-key ("Right" :mod-1 :shift) 'select-next-brother-take-current)
+ (define-main-key ("Left" :mod-1 :shift) 'select-previous-brother-take-current)
+
(define-main-key ("Left" :control :mod-1) 'select-brother-spatial-move-left)
(define-main-key ("Right" :control :mod-1) 'select-brother-spatial-move-right)
(define-main-key ("Up" :control :mod-1) 'select-brother-spatial-move-up)
(define-main-key ("Down" :control :mod-1) 'select-brother-spatial-move-down)
+
+ (define-main-key ("Left" :control :mod-1 :shift) 'select-brother-spatial-move-left-take-current)
+ (define-main-key ("Right" :control :mod-1 :shift) 'select-brother-spatial-move-right-take-current)
+ (define-main-key ("Up" :control :mod-1 :shift) 'select-brother-spatial-move-up-take-current)
+ (define-main-key ("Down" :control :mod-1 :shift) 'select-brother-spatial-move-down-take-current)
+
(define-main-key ("Tab" :mod-1) 'select-next-child)
(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
(define-main-key ("Tab" :mod-1 :control) 'select-next-subchild)
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index fd8ca93..7c52dda 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -264,6 +264,29 @@
(setf *circulate-orig* (frame-child *circulate-parent*)))
(circulate-mode :brother-direction -1))
+
+(defmacro with-move-current-focused-window (() &body body)
+ (let ((window (gensym)))
+ `(with-focus-window (,window)
+ , at body
+ (move-child-to ,window (if (frame-p (current-child))
+ (current-child)
+ (find-parent-frame (current-child) (find-current-root)))))))
+
+
+
+(defun select-next-brother-take-current ()
+ "Select the next brother and move the current focused child in it"
+ (with-move-current-focused-window ()
+ (select-next-brother)))
+
+(defun select-previous-brother-take-current ()
+ "Select the previous brother and move the current focused child in it"
+ (with-move-current-focused-window ()
+ (select-previous-brother)))
+
+
+
(defun select-next-subchild ()
"Select the next subchild"
(when (and (frame-p (current-child))
@@ -376,3 +399,26 @@
(middle-child-x child) (child-y2 child))))))
+(defun select-brother-spatial-move-right-take-current ()
+ "Select spatially the nearest brother of the current child in the right direction - move current focused child"
+ (with-move-current-focused-window ()
+ (select-brother-spatial-move-right)))
+
+
+(defun select-brother-spatial-move-left-take-current ()
+ "Select spatially the nearest brother of the current child in the left direction - move current focused child"
+ (with-move-current-focused-window ()
+ (select-brother-spatial-move-left)))
+
+(defun select-brother-spatial-move-down-take-current ()
+ "Select spatially the nearest brother of the current child in the down direction - move current focused child"
+ (with-move-current-focused-window ()
+ (select-brother-spatial-move-down)))
+
+(defun select-brother-spatial-move-up-take-current ()
+ "Select spatially the nearest brother of the current child in the up direction - move current focused child"
+ (with-move-current-focused-window ()
+ (select-brother-spatial-move-up)))
+
+
+
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 8b1ec3c..f42b8a8 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -1476,6 +1476,14 @@ For window: set current child to window or its parent according to window-parent
+(defun move-child-to (child frame-dest)
+ (when (and child (frame-p frame-dest))
+ (remove-child-in-frame child (find-parent-frame child))
+ (pushnew child (frame-child frame-dest) :test #'child-equal-p)
+ (focus-all-children child frame-dest)
+ (show-all-children t)))
+
+
(defun prevent-current-*-equal-child (child)
" Prevent current-root and current-child equal to child"
(if (child-original-root-p child)
diff --git a/src/clfswm-keys.lisp b/src/clfswm-keys.lisp
index 8b65b96..465cfa1 100644
--- a/src/clfswm-keys.lisp
+++ b/src/clfswm-keys.lisp
@@ -151,13 +151,14 @@
(character (multiple-value-list (char->keycode key)))
(number key)
(string (let* ((keysym (keysym-name->keysym key))
- (ret-keycode (multiple-value-list (xlib:keysym->keycodes *display* keysym))))
+ (ret-keycode (multiple-value-list
+ (xlib:keysym->keycodes *display* keysym))))
(let ((found nil))
(dolist (kc ret-keycode)
(when (= keysym (xlib:keycode->keysym *display* kc 0))
(setf found t)))
- (unless found
- (setf modifiers (add-in-state modifiers :shift))))
+ (unless found
+ (setf modifiers (add-in-state modifiers :shift))))
ret-keycode)))))
(if keycode
(if (consp keycode)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 425a60c..5489dc9 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -687,13 +687,6 @@ Write (defparameter *contrib-dir* \"/usr/local/lib/clfswm/\") in ~A.~%"
;;; Move by function
-(defun move-child-to (child frame-dest)
- (when (and child (frame-p frame-dest))
- (remove-child-in-frame child (find-parent-frame child))
- (pushnew child (frame-child frame-dest))
- (focus-all-children child frame-dest)
- (show-all-children t)))
-
(defun move-current-child-by-name ()
"Move current child in a named frame"
(move-child-to (current-child)
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index ec70a9a..75d8997 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -80,8 +80,8 @@
(is-in-current-child-p window))
(setf change (or change :moved))
(focus-window window)
- (focus-all-children window (find-parent-frame window (find-current-root)))
- (show-all-children))))))
+ (when (focus-all-children window (find-parent-frame window (find-current-root)))
+ (show-all-children)))))))
(unless (eq change :resized)
;; To be ICCCM compliant, send a fake configuration notify event only when
;; the window has moved and not when it has been resized or the border width has changed.
@@ -109,6 +109,7 @@
(when (find-child window *root-frame*)
(setf (window-state window) +withdrawn-state+)
(remove-child-in-all-frames window)
+ (xlib:unmap-window window)
(show-all-children))))
diff --git a/src/package.lisp b/src/package.lisp
index e072287..b7d9970 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -119,7 +119,8 @@ It is particulary useful with CLISP/MIT-CLX.")
;;; CONFIG - Default focus policy
(defconfig *default-focus-policy* :click nil
- "Default mouse focus policy. One of :click, :sloppy, :sloppy-strict or :sloppy-select.")
+ "Default mouse focus policy. One of :click, :sloppy, :sloppy-strict, :sloppy-select or
+:sloppy-select-window.")
(defconfig *show-hide-policy* #'<=
commit 29b3dd3e5a9b59100a89bd221162d42c1ddd5b1c
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sun Apr 7 22:40:46 2013 +0200
Destroy window is needed in some cases
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 5b32fd6..ec70a9a 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -117,6 +117,7 @@
(xlib:window-equal window event-window))
(when (find-child window *root-frame*)
(delete-child-in-all-frames window)
+ (xlib:destroy-window window)
(show-all-children))))
commit b5a6f441b15afa75bd6b01e64a8687b253c78d41
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Fri Apr 5 22:35:41 2013 +0200
Change focus only on mouse move
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 14f628c..8b1ec3c 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -1668,39 +1668,43 @@ managed."
(frame-selected-pos parent) 0)))
-(defun manage-focus (window root-x root-y)
- (case (if (frame-p (current-child))
- (frame-focus-policy (current-child))
- *default-focus-policy*)
- (:sloppy (focus-window window))
- (:sloppy-strict (when (and (frame-p (current-child))
- (child-member window (frame-child (current-child))))
- (focus-window window)))
- (:sloppy-select (let* ((child (find-child-under-mouse root-x root-y))
- (parent (find-parent-frame child)))
- (unless (or (child-root-p child)
- (child-equal-p (typecase child
- (xlib:window parent)
- (t child))
- (current-child)))
- (focus-all-children child parent)
- (show-all-children))))
- (:sloppy-select-window (let* ((child (find-child-under-mouse root-x root-y))
- (parent (find-parent-frame child))
- (need-warp-pointer (not (or (frame-p child)
- (child-equal-p child (frame-selected-child parent))))))
- (unless (child-root-p child)
- (when (focus-all-children child parent)
- (show-all-children)
- (when (and need-warp-pointer
- (not (eql (frame-data-slot (current-child) :tile-layout-keep-position)
- :yes)))
- (typecase child
- (xlib:window (xlib:warp-pointer *root*
- (truncate (+ (x-drawable-x child)
- (/ (x-drawable-width child) 2)))
- (truncate (+ (x-drawable-y child)
- (/ (x-drawable-height child) 2)))))
- (frame (xlib:warp-pointer *root*
- (+ (frame-rx child) 10)
- (+ (frame-ry child) 10)))))))))))
\ No newline at end of file
+(let ((lx -1) (ly -1))
+ (defun manage-focus (window root-x root-y)
+ (case (if (frame-p (current-child))
+ (frame-focus-policy (current-child))
+ *default-focus-policy*)
+ (:sloppy (focus-window window))
+ (:sloppy-strict (when (and (frame-p (current-child))
+ (child-member window (frame-child (current-child))))
+ (focus-window window)))
+ (:sloppy-select (let* ((child (find-child-under-mouse root-x root-y))
+ (parent (find-parent-frame child)))
+ (unless (or (child-root-p child)
+ (child-equal-p (typecase child
+ (xlib:window parent)
+ (t child))
+ (current-child)))
+ (focus-all-children child parent)
+ (show-all-children))))
+ (:sloppy-select-window (let* ((child (find-child-under-mouse root-x root-y))
+ (parent (find-parent-frame child))
+ (need-warp-pointer (not (or (frame-p child)
+ (child-equal-p child (frame-selected-child parent))))))
+ (unless (or (child-root-p child)
+ (= lx root-x) (= ly root-y))
+ (setf lx root-x ly root-y)
+ (when (focus-all-children child parent)
+ (show-all-children)
+ (when (and need-warp-pointer
+ (not (eql (frame-data-slot (current-child) :tile-layout-keep-position)
+ :yes)))
+ (typecase child
+ (xlib:window (xlib:warp-pointer *root*
+ (truncate (+ (x-drawable-x child)
+ (/ (x-drawable-width child) 2)))
+ (truncate (+ (x-drawable-y child)
+ (/ (x-drawable-height child) 2)))))
+ (frame (xlib:warp-pointer *root*
+ (+ (frame-rx child) 10)
+ (+ (frame-ry child) 10))))))))))))
+
-----------------------------------------------------------------------
Summary of changes:
src/bindings-second-mode.lisp | 11 ++++++
src/bindings.lisp | 10 +++++
src/clfswm-circulate-mode.lisp | 46 ++++++++++++++++++++++
src/clfswm-internal.lisp | 84 +++++++++++++++++++++++-----------------
src/clfswm-keys.lisp | 7 ++--
src/clfswm-util.lisp | 7 ----
src/clfswm.lisp | 6 ++-
src/package.lisp | 3 +-
8 files changed, 125 insertions(+), 49 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list