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
)
36 (defparameter *fastswitch-msg
* nil
)
38 (defun leave-fastswitch-mode ()
39 "Leave the fastswitch mode"
40 (throw 'exit-fastswitch-loop nil
))
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
)
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
)
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
)
64 (ensure-printable (child-fullname (expose-child-child ex-child
))))
65 (incf posx
(1+ (length (child-fullname (expose-child-child ex-child
))))))
68 (defun fastswitch-draw-window ()
69 (labels ((display-match-child ()
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
*
82 (setf (x-drawable-height *fastswitch-window
*) (* (xlib:font-ascent
*fastswitch-font
*) 3))
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
)))
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
*))
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
*
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
*))
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
*)
109 (1+ (length *fastswitch-msg
*))
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
*)))
116 (defun fastswitch-draw-window-tree ()
118 (labels ((display-match-child (child space
)
119 (let ((ex-child (find child
*expose-child-list
* :test
#'child-equal-p
:key
#'expose-child-child
)))
121 (fastswitch-draw-child-name space posy ex-child
)
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
*))
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
*)
142 (1+ (length *fastswitch-msg
*))
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
*))))
150 (defun fastswitch-draw-window-generic ()
151 (if (eq *fastswitch-display-mode
* 'TREE
)
152 (fastswitch-draw-window-tree)
153 (fastswitch-draw-window)))
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
*
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
*
177 (setf (window-transparency *fastswitch-window
*) *fastswitch-transparency
*)
178 (map-window *fastswitch-window
*)))
179 (fastswitch-draw-window-generic))
182 (defun fastswitch-enter-function ()
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
*))
193 (xlib:close-font
*expose-font
*))
194 (setf *fastswitch-window
* nil
196 *fastswitch-font
* nil
)
197 (xlib:display-finish-output
*display
*))
200 (defun fastswitch-loop-function ()
201 (unless (is-a-key-pressed-p)
202 (leave-fastswitch-mode)))
204 (define-handler fastswitch-mode
:key-press
(code state
)
205 (let ((char (keycode->char code state
)))
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))))
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
*))
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
))))
239 ;;; Fastswitch move mode
240 (defun fastswitch-move-mode ()
241 "Move children with expose shortcut"
243 (with-focus-window (win)
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
)))))