Add a fastswitch mode to quickly switch in children from expose mode
authorPhilippe Brochard <pbrochard@common-lisp.net>
Mon, 29 Jul 2013 20:12:42 +0000 (29 22:12 +0200)
committerPhilippe Brochard <pbrochard@common-lisp.net>
Mon, 29 Jul 2013 20:12:42 +0000 (29 22:12 +0200)
clfswm.asd
src/clfswm-expose-mode.lisp
src/clfswm-fastswitch-mode.lisp [new file with mode: 0644]
src/config.lisp
src/package.lisp
src/tools.lisp

index adcef17..8c185dc 100644 (file)
                                :depends-on ("package" "config" "clfswm-internal" "xlib-util" "tools"
                                                        "clfswm-keys" "clfswm-generic-mode" "clfswm-placement"
                                                        "clfswm-query"))
+                         (:file "clfswm-fastswitch-mode"
+                                :depends-on ("package" "config" "clfswm-internal" "xlib-util" "tools"
+                                                       "clfswm-keys" "clfswm-generic-mode" "clfswm-placement"
+                                                       "clfswm-expose-mode"))
                         (:file "clfswm-corner"
                                :depends-on ("package" "config" "clfswm-internal" "clfswm-expose-mode" "xlib-util"))
                         (:file "clfswm-info"
index 3083dad..c3a9814 100644 (file)
 
 
 
-(defun fastswitch-sort (predicate type)
+(defun expose-sort (predicate type)
   (lambda (x y)
     (funcall predicate (funcall type x) (funcall type y))))
 
-(defun fastswitch-associate-keys ()
+(defun expose-associate-keys ()
   (let* ((acc nil)
          (n 0)
-         (win-list (sort (get-all-windows) (fastswitch-sort #'< #'xlib:window-id)))
-         (frame-list (sort (get-all-frames) (fastswitch-sort #'< #'frame-number))))
+         (win-list (sort (get-all-windows) (expose-sort #'< #'xlib:window-id)))
+         (frame-list (sort (get-all-frames) (expose-sort #'< #'frame-number))))
     (loop for c in win-list
        do (push (make-expose-child :child c :key (number->letter n)) acc)
          (incf n))
 
 (defun expose-init ()
   (setf *expose-font* (xlib:open-font *display* *expose-font-string*)
-       *expose-child-list* (fastswitch-associate-keys)
+       *expose-child-list* (expose-associate-keys)
        *expose-selected-child* nil
         *query-string* "")
   (xlib:warp-pointer *root* (truncate (/ (xlib:screen-width *screen*) 2))
       (expose-focus-child child)))
   (show-all-children)
   t)
-
-
-
-;;;
-;;; Fast switch mode
-;;;
-;;; Expose shortcut
-;;;
-
-(defun fastswitch-mode ()
-  (dbg 'todo))
diff --git a/src/clfswm-fastswitch-mode.lisp b/src/clfswm-fastswitch-mode.lisp
new file mode 100644 (file)
index 0000000..4ecb73e
--- /dev/null
@@ -0,0 +1,157 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Fast switch mode - Like expose mode but faster since
+;;; children are not moved/resized. Shortcut key is associated to Xid for
+;;; windows and to numbers for frames.
+;;; A window or a frame will always have the same shortcut.
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2012 Philippe Brochard <pbrochard@common-lisp.net>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(defparameter *fastswitch-window* nil)
+(defparameter *fastswitch-gc* nil)
+(defparameter *fastswitch-font* nil)
+(defparameter *fastswitch-string* "")
+(defparameter *fastswitch-match-child* nil)
+
+
+(defun leave-fastswitch-mode ()
+  "Leave the fastswitch mode"
+  (throw 'exit-fastswitch-loop nil))
+
+
+
+(defun fastswitch-draw-window ()
+  (labels ((display-match-child ()
+             (let ((pos 1))
+               (dolist (ex-child *fastswitch-match-child*)
+                 (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter-second*))
+                   (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
+                                     (* (xlib:max-char-width *fastswitch-font*) pos)
+                                     (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
+                                     (expose-child-key ex-child)))
+                 (incf pos (length (expose-child-key ex-child)))
+                 (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
+                                   (* (xlib:max-char-width *fastswitch-font*) pos)
+                                   (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
+                                   ":")
+                 (incf pos)
+                 (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-childname*))
+                   (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
+                                     (* (xlib:max-char-width *fastswitch-font*) pos)
+                                     (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
+                                     (child-fullname (expose-child-child ex-child)))
+                   (incf pos (1+ (length (child-fullname (expose-child-child ex-child))))))))))
+    (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
+    (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:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
+                              *fastswitch-string*))
+    (display-match-child)
+    (copy-pixmap-buffer *fastswitch-window* *fastswitch-gc*)))
+
+
+
+(defun fastswitch-init ()
+  (setf *fastswitch-font* (xlib:open-font *display* *fastswitch-font-string*)
+        *fastswitch-string* ""
+        *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
+  (let* ((width (- (xlib:screen-width *screen*) 2)) ;;(* (xlib:max-char-width *fastswitch-font*) 3))
+         (height (* (xlib:font-ascent *fastswitch-font*) 3)))
+    (with-placement (*fastswitch-mode-placement* x y width height)
+      (setf *fastswitch-window* (xlib:create-window :parent *root*
+                                                    :x x   :y y
+                                                    :width width   :height height
+                                                    :background (get-color *fastswitch-background*)
+                                                    :border-width *border-size*
+                                                    :border (get-color *fastswitch-border*)
+                                                    :colormap (xlib:screen-default-colormap *screen*)
+                                                    :event-mask '(:exposure :key-press))
+            *fastswitch-gc* (xlib:create-gcontext :drawable *fastswitch-window*
+                                                  :foreground (get-color *fastswitch-foreground*)
+                                                  :background (get-color *fastswitch-background*)
+                                                  :font *fastswitch-font*
+                                                  :line-style :solid))
+      (setf (window-transparency *fastswitch-window*) *fastswitch-transparency*)
+      (map-window *fastswitch-window*)))
+  (fastswitch-draw-window))
+
+
+(defun fastswitch-enter-function ()
+  (stop-button-event)
+  (fastswitch-init))
+
+
+(defun fastswitch-leave-function ()
+  (when *fastswitch-gc*
+    (xlib:free-gcontext *fastswitch-gc*))
+  (when *fastswitch-window*
+    (xlib:destroy-window *fastswitch-window*))
+  (when *expose-font*
+    (xlib:close-font *expose-font*))
+  (setf *fastswitch-window* nil
+       *fastswitch-gc* nil
+       *fastswitch-font* nil)
+  (xlib:display-finish-output *display*))
+
+
+(defun fastswitch-loop-function ()
+  (unless (is-a-key-pressed-p)
+    (leave-fastswitch-mode)))
+
+(define-handler fastswitch-mode :key-press (code state)
+  (let ((char (keycode->char code state)))
+    (when char
+      (setf *fastswitch-string* (format nil "~A~A" *fastswitch-string* char)
+            *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
+      (unless *fastswitch-match-child*
+        (setf *fastswitch-string* ""
+              *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key)))
+      (fastswitch-draw-window))))
+
+
+(defun fastswitch-do-main ()
+  (with-grab-keyboard-and-pointer (92 93 66 67 t)
+    (generic-mode 'fastswitch-mode 'exit-fastswitch-loop
+                  :enter-function #'fastswitch-enter-function
+                  :loop-function #'fastswitch-loop-function
+                  :leave-function #'fastswitch-leave-function
+                  :original-mode '(main-mode))
+    (fastswitch-leave-function))
+  (expose-find-child-from-letters *fastswitch-string*))
+
+
+
+(defun fastswitch-mode ()
+  "Switch between children with expose shortcut"
+  (setf *expose-child-list* (expose-associate-keys))
+  (let ((ex-child (fastswitch-do-main)))
+    (when (and ex-child (expose-child-child ex-child))
+      (expose-focus-child (expose-child-child ex-child))))
+  (show-all-children)
+  t)
+
+
+
index 3cd3c35..09fa5b5 100644 (file)
@@ -338,6 +338,27 @@ on the root window in the main mode with the mouse")
   'Expose-mode "Immediately select child if they can be directly accessed")
 
 
+;;; CONFIG - Fastswitch string colors
+(defconfig *fastswitch-font-string* *default-font-string*
+  'Fastswitch-mode "Fastswitch string window font string")
+(defconfig *fastswitch-background* "grey10"
+  'Fastswitch-mode "Fastswitch string window background color")
+(defconfig *fastswitch-foreground* "grey50"
+  'Fastswitch-mode "Fastswitch string window foreground color")
+(defconfig *fastswitch-foreground-letter* "red"
+  'Fastswitch-mode "Fastswitch string window foreground color for letters")
+(defconfig *fastswitch-foreground-letter-second* "magenta"
+  'Fastswitch-mode "Fastswitch string window foreground color for letters")
+(defconfig *fastswitch-foreground-childname* "grey70"
+  'Fastswitch-mode "Fastswitch string window foreground color for childname")
+(defconfig *fastswitch-border* "grey20"
+  'Fastswitch-mode "Fastswitch string window border color")
+(defconfig *fastswitch-transparency* 0.9
+  'Fastswitch-mode "Fastswitch string window background transparency")
+
+
+
+
 ;;; CONFIG - Show key binding colors
 (defconfig *info-color-title* "Magenta"
   'Info-mode "Colored info title color")
index b7d9970..f67dd03 100644 (file)
@@ -251,6 +251,8 @@ loading configuration file and before opening the display.")
   'Placement "Expose mode window placement (Selection keys position)")
 (defconfig *expose-query-placement* 'bottom-left-root-placement
   'Placement "Expose mode query window placement")
+(defconfig *fastswitch-mode-placement* 'top-left-root-placement
+  'Placement "Fastswitch mode window placement")
 (defconfig *notify-window-placement* 'bottom-right-root-placement
   'Placement "Notify window placement")
 (defconfig *ask-close/kill-placement* 'top-right-root-placement
index f3920f7..8fd23f4 100644 (file)
@@ -567,13 +567,15 @@ Return the result of the last hook"
 (defun substring-equal (substring string)
   (string-equal substring (subseq string 0 (min (length substring) (length string)))))
 
-(defun string-match (match list)
+(defun string-match (match list &optional key)
   "Return the string in list witch match the match string"
   (let ((len (length match)))
     (remove-duplicates (remove-if-not (lambda (x)
                                         (string-equal match (subseq x 0 (min len (length x)))))
-                                      list)
-                       :test #'string-equal)))
+                                      list
+                                      :key key)
+                       :test #'string-equal
+                       :key key)))
 
 
 (defun extented-alphanumericp (char)