1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Expose functions - An expose like.
6 ;;; --------------------------------------------------------------------------
8 ;;; (C) 2011 Philippe Brochard <hocwp@free.fr>
10 ;;; This program is free software; you can redistribute it and/or modify
11 ;;; it under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 3 of the License, or
13 ;;; (at your option) any later version.
15 ;;; This program is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with this program; if not, write to the Free Software
22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
24 ;;; --------------------------------------------------------------------------
28 (defparameter *expose-font
* nil
)
29 (defparameter *expose-windows-list
* nil
)
30 (defparameter *expose-selected-child
* nil
)
32 (defun leave-expose-mode ()
33 "Leave the expose mode"
34 (throw 'exit-expose-loop nil
))
36 (defun valid-expose-mode ()
37 "Valid the expose mode"
38 (throw 'exit-expose-loop t
))
40 (defun mouse-leave-expose-mode (window root-x root-y
)
41 "Leave the expose mode"
42 (declare (ignore window root-x root-y
))
43 (throw 'exit-expose-loop nil
))
45 (defun mouse-valid-expose-mode (window root-x root-y
)
46 "Valid the expose mode"
47 (declare (ignore window root-x root-y
))
48 (throw 'exit-expose-loop t
))
51 (define-handler expose-mode
:key-press
(code state
)
52 (funcall-key-from-code *expose-keys
* code state
))
54 (define-handler expose-mode
:button-press
(code state window root-x root-y
)
55 (funcall-button-from-code *expose-mouse
* code state window root-x root-y
*fun-press
*))
57 (define-handler expose-mode
:exposure
()
61 (add-hook *binding-hook
* 'set-default-expose-keys
)
63 (defun set-default-expose-keys ()
64 (define-expose-key ("Escape") 'leave-expose-mode
)
65 (define-expose-key ("g" :control
) 'leave-expose-mode
)
66 (define-expose-key ("Escape" :alt
) 'leave-expose-mode
)
67 (define-expose-key ("g" :control
:alt
) 'leave-expose-mode
)
68 (define-expose-key ("Return") 'valid-expose-mode
)
69 (define-expose-key ("space") 'valid-expose-mode
)
70 (define-expose-key ("Tab") 'valid-expose-mode
)
71 (define-expose-key ("Right") 'speed-mouse-right
)
72 (define-expose-key ("Left") 'speed-mouse-left
)
73 (define-expose-key ("Down") 'speed-mouse-down
)
74 (define-expose-key ("Up") 'speed-mouse-up
)
75 (define-expose-key ("Left" :control
) 'speed-mouse-undo
)
76 (define-expose-key ("Up" :control
) 'speed-mouse-first-history
)
77 (define-expose-key ("Down" :control
) 'speed-mouse-reset
)
78 (define-expose-mouse (1) 'mouse-valid-expose-mode
)
79 (define-expose-mouse (2) 'mouse-leave-expose-mode
)
80 (define-expose-mouse (3) 'mouse-leave-expose-mode
))
82 (defmacro define-expose-letter-keys
()
83 (labels ((produce-name (n)
84 (create-symbol "%" "expose-fun-key-" n
"%")))
86 ,@(loop for n from
0 to
61
88 (defun ,(produce-name n
) ()
89 ,(format nil
"Select child '~A' (~A)" (number->string n
) n
)
90 (let ((child (nth ,n
*expose-windows-list
*)))
92 (xlib:warp-pointer
*root
* (x-drawable-x (first child
)) (x-drawable-y (first child
)))
93 (setf *expose-selected-child
* (fourth child
))
94 (when *expose-valid-on-key
*
95 (valid-expose-mode)))))
96 (define-expose-key (,(number->string n
)) ',(produce-name n
)))))))
98 (define-expose-letter-keys)
101 (defun expose-draw-letter ()
102 (loop for lwin in
*expose-windows-list
* do
103 (xlib:draw-glyphs
(first lwin
) (second lwin
)
104 (xlib:max-char-width
*expose-font
*)
105 (+ (xlib:font-ascent
*expose-font
*) (xlib:font-descent
*expose-font
*))
108 (defun expose-create-window (child n
)
109 (with-current-child (child)
110 (let* ((string (format nil
"~A~A" (number->string n
)
111 (if *expose-show-window-title
*
112 (format nil
" - ~A" (ensure-printable (child-fullname child
)))
114 (width (if *expose-show-window-title
*
115 (min (* (xlib:max-char-width
*expose-font
*) (+ (length string
) 2))
116 (- (child-width child
) 4))
117 (* (xlib:max-char-width
*expose-font
*) 3)))
118 (height (* (xlib:font-ascent
*expose-font
*) 2)))
119 (with-placement (*expose-mode-placement
* x y width height
)
120 (let* ((window (xlib:create-window
:parent
*root
*
122 :width width
:height height
123 :background
(get-color *expose-background
*)
124 :border-width
*border-size
*
125 :border
(get-color *expose-border
*)
126 :colormap
(xlib:screen-default-colormap
*screen
*)
127 :event-mask
'(:exposure
:key-press
)))
128 (gc (xlib:create-gcontext
:drawable window
129 :foreground
(get-color *expose-foreground
*)
130 :background
(get-color *expose-background
*)
132 :line-style
:solid
)))
133 (setf (window-transparency window
) *expose-transparency
*)
135 (push (list window gc string child
) *expose-windows-list
*))))))
139 (defun expose-mode-display-accel-windows ()
141 (with-all-children-reversed ((find-current-root) child
)
142 (if (or (frame-p child
)
143 (managed-window-p child
(find-parent-frame child
*root-frame
*)))
145 (expose-create-window child
(incf n
)))
146 (hide-child child
))))
147 (setf *expose-windows-list
* (nreverse *expose-windows-list
*))
148 (expose-draw-letter))
151 (defun expose-windows-generic (first-restore-frame &optional body body-escape
)
152 (setf *expose-font
* (xlib:open-font
*display
* *expose-font-string
*)
153 *expose-windows-list
* nil
154 *expose-selected-child
* nil
)
155 (xlib:warp-pointer
*root
* (truncate (/ (xlib:screen-width
*screen
*) 2))
156 (truncate (/ (xlib:screen-height
*screen
*) 2)))
157 (with-all-frames (first-restore-frame frame
)
158 (setf (frame-data-slot frame
:old-layout
) (frame-layout frame
)
159 (frame-layout frame
) #'tile-space-layout
))
160 (show-all-children t
)
161 (expose-mode-display-accel-windows)
162 (let ((grab-keyboard-p (xgrab-keyboard-p))
163 (grab-pointer-p (xgrab-pointer-p)))
164 (xgrab-pointer *root
* 92 93)
165 (unless grab-keyboard-p
167 (xgrab-keyboard *root
*))
168 (if (generic-mode 'expose-mode
'exit-expose-loop
169 :original-mode
'(main-mode))
170 (multiple-value-bind (x y
) (xlib:query-pointer
*root
*)
171 (let* ((child (or *expose-selected-child
* (find-child-under-mouse x y
)))
172 (parent (find-parent-frame child
*root-frame
*)))
173 (when (and child parent
)
174 (pfuncall body parent
)
175 (focus-all-children child parent
))))
176 (pfuncall body-escape
))
177 (dolist (lwin *expose-windows-list
*)
179 (xlib:destroy-window it
))
181 (xlib:free-gcontext it
)))
183 (xlib:close-font
*expose-font
*))
184 (setf *expose-windows-list
* nil
)
185 (with-all-frames (first-restore-frame frame
)
186 (setf (frame-layout frame
) (frame-data-slot frame
:old-layout
)
187 (frame-data-slot frame
:old-layout
) nil
))
188 (show-all-children t
)
190 (unless grab-keyboard-p
194 (xgrab-pointer *root
* 66 67)
196 (wait-no-key-or-button-press))
200 (defun expose-windows-mode ()
201 "Present all windows in the current frame (An expose like)"
203 (expose-windows-generic (find-current-root)))
205 (defun expose-all-windows-mode ()
206 "Present all windows in all frames (An expose like)"
208 (let ((orig-root *current-root
*))
209 (switch-to-root-frame :show-later t
)
210 (expose-windows-generic *root-frame
*
212 (setf *current-root
* parent
))
214 (setf *current-root
* orig-root
)))))
216 (defun expose-windows-current-child-mode ()
217 "Present all windows in the current child (An expose like)"
219 (when (frame-p (current-child))
220 (let ((orig-root *current-root
*))
221 (unless (child-equal-p (current-child) *current-root
*)
222 (setf *current-root
* (current-child)))
223 (expose-windows-generic *current-root
*
225 (setf *current-root
* parent
))
227 (setf *current-root
* orig-root
))))))