1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Second mode functions
6 ;;; --------------------------------------------------------------------------
8 ;;; (C) 2012 Philippe Brochard <pbrochard@common-lisp.net>
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 *sm-window
* nil
)
29 (defparameter *sm-font
* nil
)
30 (defparameter *sm-gc
* nil
)
32 (defparameter *second-mode-leave-function
* nil
33 "Execute the function if not nil")
36 (defun draw-second-mode-window ()
37 (raise-window *sm-window
*)
38 (clear-pixmap-buffer *sm-window
* *sm-gc
*)
39 (let* ((text (format nil
"Second mode"))
41 (xlib:draw-glyphs
*pixmap-buffer
* *sm-gc
*
42 (truncate (/ (- *sm-width
* (* (xlib:max-char-width
*sm-font
*) len
)) 2))
43 (truncate (/ (+ *sm-height
* (- (xlib:font-ascent
*sm-font
*) (xlib:font-descent
*sm-font
*))) 2))
45 (copy-pixmap-buffer *sm-window
* *sm-gc
*)
51 ;;; Second mode handlers
52 (define-handler second-mode
:key-press
(code state
)
53 (funcall-key-from-code *second-keys
* code state
)
54 (draw-second-mode-window))
56 (define-handler second-mode
:enter-notify
()
57 (draw-second-mode-window))
59 (define-handler second-mode
:motion-notify
(window root-x root-y
)
60 (unless (compress-motion-notify)
61 (funcall-button-from-code *second-mouse
* 'motion
62 (modifiers->state
*default-modifiers
*)
63 window root-x root-y
*fun-press
*)))
65 (define-handler second-mode
:button-press
(window root-x root-y code state
)
66 (funcall-button-from-code *second-mouse
* code state window root-x root-y
*fun-press
*)
67 (draw-second-mode-window))
69 (define-handler second-mode
:button-release
(window root-x root-y code state
)
70 (funcall-button-from-code *second-mouse
* code state window root-x root-y
*fun-release
*)
71 (draw-second-mode-window))
73 (define-handler second-mode
:configure-request
()
74 (apply #'handle-event-fun-main-mode-configure-request event-slots
)
75 (draw-second-mode-window))
78 (define-handler second-mode
:configure-notify
()
79 (draw-second-mode-window))
82 (define-handler second-mode
:destroy-notify
()
83 (apply #'handle-event-fun-main-mode-destroy-notify event-slots
)
84 (draw-second-mode-window))
86 (define-handler second-mode
:map-request
()
87 (apply #'handle-event-fun-main-mode-map-request event-slots
)
88 (draw-second-mode-window))
90 (define-handler second-mode
:unmap-notify
()
91 (apply #'handle-event-fun-main-mode-unmap-notify event-slots
)
92 (draw-second-mode-window))
94 (define-handler second-mode
:exposure
()
95 (apply #'handle-event-fun-main-mode-exposure event-slots
)
96 (draw-second-mode-window))
101 (defun sm-enter-function ()
102 (with-placement (*second-mode-placement
* x y
*sm-width
* *sm-height
*)
103 (setf *in-second-mode
* t
104 *sm-window
* (xlib:create-window
:parent
*root
*
106 :width
*sm-width
* :height
*sm-height
*
107 :background
(get-color *sm-background-color
*)
108 :border-width
*border-size
*
109 :border
(get-color *sm-border-color
*)
110 :colormap
(xlib:screen-default-colormap
*screen
*)
111 :event-mask
'(:exposure
))
112 *sm-font
* (xlib:open-font
*display
* *sm-font-string
*)
113 *sm-gc
* (xlib:create-gcontext
:drawable
*sm-window
*
114 :foreground
(get-color *sm-foreground-color
*)
115 :background
(get-color *sm-background-color
*)
117 :line-style
:solid
)))
118 (setf (window-transparency *sm-window
*) *sm-transparency
*)
119 (map-window *sm-window
*)
120 (draw-second-mode-window)
123 (xgrab-keyboard *root
*)
124 (xgrab-pointer *root
* 66 67)
127 (defun sm-loop-function ()
128 (raise-window *sm-window
*))
130 (defun sm-leave-function ()
131 (setf *in-second-mode
* nil
)
133 (xlib:free-gcontext
*sm-gc
*)
136 (xlib:close-font
*sm-font
*)
137 (setf *sm-font
* nil
))
139 (xlib:destroy-window
*sm-window
*)
140 (setf *sm-window
* nil
))
145 (display-all-frame-info)
146 (raise-notify-window)
147 (wait-no-key-or-button-press))
149 (defun second-key-mode ()
150 "Switch to editing mode (second mode)"
151 (generic-mode 'second-mode
153 :enter-function
#'sm-enter-function
154 :loop-function
#'sm-loop-function
155 :leave-function
#'sm-leave-function
)
156 (when *second-mode-leave-function
*
157 (funcall *second-mode-leave-function
*)
158 (setf *second-mode-leave-function
* nil
)))
160 (defun leave-second-mode ()
162 (cond (*in-second-mode
*
163 (setf *in-second-mode
* nil
)
164 (throw 'exit-second-loop nil
))
165 (t (setf *in-second-mode
* nil
)
166 (show-all-children))))
169 (defun sm-delete-focus-window ()
170 "Close focus window: Delete the focus window in all frames and workspaces"
171 (setf *second-mode-leave-function
* 'delete-focus-window
)
174 (defun sm-ask-close/kill-current-window
()
175 "Close or kill the current window (ask before doing anything)"
176 (setf *second-mode-leave-function
* #'ask-close
/kill-current-window
)