dad41310d552e464371ce4c97794c9924f39a370
[clfswm.git] / src / clfswm-fastswitch-mode.lisp
blobdad41310d552e464371ce4c97794c9924f39a370
1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
3 ;;;
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 ;;; --------------------------------------------------------------------------
10 ;;;
11 ;;; (C) 2005-2013 Philippe Brochard <pbrochard@common-lisp.net>
12 ;;;
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.
17 ;;;
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.
22 ;;;
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.
26 ;;;
27 ;;; --------------------------------------------------------------------------
29 (in-package :clfswm)
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 ()
46 (let ((posx 1)
47 (posy 2))
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)
64 ":")
65 (incf posx)
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*
76 (setf posx 1
77 posy (1+ posy))
78 (return)))))))
79 (adjust-window ()
80 (setf (x-drawable-height *fastswitch-window*) (* (xlib:font-ascent *fastswitch-font*) 3))
81 (let ((posx 1))
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)))
85 (incf posx)
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*))
89 (setf posx 1)
90 (incf (x-drawable-height *fastswitch-window*) (xlib:font-ascent *fastswitch-font*))))))))
91 (when *fastswitch-adjust-window-p*
92 (adjust-window))
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*))
98 *fastswitch-msg*))
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*)
103 (if *fastswitch-msg*
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*
121 :x x :y y
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*
132 :line-style :solid))
133 (setf (window-transparency *fastswitch-window*) *fastswitch-transparency*)
134 (map-window *fastswitch-window*)))
135 (fastswitch-draw-window))
138 (defun fastswitch-enter-function ()
139 (stop-button-event)
140 (fastswitch-init))
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*))
148 (when *expose-font*
149 (xlib:close-font *expose-font*))
150 (setf *fastswitch-window* nil
151 *fastswitch-gc* 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)))
162 (when char
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))))
190 (show-all-children)
195 ;;; Fastswitch move mode
196 (defun fastswitch-move-mode ()
197 "Move children with expose shortcut"
198 (let ((window nil))
199 (with-focus-window (win)
200 (setf window win))
201 (no-focus)
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 (when (child-equal-p window (current-child))
217 (focus-all-children window to))))))
218 (show-all-children))