src/clfswm-fastswitch-mode.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Fast switch mode - Like expose mode but faster since
   6 ;;; children are not moved/resized. Shortcut key is associated to Xid for
   7 ;;; windows and to numbers for frames.
   8 ;;; A window or a frame will always have the same shortcut.
   9 ;;; --------------------------------------------------------------------------
  10 ;;;
  11 ;;; (C) 2005-2013 Philippe Brochard <pbrochard@common-lisp.net>
  12 ;;;
  13 ;;; This program is free software; you can redistribute it and/or modify
  14 ;;; it under the terms of the GNU General Public License as published by
  15 ;;; the Free Software Foundation; either version 3 of the License, or
  16 ;;; (at your option) any later version.
  17 ;;;
  18 ;;; This program is distributed in the hope that it will be useful,
  19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;;; GNU General Public License for more details.
  22 ;;;
  23 ;;; You should have received a copy of the GNU General Public License
  24 ;;; along with this program; if not, write to the Free Software
  25 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  26 ;;;
  27 ;;; --------------------------------------------------------------------------
  28
  29 (in-package :clfswm)
  30
  31 (defparameter *fastswitch-window* nil)
  32 (defparameter *fastswitch-gc* nil)
  33 (defparameter *fastswitch-font* nil)
  34 (defparameter *fastswitch-string* "")
  35 (defparameter *fastswitch-match-child* nil)
  36
  37
  38 (defun leave-fastswitch-mode ()
  39   "Leave the fastswitch mode"
  40   (throw 'exit-fastswitch-loop nil))
  41
  42
  43
  44 (defun fastswitch-draw-window ()
  45   (labels ((display-match-child ()
  46              (let ((pos 1))
  47                (dolist (ex-child *fastswitch-match-child*)
  48                  (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter-second*))
  49                    (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
  50                                      (* (xlib:max-char-width *fastswitch-font*) pos)
  51                                      (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
  52                                      (expose-child-key ex-child)))
  53                  (incf pos (length (expose-child-key ex-child)))
  54                  (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
  55                                    (* (xlib:max-char-width *fastswitch-font*) pos)
  56                                    (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
  57                                    ":")
  58                  (incf pos)
  59                  (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-childname*))
  60                    (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
  61                                      (* (xlib:max-char-width *fastswitch-font*) pos)
  62                                      (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
  63                                      (child-fullname (expose-child-child ex-child)))
  64                    (incf pos (1+ (length (child-fullname (expose-child-child ex-child))))))))))
  65     (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
  66     (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter*)
  67                                          :background (get-color *fastswitch-background*))
  68       (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
  69                               (xlib:max-char-width *fastswitch-font*)
  70                               (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
  71                               *fastswitch-string*))
  72     (display-match-child)
  73     (copy-pixmap-buffer *fastswitch-window* *fastswitch-gc*)))
  74
  75
  76
  77 (defun fastswitch-init ()
  78   (setf *fastswitch-font* (xlib:open-font *display* *fastswitch-font-string*)
  79         *fastswitch-string* ""
  80         *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
  81   (let* ((width (- (xlib:screen-width *screen*) 2)) ;;(* (xlib:max-char-width *fastswitch-font*) 3))
  82          (height (* (xlib:font-ascent *fastswitch-font*) 3)))
  83     (with-placement (*fastswitch-mode-placement* x y width height)
  84       (setf *fastswitch-window* (xlib:create-window :parent *root*
  85                                                     :x x   :y y
  86                                                     :width width   :height height
  87                                                     :background (get-color *fastswitch-background*)
  88                                                     :border-width *border-size*
  89                                                     :border (get-color *fastswitch-border*)
  90                                                     :colormap (xlib:screen-default-colormap *screen*)
  91                                                     :event-mask '(:exposure :key-press))
  92             *fastswitch-gc* (xlib:create-gcontext :drawable *fastswitch-window*
  93                                                   :foreground (get-color *fastswitch-foreground*)
  94                                                   :background (get-color *fastswitch-background*)
  95                                                   :font *fastswitch-font*
  96                                                   :line-style :solid))
  97       (setf (window-transparency *fastswitch-window*) *fastswitch-transparency*)
  98       (map-window *fastswitch-window*)))
  99   (fastswitch-draw-window))
 100
 101
 102 (defun fastswitch-enter-function ()
 103   (stop-button-event)
 104   (fastswitch-init))
 105
 106
 107 (defun fastswitch-leave-function ()
 108   (when *fastswitch-gc*
 109     (xlib:free-gcontext *fastswitch-gc*))
 110   (when *fastswitch-window*
 111     (xlib:destroy-window *fastswitch-window*))
 112   (when *expose-font*
 113     (xlib:close-font *expose-font*))
 114   (setf *fastswitch-window* nil
 115         *fastswitch-gc* nil
 116         *fastswitch-font* nil)
 117   (xlib:display-finish-output *display*))
 118
 119
 120 (defun fastswitch-loop-function ()
 121   (unless (is-a-key-pressed-p)
 122     (leave-fastswitch-mode)))
 123
 124 (define-handler fastswitch-mode :key-press (code state)
 125   (let ((char (keycode->char code state)))
 126     (when char
 127       (setf *fastswitch-string* (format nil "~A~A" *fastswitch-string* char)
 128             *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
 129       (unless *fastswitch-match-child*
 130         (setf *fastswitch-string* ""
 131               *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key)))
 132       (fastswitch-draw-window))))
 133
 134
 135 (defun fastswitch-do-main ()
 136   (with-grab-keyboard-and-pointer (92 93 66 67 t)
 137     (generic-mode 'fastswitch-mode 'exit-fastswitch-loop
 138                   :enter-function #'fastswitch-enter-function
 139                   :loop-function #'fastswitch-loop-function
 140                   :leave-function #'fastswitch-leave-function
 141                   :original-mode '(main-mode))
 142     (fastswitch-leave-function))
 143   (expose-find-child-from-letters *fastswitch-string*))
 144
 145
 146
 147 (defun fastswitch-mode ()
 148   "Switch between children with expose shortcut"
 149   (setf *expose-child-list* (expose-associate-keys))
 150   (let ((ex-child (fastswitch-do-main)))
 151     (when (and ex-child (expose-child-child ex-child))
 152       (expose-focus-child (expose-child-child ex-child))))
 153   (show-all-children)
 154   t)
 155
 156
 157