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 ((posx 1)
  47                    (posy 2))
  48                (dolist (ex-child *fastswitch-match-child*)
  49                  (when (or *fastswitch-show-frame-p* (not (frame-p (expose-child-child ex-child))))
  50                    (xlib:with-gcontext (*fastswitch-gc*
  51                                         :foreground (get-color (if (frame-p (expose-child-child ex-child))
  52                                                                    *fastswitch-foreground-letter-second-frame*
  53                                                                    *fastswitch-foreground-letter-second*)))
  54                      (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
  55                                        (* (xlib:max-char-width *fastswitch-font*) posx)
  56                                        (+ (* posy (xlib:font-ascent *fastswitch-font*))
  57                                           (xlib:font-descent *fastswitch-font*) 1)
  58                                        (expose-child-key ex-child)))
  59                    (incf posx (length (expose-child-key ex-child)))
  60                    (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
  61                                      (* (xlib:max-char-width *fastswitch-font*) posx)
  62                                      (+ (* posy (xlib:font-ascent *fastswitch-font*))
  63                                         (xlib:font-descent *fastswitch-font*) 1)
  64                                      ":")
  65                    (incf posx)
  66                    (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-childname*))
  67                      (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
  68                                        (* (xlib:max-char-width *fastswitch-font*) posx)
  69                                        (+ (* posy (xlib:font-ascent *fastswitch-font*))
  70                                           (xlib:font-descent *fastswitch-font*) 1)
  71                                        (child-fullname (expose-child-child ex-child)))
  72                      (incf posx (1+ (length (child-fullname (expose-child-child ex-child))))))
  73                    (when (> (* posx (xlib:max-char-width *fastswitch-font*))
  74                             (x-drawable-width *fastswitch-window*))
  75                      (if *fastswitch-adjust-window-p*
  76                          (setf posx 1
  77                                posy (1+ posy))
  78                          (return)))))))
  79            (adjust-window ()
  80              (setf (x-drawable-height *fastswitch-window*) (* (xlib:font-ascent *fastswitch-font*) 3))
  81              (let ((posx 1))
  82                (dolist (ex-child *fastswitch-match-child*)
  83                  (when (or *fastswitch-show-frame-p* (not (frame-p (expose-child-child ex-child))))
  84                    (incf posx (length (expose-child-key ex-child)))
  85                    (incf posx)
  86                    (incf posx (1+ (length (child-fullname (expose-child-child ex-child)))))
  87                    (when (> (* posx (xlib:max-char-width *fastswitch-font*))
  88                             (x-drawable-width *fastswitch-window*))
  89                      (setf posx 1)
  90                      (incf (x-drawable-height *fastswitch-window*) (xlib:font-ascent *fastswitch-font*))))))))
  91     (when *fastswitch-adjust-window-p*
  92       (adjust-window))
  93     (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
  94     (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter*)
  95                                          :background (get-color *fastswitch-background*))
  96       (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
  97                               (xlib:max-char-width *fastswitch-font*)
  98                               (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
  99                               *fastswitch-string*))
 100     (display-match-child)
 101     (copy-pixmap-buffer *fastswitch-window* *fastswitch-gc*)))
 102
 103
 104
 105 (defun fastswitch-init ()
 106   (setf *fastswitch-font* (xlib:open-font *display* *fastswitch-font-string*)
 107         *fastswitch-string* ""
 108         *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
 109   (let* ((width (- (screen-width) 2))
 110          (height (* (xlib:font-ascent *fastswitch-font*) 3)))
 111     (with-placement (*fastswitch-mode-placement* x y width height)
 112       (setf *fastswitch-window* (xlib:create-window :parent *root*
 113                                                     :x x   :y y
 114                                                     :width width   :height height
 115                                                     :background (get-color *fastswitch-background*)
 116                                                     :border-width *border-size*
 117                                                     :border (get-color *fastswitch-border*)
 118                                                     :colormap (xlib:screen-default-colormap *screen*)
 119                                                     :event-mask '(:exposure :key-press))
 120             *fastswitch-gc* (xlib:create-gcontext :drawable *fastswitch-window*
 121                                                   :foreground (get-color *fastswitch-foreground*)
 122                                                   :background (get-color *fastswitch-background*)
 123                                                   :font *fastswitch-font*
 124                                                   :line-style :solid))
 125       (setf (window-transparency *fastswitch-window*) *fastswitch-transparency*)
 126       (map-window *fastswitch-window*)))
 127   (fastswitch-draw-window))
 128
 129
 130 (defun fastswitch-enter-function ()
 131   (stop-button-event)
 132   (fastswitch-init))
 133
 134
 135 (defun fastswitch-leave-function ()
 136   (when *fastswitch-gc*
 137     (xlib:free-gcontext *fastswitch-gc*))
 138   (when *fastswitch-window*
 139     (xlib:destroy-window *fastswitch-window*))
 140   (when *expose-font*
 141     (xlib:close-font *expose-font*))
 142   (setf *fastswitch-window* nil
 143         *fastswitch-gc* nil
 144         *fastswitch-font* nil)
 145   (xlib:display-finish-output *display*))
 146
 147
 148 (defun fastswitch-loop-function ()
 149   (unless (is-a-key-pressed-p)
 150     (leave-fastswitch-mode)))
 151
 152 (define-handler fastswitch-mode :key-press (code state)
 153   (let ((char (keycode->char code state)))
 154     (when char
 155       (setf *fastswitch-string* (format nil "~A~A" *fastswitch-string* char)
 156             *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
 157       (unless *fastswitch-match-child*
 158         (setf *fastswitch-string* ""
 159               *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key)))
 160       (fastswitch-draw-window))))
 161
 162
 163 (defun fastswitch-do-main ()
 164   (with-grab-keyboard-and-pointer (92 93 66 67 t)
 165     (generic-mode 'fastswitch-mode 'exit-fastswitch-loop
 166                   :enter-function #'fastswitch-enter-function
 167                   :loop-function #'fastswitch-loop-function
 168                   :leave-function #'fastswitch-leave-function
 169                   :original-mode '(main-mode))
 170     (fastswitch-leave-function))
 171   (expose-find-child-from-letters *fastswitch-string*))
 172
 173
 174
 175 (defun fastswitch-mode ()
 176   "Switch between children with expose shortcut"
 177   (setf *expose-child-list* (expose-associate-keys))
 178   (let ((ex-child (fastswitch-do-main)))
 179     (when (and ex-child (expose-child-child ex-child))
 180       (expose-focus-child (expose-child-child ex-child))))
 181   (show-all-children)
 182   t)
 183
 184
 185