From ae68af20a5e625d7e4762ee050f19651fb919aac Mon Sep 17 00:00:00 2001
From: Philippe Brochard <pbrochard@common-lisp.net>
Date: Thu, 1 Aug 2013 23:04:57 +0200
Subject: [PATCH] Add a fastswitch-move-mode to move children from expose
 shortcuts

---
 src/bindings.lisp               |  2 +-
 src/clfswm-fastswitch-mode.lisp | 42 +++++++++++++++++++++++++++++++++++++----
 2 files changed, 39 insertions(+), 5 deletions(-)

diff --git a/src/bindings.lisp b/src/bindings.lisp
index ba51437..48b78a0 100644
--- a/src/bindings.lisp
+++ b/src/bindings.lisp
@@ -75,7 +75,7 @@
   (define-main-key ("Home" :mod-1) 'switch-to-root-frame)
   (define-main-key ("Home" :mod-1 :shift) 'switch-and-select-root-frame)
   (define-main-key ("Menu") 'fastswitch-mode)
-  (define-main-key (135) 'fastswitch-mode)  ;; Menu hardcoded -> not good!!!
+  (define-main-key ("Menu" :control) 'fastswitch-move-mode)
   (define-main-key ("F10" :mod-1) 'fast-layout-switch)
   (define-main-key ("F10" :shift :control) 'toggle-show-root-frame)
   (define-main-key ("F10") 'expose-windows-mode)
diff --git a/src/clfswm-fastswitch-mode.lisp b/src/clfswm-fastswitch-mode.lisp
index c74d2d5..dad4131 100644
--- a/src/clfswm-fastswitch-mode.lisp
+++ b/src/clfswm-fastswitch-mode.lisp
@@ -33,7 +33,7 @@
 (defparameter *fastswitch-font* nil)
 (defparameter *fastswitch-string* "")
 (defparameter *fastswitch-match-child* nil)
-
+(defparameter *fastswitch-msg* nil)
 
 (defun leave-fastswitch-mode ()
   "Leave the fastswitch mode"
@@ -91,10 +91,18 @@
     (when *fastswitch-adjust-window-p*
       (adjust-window))
     (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
+    (when *fastswitch-msg*
+      (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
+                              (xlib:max-char-width *fastswitch-font*)
+                              (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
+                              *fastswitch-msg*))
     (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter*)
                                          :background (get-color *fastswitch-background*))
       (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
-                              (xlib:max-char-width *fastswitch-font*)
+                              (* (xlib:max-char-width *fastswitch-font*)
+                                 (if *fastswitch-msg*
+                                     (1+ (length *fastswitch-msg*))
+                                     1))
                               (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
                               *fastswitch-string*))
     (display-match-child)
@@ -160,7 +168,7 @@
       (fastswitch-draw-window))))
 
 
-(defun fastswitch-do-main ()
+(defun fastswitch-select-child ()
   (with-grab-keyboard-and-pointer (92 93 66 67 t)
     (generic-mode 'fastswitch-mode 'exit-fastswitch-loop
                   :enter-function #'fastswitch-enter-function
@@ -175,7 +183,8 @@
 (defun fastswitch-mode ()
   "Switch between children with expose shortcut"
   (setf *expose-child-list* (expose-associate-keys))
-  (let ((ex-child (fastswitch-do-main)))
+  (setf *fastswitch-msg* "Select child:  ")
+  (let ((ex-child (fastswitch-select-child)))
     (when (and ex-child (expose-child-child ex-child))
       (expose-focus-child (expose-child-child ex-child))))
   (show-all-children)
@@ -183,3 +192,28 @@
 
 
 
+;;; Fastswitch move mode
+(defun fastswitch-move-mode ()
+  "Move children with expose shortcut"
+  (let ((window nil))
+    (with-focus-window (win)
+      (setf window win))
+    (no-focus)
+    (setf *expose-child-list* (expose-associate-keys))
+    (setf *fastswitch-msg* (if window
+                               (format nil "Move focused child [~A] with:  "
+                                       (child-fullname window))
+                               "No child to move...  "))
+    (let ((ex-child (fastswitch-select-child)))
+      (when (and window ex-child (expose-child-child ex-child))
+        (let ((from (find-parent-frame window))
+              (to (typecase (expose-child-child ex-child)
+                    (xlib:window (find-parent-frame (expose-child-child ex-child)))
+                    (frame (expose-child-child ex-child)))))
+          (when (and (frame-p from) (frame-p to))
+            (remove-child-in-frame window from)
+            (pushnew window (frame-child to) :test #'child-equal-p)
+            (when (child-equal-p window (current-child))
+              (focus-all-children window to))))))
+    (show-all-children))
+  t)
-- 
2.11.4.GIT