1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
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 ;;; --------------------------------------------------------------------------
11 ;;; (C) 2005-2013 Philippe Brochard <pbrochard@common-lisp.net>
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.
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.
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.
27 ;;; --------------------------------------------------------------------------
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
)
38 (defun leave-fastswitch-mode ()
39 "Leave the fastswitch mode"
40 (throw 'exit-fastswitch-loop nil
))
44 (defun fastswitch-draw-window ()
45 (labels ((display-match-child ()
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)
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
*
80 (setf (x-drawable-height *fastswitch-window
*) (* (xlib:font-ascent
*fastswitch-font
*) 3))
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
)))
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
*))
90 (incf (x-drawable-height *fastswitch-window
*) (xlib:font-ascent
*fastswitch-font
*))))))))
91 (when *fastswitch-adjust-window-p
*
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
*))
100 (display-match-child)
101 (copy-pixmap-buffer *fastswitch-window
* *fastswitch-gc
*)))
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
*
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
*
125 (setf (window-transparency *fastswitch-window
*) *fastswitch-transparency
*)
126 (map-window *fastswitch-window
*)))
127 (fastswitch-draw-window))
130 (defun fastswitch-enter-function ()
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
*))
141 (xlib:close-font
*expose-font
*))
142 (setf *fastswitch-window
* nil
144 *fastswitch-font
* nil
)
145 (xlib:display-finish-output
*display
*))
148 (defun fastswitch-loop-function ()
149 (unless (is-a-key-pressed-p)
150 (leave-fastswitch-mode)))
152 (define-handler fastswitch-mode
:key-press
(code state
)
153 (let ((char (keycode->char code state
)))
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))))
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
*))
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
))))