Allow to move the current focused child when circulating over brothers (new bindings)
authorPhilippe Brochard <pbrochard@common-lisp.net>
Mon, 22 Apr 2013 18:49:52 +0000 (20:49 +0200)
committerPhilippe Brochard <pbrochard@common-lisp.net>
Mon, 22 Apr 2013 18:49:52 +0000 (20:49 +0200)
src/bindings-second-mode.lisp
src/bindings.lisp
src/clfswm-circulate-mode.lisp
src/clfswm-internal.lisp
src/clfswm-keys.lisp
src/clfswm-util.lisp
src/clfswm.lisp
src/package.lisp

index c2e76b3..93620a2 100644 (file)
   (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)
index 106ae9a..45d40d6 100644 (file)
   (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)
index fd8ca93..7c52dda 100644 (file)
     (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))
                                                        (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)))
+
+
+
index 8b1ec3c..f42b8a8 100644 (file)
@@ -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)
index 8b65b96..465cfa1 100644 (file)
                                          (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)
index 425a60c..5489dc9 100644 (file)
@@ -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)
index ec70a9a..75d8997 100644 (file)
@@ -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.
     (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))))
 
 
index e072287..b7d9970 100644 (file)
@@ -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* #'<=