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
))
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 (when *fastswitch-msg
*
95 (xlib:draw-image-glyphs
*pixmap-buffer
* *fastswitch-gc
*
96 (xlib:max-char-width
*fastswitch-font
*)
97 (+ (xlib:font-ascent
*fastswitch-font
*) (xlib:font-descent
*fastswitch-font
*))
99 (xlib:with-gcontext
(*fastswitch-gc
* :foreground
(get-color *fastswitch-foreground-letter
*)
100 :background
(get-color *fastswitch-background
*))
101 (xlib:draw-image-glyphs
*pixmap-buffer
* *fastswitch-gc
*
102 (* (xlib:max-char-width
*fastswitch-font
*)
104 (1+ (length *fastswitch-msg
*))
106 (+ (xlib:font-ascent
*fastswitch-font
*) (xlib:font-descent
*fastswitch-font
*))
107 *fastswitch-string
*))
108 (display-match-child)
109 (copy-pixmap-buffer *fastswitch-window
* *fastswitch-gc
*)))
113 (defun fastswitch-init ()
114 (setf *fastswitch-font
* (xlib:open-font
*display
* *fastswitch-font-string
*)
115 *fastswitch-string
* ""
116 *fastswitch-match-child
* (string-match *fastswitch-string
* *expose-child-list
* #'expose-child-key
))
117 (let* ((width (- (screen-width) 2))
118 (height (* (xlib:font-ascent
*fastswitch-font
*) 3)))
119 (with-placement (*fastswitch-mode-placement
* x y width height
)
120 (setf *fastswitch-window
* (xlib:create-window
:parent
*root
*
122 :width width
:height height
123 :background
(get-color *fastswitch-background
*)
124 :border-width
*border-size
*
125 :border
(get-color *fastswitch-border
*)
126 :colormap
(xlib:screen-default-colormap
*screen
*)
127 :event-mask
'(:exposure
:key-press
))
128 *fastswitch-gc
* (xlib:create-gcontext
:drawable
*fastswitch-window
*
129 :foreground
(get-color *fastswitch-foreground
*)
130 :background
(get-color *fastswitch-background
*)
131 :font
*fastswitch-font
*
133 (setf (window-transparency *fastswitch-window
*) *fastswitch-transparency
*)
134 (map-window *fastswitch-window
*)))
135 (fastswitch-draw-window))
138 (defun fastswitch-enter-function ()
143 (defun fastswitch-leave-function ()
144 (when *fastswitch-gc
*
145 (xlib:free-gcontext
*fastswitch-gc
*))
146 (when *fastswitch-window
*
147 (xlib:destroy-window
*fastswitch-window
*))
149 (xlib:close-font
*expose-font
*))
150 (setf *fastswitch-window
* nil
152 *fastswitch-font
* nil
)
153 (xlib:display-finish-output
*display
*))
156 (defun fastswitch-loop-function ()
157 (unless (is-a-key-pressed-p)
158 (leave-fastswitch-mode)))
160 (define-handler fastswitch-mode
:key-press
(code state
)
161 (let ((char (keycode->char code state
)))
163 (setf *fastswitch-string
* (format nil
"~A~A" *fastswitch-string
* char
)
164 *fastswitch-match-child
* (string-match *fastswitch-string
* *expose-child-list
* #'expose-child-key
))
165 (unless *fastswitch-match-child
*
166 (setf *fastswitch-string
* ""
167 *fastswitch-match-child
* (string-match *fastswitch-string
* *expose-child-list
* #'expose-child-key
)))
168 (fastswitch-draw-window))))
171 (defun fastswitch-select-child ()
172 (with-grab-keyboard-and-pointer (92 93 66 67 t
)
173 (generic-mode 'fastswitch-mode
'exit-fastswitch-loop
174 :enter-function
#'fastswitch-enter-function
175 :loop-function
#'fastswitch-loop-function
176 :leave-function
#'fastswitch-leave-function
177 :original-mode
'(main-mode))
178 (fastswitch-leave-function))
179 (expose-find-child-from-letters *fastswitch-string
*))
183 (defun fastswitch-mode ()
184 "Switch between children with expose shortcut"
185 (setf *expose-child-list
* (expose-associate-keys))
186 (setf *fastswitch-msg
* "Select child: ")
187 (let ((ex-child (fastswitch-select-child)))
188 (when (and ex-child
(expose-child-child ex-child
))
189 (expose-focus-child (expose-child-child ex-child
))))
195 ;;; Fastswitch move mode
196 (defun fastswitch-move-mode ()
197 "Move children with expose shortcut"
199 (with-focus-window (win)
202 (setf *expose-child-list
* (expose-associate-keys))
203 (setf *fastswitch-msg
* (if window
204 (format nil
"Move focused child [~A] with: "
205 (child-fullname window
))
206 "No child to move... "))
207 (let ((ex-child (fastswitch-select-child)))
208 (when (and window ex-child
(expose-child-child ex-child
))
209 (let ((from (find-parent-frame window
))
210 (to (typecase (expose-child-child ex-child
)
211 (xlib:window
(find-parent-frame (expose-child-child ex-child
)))
212 (frame (expose-child-child ex-child
)))))
213 (when (and (frame-p from
) (frame-p to
))
214 (remove-child-in-frame window from
)
215 (pushnew window
(frame-child to
) :test
#'child-equal-p
)
216 (focus-all-children from from
)))))