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