/[defwm]/Define-Window-Manager/src/events.lisp
ViewVC logotype

Contents of /Define-Window-Manager/src/events.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Thu Feb 26 21:00:38 2004 UTC (10 years, 1 month ago) by rjain
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +6 -3 lines
add some accessors... more to come
1 (in-package :define-window-manager)
2
3 ;; Copied-and-modified from McCLIM's CLX backend's port.lisp so that we can intercept the
4 ;; events. EVENT-HANDLER should probably be a generic, with the port as the first argument.
5 (defmethod get-next-event ((port define-window-manager-port) &key wait-function (timeout nil))
6 (declare (ignore wait-function))
7 (let* ((clim-clx::*clx-port* port)
8 (display (clim-clx::clx-port-display port)))
9 (declare (special clim-clx::*clx-port*))
10 (unless (xlib:event-listen display)
11 (xlib:display-finish-output display))
12 ; temporary solution
13 (or (xlib:process-event display :timeout timeout :discard-p t
14 :handler (lambda (&rest event-slots)
15 (apply #'event-handler port event-slots)))
16 :timeout)))
17 ;; [Mike] Timeout and wait-functions are both implementation
18 ;; specific and hence best done in the backends.
19
20
21 (defclass window-manager-event (event)
22 ()
23 (:documentation
24 "Class to inidicate events that are specifically of interest to
25 window managers and not to CLIM."))
26
27 (defclass window-configuration-mixin ()
28 ((x :initarg :x)
29 (y :initarg :y)
30 (width :initarg :width)
31 (height :initarg :height)
32 (border-width :initarg :border-width)))
33
34 (defclass create-window-event (device-event window-configuration-mixin window-manager-event)
35 ((event-sheet :initarg :event-sheet
36 :reader event-sheet)
37 (new-window :initarg :new-window
38 :reader event-new-window)))
39
40 (defclass destroy-window-event (device-event window-manager-event)
41 ((event-sheet :initarg :event-sheet
42 :reader event-sheet)
43 (sheet :initarg :sheet)))
44
45 (defclass reparent-event (device-event window-manager-event)
46 ((event-sheet :initarg :event-sheet)
47 (parent :initarg :parent
48 :documentation "The new parent")
49 (override-redirect-p :initarg :override-redirect-p)))
50
51 (defclass unmap-event (device-event window-manager-event)
52 ((parent :initarg :parent)
53 (configure-p :initarg :configure-p)))
54
55 (defclass client-request (device-event window-manager-event)
56 ((parent :initarg :parent)))
57
58 (defclass circulate-request (client-request window-manager-event)
59 ((place :initarg :place)))
60
61 (defclass configure-request (client-request window-configuration-mixin window-manager-event)
62 ((stack-mode :initarg :stack-mode)
63 (above-sibling :initarg :above-sibling)
64 (value-mask :initarg :value-mask)))
65
66 (defclass map-request (client-request window-manager-event)
67 ())
68
69 (defclass resize-request (client-request window-configuration-mixin window-manager-event)
70 ((width :initarg :width)
71 (height :initarg :height)))
72
73 (defclass property-change-event (device-event window-manager-event)
74 ((atom :initarg :atom
75 :reader property-change-event-atom)
76 (state :initarg :state
77 :reader property-change-event-state)))
78
79 (defun event-handler (&rest event-slots
80 &key display event-window window parent
81 event-key code state mode time
82 width height x y root-x root-y border-width
83 data override-redirect-p send-event-p configure-p
84 above-sibling atom place
85 hint-p stack-mode value-mask
86 &allow-other-keys)
87 (or (apply 'clim-clx::event-handler event-slots)
88 (let ((event-sheet (and event-window
89 (climi::port-lookup-sheet clim-clx::*clx-port* event-window)))
90 (sheet (and window
91 (climi::port-lookup-sheet clim-clx::*clx-port* window)))
92 (parent-sheet (and parent
93 (climi::port-lookup-sheet clim-clx::*clx-port* parent))))
94 (declare (special clim-clx::*clx-port*))
95 (when event-sheet
96 (case event-key
97 (:create-notify
98 (make-instance 'create-window-event
99 :sheet event-sheet
100 :new-window window
101 :x x :y y
102 :width width :height height
103 :border-width border-width
104 :override-redirect-p override-redirect-p))
105 (:destroy-notify
106 (make-instance 'destroy-window-event
107 :parent event-sheet
108 :sheet sheet))
109 (:map-request
110 (make-instance 'map-request
111 :sheet event-sheet
112 :source-sheet sheet))
113 (:reparent-notify
114 (make-instance 'reparent-event
115 :sheet event-sheet
116 :source-sheet sheet
117 :parent parent-sheet
118 :override-redirect-p override-redirect-p))
119 (:unmap-notify
120 (make-instance 'unmap-event
121 :sheet event-sheet
122 :source-sheet sheet
123 :configure-p configure-p))
124 (:circulate-request
125 (make-instance 'circulate-request
126 :sheet event-sheet
127 :source-sheet sheet
128 :place place))
129 (:configure-request
130 (make-instance 'configure-request
131 :sheet event-sheet
132 :source-sheet sheet
133 :x x :y y
134 :width width :height height
135 :border-width border-width
136 :stack-mode stack-mode
137 :above-sibling above-sibling
138 :value-mask value-mask))
139 (:resize-request
140 (make-instance 'resize-request
141 :sheet (climi::port-lookup-sheet clim-clx::*clx-port* (xlib:drawable-root window))
142 :source-sheet sheet
143 :width width :height height))
144 (:property-notify
145 (make-instance 'property-change-event
146 :sheet sheet
147 :atom atom
148 :state state
149 :timestamp time))
150 (t
151 nil))))))
152
153 (defmethod distribute-event ((port define-window-manager-port) (event window-manager-event))
154 (dispatch-event (event-sheet event) event))
155
156 ;;; What kind of dispatching policy (queueing vs. immediate handling) do we want for the different WM events?
157
158
159 (defmethod handle-event (sheet (event window-manager-event))
160 (handle-window-manager-event sheet event))
161 (defmethod handle-event ((sheet external-sheet) event)
162 (handle-window-manager-event (window-border sheet) event))
163 (defmethod handle-event ((sheet root-sheet) event)
164 (handle-window-manager-event sheet event))
165
166 (defgeneric handle-window-manager-event (sheet event)
167 (:method-combination hooked-method-combination)
168 (:documentation
169 "This function is called by HANDLE-EVENT for all
170 window-management-related events. The primary methods of this function
171 call the appropriate 'action performer' function to perform the actual
172 event handling for the event. They are naive in that they simply call
173 that function typically based on the event type, but sometimes based on
174 some slots of that event. Any standard filtering or massaging of events
175 is done in the :around or :before methods of this function. Hooks may be
176 added to further filter or massage the events.
177
178 In summary, once the primary method is called, it is assumed that the
179 event should now be handled as-is. Any hooks on the 'action performer'
180 functions should be merely for updating data structures, tweaking
181 properties, or the like, not for substantially affecting the progress or
182 behavior of the action."))
183
184 (defgeneric manage-window (window-manager new-window)
185 (:method-combination hooked-method-combination))
186
187 (defgeneric unmanage-window (window-manager sheet)
188 (:method-combination hooked-method-combination))
189
190 (defgeneric configure-window (window-border request)
191 (:method-combination hooked-method-combination))
192
193 (defmethod handle-window-manager-event ((root root-sheet) (event create-window-event))
194 (let ((new-sheet (manage-window (window-manager root) (event-new-window event))))
195 (configure-window new-sheet event)))
196 (defmethod handle-window-manager-event ((sheet window-border) (event reparent-event))
197 (unmanage-window (window-manager sheet) (event-source-sheet event)))
198 (defmethod handle-window-manager-event ((sheet root-sheet) (event destroy-window-event))
199 (unmanage-window (window-manager sheet) (event-source-sheet event)))
200 (defmethod handle-window-manager-event ((sheet window-border) (event circulate-request))
201 (configure-window sheet event))
202 (defmethod handle-window-manager-event ((sheet window-border) (event configure-request))
203 (configure-window sheet event))
204 (defmethod handle-window-manager-event ((sheet window-border) (event resize-request))
205 (configure-window sheet event))
206 (defmethod handle-window-manager-event ((sheet window-border) (event property-change-event))
207 (handle-property-change sheet (property-change-event-atom event) event))
208
209 (defmethod manage-window ((window-manager define-window-manager) new-window)
210 (let ((sheet (make-external-sheet window-manager new-window)))
211 (climi::port-register-mirror (port window-manager) sheet new-window)))
212
213 (defmethod unmanage-window ((window-manager define-window-manager) sheet)
214 (let ((port (port window-manager)))
215 (climi::port-unregister-mirror port sheet (climi::port-lookup-sheet port sheet))))
216

  ViewVC Help
Powered by ViewVC 1.1.5