From b138cebe5651ee266a3d7f0ea3d6c26b9d4908e4 Mon Sep 17 00:00:00 2001 From: Philippe Brochard Date: Mon, 29 Jul 2013 22:12:42 +0200 Subject: [PATCH] Add a fastswitch mode to quickly switch in children from expose mode --- clfswm.asd | 4 + src/clfswm-expose-mode.lisp | 21 ++---- src/clfswm-fastswitch-mode.lisp | 157 ++++++++++++++++++++++++++++++++++++++++ src/config.lisp | 21 ++++++ src/package.lisp | 2 + src/tools.lisp | 8 +- 6 files changed, 194 insertions(+), 19 deletions(-) create mode 100644 src/clfswm-fastswitch-mode.lisp diff --git a/clfswm.asd b/clfswm.asd index adcef17..8c185dc 100644 --- a/clfswm.asd +++ b/clfswm.asd @@ -54,6 +54,10 @@ :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" diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp index 3083dad..c3a9814 100644 --- a/src/clfswm-expose-mode.lisp +++ b/src/clfswm-expose-mode.lisp @@ -52,15 +52,15 @@ -(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)) @@ -146,7 +146,7 @@ (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)) @@ -246,14 +246,3 @@ (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 index 0000000..4ecb73e --- /dev/null +++ b/src/clfswm-fastswitch-mode.lisp @@ -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 +;;; +;;; 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) + + + diff --git a/src/config.lisp b/src/config.lisp index 3cd3c35..09fa5b5 100644 --- a/src/config.lisp +++ b/src/config.lisp @@ -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") diff --git a/src/package.lisp b/src/package.lisp index b7d9970..f67dd03 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/tools.lisp b/src/tools.lisp index f3920f7..8fd23f4 100644 --- a/src/tools.lisp +++ b/src/tools.lisp @@ -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) -- 2.11.4.GIT