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 (defparameter *fastswitch-msg* nil)
  37
  38 (defun leave-fastswitch-mode ()
  39   "Leave the fastswitch mode"
  40   (throw 'exit-fastswitch-loop nil))
  41
  42
  43 (defun fastswitch-draw-child-name (posx posy ex-child)
  44   (let ((placey (* posy (+ (xlib:font-ascent *fastswitch-font*)
  45                            (xlib:font-descent *fastswitch-font*) 1))))
  46     (xlib:with-gcontext (*fastswitch-gc*
  47                          :foreground (get-color (if (frame-p (expose-child-child ex-child))
  48                                                     *fastswitch-foreground-letter-second-frame*
  49                                                     *fastswitch-foreground-letter-second*)))
  50       (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
  51                         (* (xlib:max-char-width *fastswitch-font*) posx)
  52                         placey
  53                         (expose-child-key ex-child)))
  54     (incf posx (length (expose-child-key ex-child)))
  55     (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
  56                       (* (xlib:max-char-width *fastswitch-font*) posx)
  57                       placey
  58                       ":")
  59     (incf posx 1)
  60     (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-childname*))
  61       (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
  62                         (* (xlib:max-char-width *fastswitch-font*) posx)
  63                         placey
  64                         (child-fullname (expose-child-child ex-child)))
  65       (incf posx (1+ (length (child-fullname (expose-child-child ex-child))))))
  66     posx))
  67
  68 (defun fastswitch-draw-window ()
  69   (labels ((display-match-child ()
  70              (let ((posx 1)
  71                    (posy 2))
  72                (dolist (ex-child *fastswitch-match-child*)
  73                  (when (or *fastswitch-show-frame-p* (not (frame-p (expose-child-child ex-child))))
  74                    (setf posx (fastswitch-draw-child-name posx posy ex-child))
  75                    (when (> (* posx (xlib:max-char-width *fastswitch-font*))
  76                             (x-drawable-width *fastswitch-window*))
  77                      (if *fastswitch-adjust-window-p*
  78                          (setf posx 1
  79                                posy (1+ posy))
  80                          (return)))))))
  81            (adjust-window ()
  82              (setf (x-drawable-height *fastswitch-window*) (* (xlib:font-ascent *fastswitch-font*) 3))
  83              (let ((posx 1)
  84                    (inc 0))
  85                (dolist (ex-child *fastswitch-match-child*)
  86                  (when (or *fastswitch-show-frame-p* (not (frame-p (expose-child-child ex-child))))
  87                    (incf posx (length (expose-child-key ex-child)))
  88                    (incf posx)
  89                    (incf posx (1+ (length (child-fullname (expose-child-child ex-child)))))
  90                    (when (> (* posx (xlib:max-char-width *fastswitch-font*))
  91                             (x-drawable-width *fastswitch-window*))
  92                      (setf posx 1)
  93                      (incf inc (+ (xlib:font-ascent *fastswitch-font*)
  94                                   (xlib:font-descent *fastswitch-font*) 1)))))
  95                (incf (x-drawable-height *fastswitch-window*) inc))))
  96     (when *fastswitch-adjust-window-p*
  97       (adjust-window))
  98     (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
  99     (when *fastswitch-msg*
 100       (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
 101                               (xlib:max-char-width *fastswitch-font*)
 102                               (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
 103                               *fastswitch-msg*))
 104     (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter*)
 105                                          :background (get-color *fastswitch-background*))
 106       (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
 107                               (* (xlib:max-char-width *fastswitch-font*)
 108                                  (if *fastswitch-msg*
 109                                      (1+ (length *fastswitch-msg*))
 110                                      1))
 111                               (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
 112                               *fastswitch-string*))
 113     (display-match-child)
 114     (copy-pixmap-buffer *fastswitch-window* *fastswitch-gc*)))
 115
 116 (defun fastswitch-draw-window-tree ()
 117   (let ((posy 2))
 118     (labels ((display-match-child (child space)
 119                (let ((ex-child (find child *expose-child-list* :test #'child-equal-p :key #'expose-child-child)))
 120                  (when ex-child
 121                    (fastswitch-draw-child-name space posy ex-child)
 122                    (incf posy)))
 123                (when (frame-p child)
 124                  (dolist (c (frame-child child))
 125                    (display-match-child c (+ space 2))))))
 126       (setf (x-drawable-height *fastswitch-window*)
 127             (+ (* (xlib:font-ascent *fastswitch-font*) 3)
 128                (* (1- (length *expose-child-list*))
 129                   (+ (xlib:font-ascent *fastswitch-font*)
 130                      (xlib:font-descent *fastswitch-font*) 1))))
 131       (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
 132       (when *fastswitch-msg*
 133         (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
 134                                 (xlib:max-char-width *fastswitch-font*)
 135                                 (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
 136                                 *fastswitch-msg*))
 137       (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter*)
 138                                            :background (get-color *fastswitch-background*))
 139         (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
 140                                 (* (xlib:max-char-width *fastswitch-font*)
 141                                    (if *fastswitch-msg*
 142                                        (1+ (length *fastswitch-msg*))
 143                                        1))
 144                                 (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
 145                                 *fastswitch-string*))
 146       (display-match-child *root-frame* 0)
 147       (copy-pixmap-buffer *fastswitch-window* *fastswitch-gc*))))
 148
 149
 150 (defun fastswitch-draw-window-generic ()
 151   (if (eq *fastswitch-display-mode* 'TREE)
 152       (fastswitch-draw-window-tree)
 153       (fastswitch-draw-window)))
 154
 155
 156
 157 (defun fastswitch-init ()
 158   (setf *fastswitch-font* (xlib:open-font *display* *fastswitch-font-string*)
 159         *fastswitch-string* ""
 160         *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
 161   (let* ((width (- (screen-width) 2))
 162          (height (* (xlib:font-ascent *fastswitch-font*) 3)))
 163     (with-placement (*fastswitch-mode-placement* x y width height)
 164       (setf *fastswitch-window* (xlib:create-window :parent *root*
 165                                                     :x x   :y y
 166                                                     :width width   :height height
 167                                                     :background (get-color *fastswitch-background*)
 168                                                     :border-width *border-size*
 169                                                     :border (get-color *fastswitch-border*)
 170                                                     :colormap (xlib:screen-default-colormap *screen*)
 171                                                     :event-mask '(:exposure :key-press))
 172             *fastswitch-gc* (xlib:create-gcontext :drawable *fastswitch-window*
 173                                                   :foreground (get-color *fastswitch-foreground*)
 174                                                   :background (get-color *fastswitch-background*)
 175                                                   :font *fastswitch-font*
 176                                                   :line-style :solid))
 177       (setf (window-transparency *fastswitch-window*) *fastswitch-transparency*)
 178       (map-window *fastswitch-window*)))
 179   (fastswitch-draw-window-generic))
 180
 181
 182 (defun fastswitch-enter-function ()
 183   (stop-button-event)
 184   (fastswitch-init))
 185
 186
 187 (defun fastswitch-leave-function ()
 188   (when *fastswitch-gc*
 189     (xlib:free-gcontext *fastswitch-gc*))
 190   (when *fastswitch-window*
 191     (xlib:destroy-window *fastswitch-window*))
 192   (when *expose-font*
 193     (xlib:close-font *expose-font*))
 194   (setf *fastswitch-window* nil
 195         *fastswitch-gc* nil
 196         *fastswitch-font* nil)
 197   (xlib:display-finish-output *display*))
 198
 199
 200 (defun fastswitch-loop-function ()
 201   (unless (is-a-key-pressed-p)
 202     (leave-fastswitch-mode)))
 203
 204 (define-handler fastswitch-mode :key-press (code state)
 205   (let ((char (keycode->char code state)))
 206     (when char
 207       (setf *fastswitch-string* (format nil "~A~A" *fastswitch-string* char)
 208             *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
 209       (unless *fastswitch-match-child*
 210         (setf *fastswitch-string* ""
 211               *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key)))
 212       (fastswitch-draw-window-generic))))
 213
 214
 215 (defun fastswitch-select-child ()
 216   (with-grab-keyboard-and-pointer (92 93 66 67 t)
 217     (generic-mode 'fastswitch-mode 'exit-fastswitch-loop
 218                   :enter-function #'fastswitch-enter-function
 219                   :loop-function #'fastswitch-loop-function
 220                   :leave-function #'fastswitch-leave-function
 221                   :original-mode '(main-mode))
 222     (fastswitch-leave-function))
 223   (expose-find-child-from-letters *fastswitch-string*))
 224
 225
 226
 227 (defun fastswitch-mode ()
 228   "Switch between children with expose shortcut"
 229   (setf *expose-child-list* (expose-associate-keys))
 230   (setf *fastswitch-msg* "Select child:  ")
 231   (let ((ex-child (fastswitch-select-child)))
 232     (when (and ex-child (expose-child-child ex-child))
 233       (expose-focus-child (expose-child-child ex-child))))
 234   (show-all-children)
 235   t)
 236
 237
 238
 239 ;;; Fastswitch move mode
 240 (defun fastswitch-move-mode ()
 241   "Move children with expose shortcut"
 242   (let ((window nil))
 243     (with-focus-window (win)
 244       (setf window win))
 245     (no-focus)
 246     (setf *expose-child-list* (expose-associate-keys))
 247     (setf *fastswitch-msg* (if window
 248                                (format nil "Move focused child [~A] with:  "
 249                                        (child-fullname window))
 250                                "No child to move...  "))
 251     (let ((ex-child (fastswitch-select-child)))
 252       (when (and window ex-child (expose-child-child ex-child))
 253         (let ((from (find-parent-frame window))
 254               (to (typecase (expose-child-child ex-child)
 255                     (xlib:window (find-parent-frame (expose-child-child ex-child)))
 256                     (frame (expose-child-child ex-child)))))
 257           (when (and (frame-p from) (frame-p to))
 258             (remove-child-in-frame window from)
 259             (pushnew window (frame-child to) :test #'child-equal-p)
 260             (focus-all-children from from)))))
 261     (show-all-children))
 262   t)