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