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 ()
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)
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
*))
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
*))
78 (copy-pixmap-buffer *fastswitch-window
* *fastswitch-gc
*)))
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
*
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
*
102 (setf (window-transparency *fastswitch-window
*) *fastswitch-transparency
*)
103 (map-window *fastswitch-window
*)))
104 (fastswitch-draw-window))
107 (defun fastswitch-enter-function ()
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
*))
118 (xlib:close-font
*expose-font
*))
119 (setf *fastswitch-window
* nil
121 *fastswitch-font
* nil
)
122 (xlib:display-finish-output
*display
*))
125 (defun fastswitch-loop-function ()
126 (unless (is-a-key-pressed-p)
127 (leave-fastswitch-mode)))
129 (define-handler fastswitch-mode
:key-press
(code state
)
130 (let ((char (keycode->char code state
)))
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))))
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
*))
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
))))