diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp index c2e76b38bda2cea82f9d4ee3c0f92d48ae629231..93620a24cc1d799f4d0233b992ab0666be7b53c7 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 106ae9af52321088b06bc9bdf8c7481f5d2bcef3..45d40d6d4efd5e48f455dd3378baca2350428153 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 fd8ca93fff6f47714de99df032e3bdbcacd2b643..7c52dda556dab7ac0f62252f9c649c280eb8a4b3 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) + ,@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 8b1ec3ca2b354e8d017c7c88c199e0a81cd9a470..f42b8a88cbee7d91e9e331c8fc13bdc0be373a06 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 8b65b96c11999ccf5150481b2003d8552701a407..465cfa1d87d29c25bf65dd13a0eadd2774f75fd4 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 425a60c419eecbf69951e54b60a29028bb92dc13..5489dc91c1bd29d3079bd8607f158a666812a659 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 ec70a9a6db68a4cefd0aeb38171b7ca276fdadd0..75d8997f435daeee65a9845866d190df73bb4249 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 e072287f4a350de867046a9bb4bf56b66db12b00..b7d9970d6d215ecaa8604f2ee27d3fba9d07ca43 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* #'<=