src/clfswm-util.lisp (copy-focus-window, cut-focus-window): New functions and ask...
[clfswm.git] / src / clfswm-second-mode.lisp
bloba80a4efe2ae92f20adf41eb1bd4ca6cf367415ff
1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
3 ;;;
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Second mode functions
6 ;;; --------------------------------------------------------------------------
7 ;;;
8 ;;; (C) 2011 Philippe Brochard <hocwp@free.fr>
9 ;;;
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.
14 ;;;
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.
19 ;;;
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.
23 ;;;
24 ;;; --------------------------------------------------------------------------
26 (in-package :clfswm)
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"))
40 (len (length text)))
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))
44 text))
45 (copy-pixmap-buffer *sm-window* *sm-gc*))
50 ;;; Second mode handlers
51 (define-handler second-mode :key-press (code state)
52 (funcall-key-from-code *second-keys* code state)
53 (draw-second-mode-window))
55 (define-handler second-mode :enter-notify ()
56 (draw-second-mode-window))
58 (define-handler second-mode :motion-notify (window root-x root-y)
59 (unless (compress-motion-notify)
60 (funcall-button-from-code *second-mouse* 'motion
61 (modifiers->state *default-modifiers*)
62 window root-x root-y *fun-press*)))
64 (define-handler second-mode :button-press (window root-x root-y code state)
65 (funcall-button-from-code *second-mouse* code state window root-x root-y *fun-press*)
66 (draw-second-mode-window))
68 (define-handler second-mode :button-release (window root-x root-y code state)
69 (funcall-button-from-code *second-mouse* code state window root-x root-y *fun-release*)
70 (draw-second-mode-window))
72 (define-handler second-mode :configure-request ()
73 (apply #'handle-event-fun-main-mode-configure-request event-slots)
74 (draw-second-mode-window))
77 (define-handler second-mode :configure-notify ()
78 (draw-second-mode-window))
81 (define-handler second-mode :destroy-notify ()
82 (apply #'handle-event-fun-main-mode-destroy-notify event-slots)
83 (draw-second-mode-window))
85 (define-handler second-mode :map-request ()
86 (apply #'handle-event-fun-main-mode-map-request event-slots)
87 (draw-second-mode-window))
89 (define-handler second-mode :unmap-notify ()
90 (apply #'handle-event-fun-main-mode-unmap-notify event-slots)
91 (draw-second-mode-window))
93 (define-handler second-mode :exposure ()
94 (apply #'handle-event-fun-main-mode-exposure event-slots)
95 (draw-second-mode-window))
100 (defun sm-enter-function ()
101 (with-placement (*second-mode-placement* x y *sm-width* *sm-height*)
102 (setf *in-second-mode* t
103 *sm-window* (xlib:create-window :parent *root*
104 :x x :y y
105 :width *sm-width* :height *sm-height*
106 :background (get-color *sm-background-color*)
107 :border-width *border-size*
108 :border (get-color *sm-border-color*)
109 :colormap (xlib:screen-default-colormap *screen*)
110 :event-mask '(:exposure))
111 *sm-font* (xlib:open-font *display* *sm-font-string*)
112 *sm-gc* (xlib:create-gcontext :drawable *sm-window*
113 :foreground (get-color *sm-foreground-color*)
114 :background (get-color *sm-background-color*)
115 :font *sm-font*
116 :line-style :solid)))
117 (map-window *sm-window*)
118 (draw-second-mode-window)
119 (no-focus)
120 (ungrab-main-keys)
121 (xgrab-keyboard *root*)
122 (xgrab-pointer *root* 66 67)
123 (speed-mouse-reset))
125 (defun sm-loop-function ()
126 (raise-window *sm-window*))
128 (defun sm-leave-function ()
129 (xlib:free-gcontext *sm-gc*)
130 (xlib:close-font *sm-font*)
131 (xlib:destroy-window *sm-window*)
132 (xungrab-keyboard)
133 (xungrab-pointer)
134 (grab-main-keys)
135 (show-all-children)
136 (display-all-frame-info)
137 (wait-no-key-or-button-press)
138 (setf *in-second-mode* nil))
140 (defun second-key-mode ()
141 "Switch to editing mode (second mode)"
142 (generic-mode 'second-mode
143 'exit-second-loop
144 :enter-function #'sm-enter-function
145 :loop-function #'sm-loop-function
146 :leave-function #'sm-leave-function)
147 (when *second-mode-leave-function*
148 (funcall *second-mode-leave-function*)
149 (setf *second-mode-leave-function* nil)))
151 (defun leave-second-mode ()
152 "Leave second mode"
153 (cond (*in-second-mode*
154 (setf *in-second-mode* nil)
155 (throw 'exit-second-loop nil))
156 (t (setf *in-second-mode* nil)
157 (show-all-children))))