1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Blank window mode to place blank window on screen and manage
6 ;;; them with the keyboard or the mouse.
7 ;;; This is useful when you want to hide some part of the screen (for example
8 ;;; in school class for interactive presentation).
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 ;;; Documentation: Blank window mode to place blank window on screen.
28 ;;; If you want to use this file, just add this line in your configuration
31 ;;; (load-contrib "blank-window-mode.lisp")
33 ;;; --------------------------------------------------------------------------
37 (format t
"Loading Blank Window Mode code... ")
39 (defconfig *blank-window-width
* 50 'blank-window
"Blank window width")
40 (defconfig *blank-window-height
* 20 'blank-window
"Blank window height")
41 (defconfig *blank-window-color
* "white" 'blank-window
"Blank window color")
42 (defconfig *blank-window-border
* "magenta" 'blank-window
"Blank window border color")
45 (defparameter *blank-window-list
* nil
)
46 (defparameter *in-blank-window-mode
* nil
)
47 (defparameter *blank-window-show-current
* nil
)
49 (defparameter *blank-window-keys
* nil
)
50 (defparameter *blank-window-mouse
* nil
)
53 (define-init-hash-table-key *blank-window-keys
* "Blank-Window mode keys")
54 (define-init-hash-table-key *blank-window-mouse
* "Blank-Window mode mouse button")
56 (define-define-key "blank-window" *blank-window-keys
*)
57 (define-define-mouse "blank-window-mouse" *blank-window-mouse
*)
59 (add-hook *binding-hook
* 'init-
*blank-window-keys
*)
62 (defun leave-blank-window-mode (&optional window root-x root-y
)
63 "Leave the blank-window mode"
64 (declare (ignore window root-x root-y
))
65 (when *in-blank-window-mode
*
66 (throw 'exit-blank-window-loop nil
)))
70 (defun bwm-enter-function ()
71 (setf *in-blank-window-mode
* t
)
73 (xgrab-keyboard *root
*)
74 (xgrab-pointer *root
* 66 67)
75 (dolist (window *blank-window-list
*)
76 (raise-window window
)))
79 (defun bwm-leave-function ()
80 (setf *in-blank-window-mode
* nil
)
84 (wait-no-key-or-button-press))
88 (define-handler blank-window-mode
:key-press
(code state
)
89 (funcall-key-from-code *blank-window-keys
* code state
))
91 (define-handler blank-window-mode
:button-press
(code state window root-x root-y
)
92 (funcall-button-from-code *blank-window-mouse
* code state window root-x root-y
*fun-press
*))
96 (defun blank-window-mode ()
98 (generic-mode 'blank-window-mode
99 'exit-blank-window-loop
100 :enter-function
#'bwm-enter-function
101 ;;:loop-function #'bwm-loop-function
102 :leave-function
#'bwm-leave-function
103 :original-mode
'main-mode
))
108 (defun create-new-blank-window (&rest args
)
109 "Create a new blank window"
110 (declare (ignore args
))
112 (push (xlib:create-window
:parent
*root
*
114 :width
*blank-window-width
* :height
*blank-window-height
*
115 :background
(get-color *blank-window-color
*)
117 :border
(get-color *blank-window-border
*)
118 :colormap
(xlib:screen-default-colormap
*screen
*)
119 :event-mask
'(:exposure
))
120 *blank-window-list
*))
121 (map-window (first *blank-window-list
*)))
123 (defun clear-all-blank-window ()
124 "Clear all blank window"
125 (dolist (window *blank-window-list
*)
127 (xlib:destroy-window window
))
128 (setf *blank-window-list
* nil
))
130 (defmacro with-current-blank-window
((window) &body body
)
131 `(let ((,window
(first *blank-window-list
*)))
135 (defun blank-window-fill-width ()
136 "Current blank window fill all width screen"
137 (with-current-blank-window (window)
138 (setf (xlib:drawable-x window
) 0
139 (xlib:drawable-width window
) (xlib:drawable-width
*root
*))))
141 (defun blank-window-fill-height ()
142 "Current blank window fill all height screen"
143 (with-current-blank-window (window)
144 (setf (xlib:drawable-y window
) 0
145 (xlib:drawable-height window
) (xlib:drawable-height
*root
*))))
147 (defun blank-window-down (dy)
148 "Move current blank window down"
149 (with-current-blank-window (window)
150 (incf (xlib:drawable-y window
) dy
)))
152 (defun blank-window-right (dx)
153 "Move current blank window right"
154 (with-current-blank-window (window)
155 (incf (xlib:drawable-x window
) dx
)))
157 (defun blank-window-inc-width (dw)
158 "Change current blank window width"
159 (with-current-blank-window (window)
160 (decf (xlib:drawable-x window
) dw
)
161 (incf (xlib:drawable-width window
) (* dw
2))))
163 (defun blank-window-inc-height (dh)
164 "Change current blank window height"
165 (with-current-blank-window (window)
166 (decf (xlib:drawable-y window
) dh
)
167 (incf (xlib:drawable-height window
) (* dh
2))))
170 (defun select-next-blank-window ()
171 "Select next blank window"
172 (with-current-blank-window (window)
173 (setf (xlib:drawable-border-width window
) 0))
174 (setf *blank-window-list
* (rotate-list *blank-window-list
*))
175 (when *blank-window-show-current
*
176 (with-current-blank-window (window)
177 (setf (xlib:drawable-border-width window
) 1))))
179 (defun toggle-show-current-blank-window ()
180 (setf *blank-window-show-current
* (not *blank-window-show-current
*))
181 (with-current-blank-window (window)
182 (setf (xlib:drawable-border-width window
) (if *blank-window-show-current
* 1 0))))
184 (defun remove-current-blank-window ()
185 (let ((window (pop *blank-window-list
*)))
188 (xlib:destroy-window window
)))
189 (with-current-blank-window (window)
190 (setf (xlib:drawable-border-width window
) (if *blank-window-show-current
* 1 0))))
192 (defun find-blank-window-under-mouse ()
193 "Return the blank window under the mouse pointer if any"
195 (dolist (win *blank-window-list
*)
196 (when (in-window win x y
)
197 (with-current-blank-window (window)
198 (setf (xlib:drawable-border-width window
) 0))
199 (setf *blank-window-list
* (remove win
*blank-window-list
* :test
#'xlib
:window-equal
))
200 (push win
*blank-window-list
*)
201 (when *blank-window-show-current
*
202 (with-current-blank-window (window)
203 (setf (xlib:drawable-border-width window
) 1)))
204 (return-from find-blank-window-under-mouse win
)))))
206 (defun move-blank-window (window root-x root-y
)
207 "Move blank window with the mouse"
208 (declare (ignore window
))
209 (let ((window (find-blank-window-under-mouse)))
211 (move-window window root-x root-y
))))
213 (defun resize-blank-window (window root-x root-y
)
214 "Resize blank window with the mouse"
215 (declare (ignore window
))
216 (let ((window (find-blank-window-under-mouse)))
218 (resize-window window root-x root-y
))))
220 (defun hide-unhide-current-blank-window ()
221 "Hide or unhide the current blank window"
222 (with-current-blank-window (window)
223 (if (window-hidden-p window
)
224 (unhide-window window
)
225 (hide-window window
))))
228 (defun blank-black-window ()
229 "Open a black window. ie light of the screen"
230 (let ((black-win (xlib:create-window
:parent
*root
*
232 :width
(xlib:drawable-width
*root
*)
233 :height
(xlib:drawable-height
*root
*)
234 :background
(get-color "black")
236 :border
(get-color "black")
237 :colormap
(xlib:screen-default-colormap
*screen
*)
238 :event-mask
'(:exposure
))))
239 (map-window black-win
)
240 (wait-no-key-or-button-press)
241 (wait-a-key-or-button-press)
242 (xlib:destroy-window black-win
)
243 (wait-no-key-or-button-press)))
247 (defun set-default-blank-window-keys ()
248 ;;(define-blank-window-key ("Return") 'leave-blank-window-mode)
249 (define-blank-window-key ("Escape") 'leave-blank-window-mode
)
250 (define-blank-window-key ("twosuperior") 'leave-blank-window-mode
)
251 (define-blank-window-key ("Return") 'create-new-blank-window
)
252 (define-blank-window-key ("BackSpace" :control
) 'clear-all-blank-window
)
253 (define-blank-window-key ("Tab") 'select-next-blank-window
)
254 (define-blank-window-key ("w") 'blank-window-fill-width
)
255 (define-blank-window-key ("h") 'blank-window-fill-height
)
256 (define-blank-window-key ("Down") 'blank-window-down
5)
257 (define-blank-window-key ("Down" :shift
) 'blank-window-down
1)
258 (define-blank-window-key ("Down" :control
) 'blank-window-down
20)
259 (define-blank-window-key ("Up") 'blank-window-down -
5)
260 (define-blank-window-key ("Up" :shift
) 'blank-window-down -
1)
261 (define-blank-window-key ("Up" :control
) 'blank-window-down -
20)
262 (define-blank-window-key ("Right") 'blank-window-right
5)
263 (define-blank-window-key ("Right" :shift
) 'blank-window-right
1)
264 (define-blank-window-key ("Right" :control
) 'blank-window-right
20)
265 (define-blank-window-key ("Left") 'blank-window-right -
5)
266 (define-blank-window-key ("Left" :shift
) 'blank-window-right -
1)
267 (define-blank-window-key ("Left" :control
) 'blank-window-right -
20)
268 (define-blank-window-key ("c") 'toggle-show-current-blank-window
)
269 (define-blank-window-key ("p") 'blank-window-inc-width
1)
270 (define-blank-window-key ("o") 'blank-window-inc-height
1)
271 (define-blank-window-key ("m") 'blank-window-inc-width -
1)
272 (define-blank-window-key ("l") 'blank-window-inc-height -
1)
273 (define-blank-window-key ("Delete") 'remove-current-blank-window
)
274 (define-blank-window-key ("t") 'hide-unhide-current-blank-window
)
275 (define-blank-window-key ("Control_R") 'banish-pointer
)
276 (define-blank-window-key ("b") 'banish-pointer
)
277 (define-blank-window-key ("x") 'blank-black-window
)
279 (define-blank-window-mouse (1) 'move-blank-window
)
280 (define-blank-window-mouse (2) 'create-new-blank-window
)
281 (define-blank-window-mouse (3) 'resize-blank-window
))
285 (add-hook *binding-hook
* 'set-default-blank-window-keys
)