/[mcclim]/mcclim/input.lisp
ViewVC logotype

Contents of /mcclim/input.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (hide annotations)
Fri Apr 19 22:27:09 2002 UTC (12 years ago) by moore
Branch: MAIN
Changes since 1.8: +27 -4 lines
Make a global choice, based on multiprocessing or not, whether events
should be handled immediately or queued up to be serviced by another
process.  The choice is implemented by the classes
clim-sheet-input-mixin and clim-repainting-mixin, from which all panes
inherit.  These classes' superclasses are conditionalized on whether or
not the implementation is capable of multiprocessing.

When multiprocessing there is a single event queue per frame.  This is
implemented by queue-event on pane classes.

The event loop is implemented in stream-input-wait.  In single
processing mode, stream-input-wait calls process-next-event and
handles events immediately.  When multiprocessing, stream-input-wait
reads events from the frame event queue and handles them.  The
function clim-extensions:simple-event-loop is supplied for
applications which do not loop reading from a stream; various examples
have been changed to use it.

In stream-read-gesture/stream-input-wait the input-wait-test function
is not expected to block anymore; nor is the input-wait-handler
expected to dispatch events.  input-wait-handler is responsible for
consuming events that should not be seen by anyone
else. input-context-wait-test and highlight-applicable-presentation
have been rewritten to reflect this.

The adjustable-array buffer for extended-input-streams has been added
back in.  A typo in %event-matches-gesture has been fixed.

Default methods for map-over-output-records-containing-position and
map-over-output-records-overlapping-region have been added.

The cursor implementation has been broken out into a cursor-mixin so I
can snarf it for Goatee :)
1 mikemac 1.1 ;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-
2    
3     ;;; (c) copyright 1998,1999,2000 by Michael McDonald (mikemac@mikemac.com)
4 gilbert 1.5 ;;; (c) copyright 2002 by Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
5 mikemac 1.1
6     ;;; This library is free software; you can redistribute it and/or
7     ;;; modify it under the terms of the GNU Library General Public
8     ;;; License as published by the Free Software Foundation; either
9     ;;; version 2 of the License, or (at your option) any later version.
10     ;;;
11     ;;; This library is distributed in the hope that it will be useful,
12     ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13     ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14     ;;; Library General Public License for more details.
15     ;;;
16     ;;; You should have received a copy of the GNU Library General Public
17     ;;; License along with this library; if not, write to the
18     ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19     ;;; Boston, MA 02111-1307 USA.
20    
21     (in-package :CLIM-INTERNALS)
22    
23     ;;; Input Protocol Classes
24    
25 gilbert 1.5 ;; Event queues
26    
27     (defclass standard-event-queue ()
28     ((lock :initform (make-lock "event queue")
29     :reader event-queue-lock)
30     (head :initform nil
31     :accessor event-queue-head
32     :documentation "Head pointer of event queue.")
33     (tail :initform nil
34     :accessor event-queue-tail
35     :documentation "Tail pointer of event queue.") ))
36    
37     (defmethod event-queue-read-no-hang ((eq standard-event-queue))
38     "Reads one event from the queue, if there is no event just return NIL."
39     (with-lock-held ((event-queue-lock eq))
40     (let ((res (pop (event-queue-head eq))))
41     (when (null (event-queue-head eq))
42     (setf (event-queue-tail eq) nil))
43     res)))
44    
45     (defmethod event-queue-read ((eq standard-event-queue))
46     "Reads one event from the queue, if there is no event, hang until here is one."
47     (loop
48     (let ((res (event-queue-read-no-hang eq)))
49     (when res
50     (return res))
51     (process-wait "Waiting for event"
52     (lambda ()
53     (not (null (event-queue-head eq))))))))
54    
55     (defmethod event-queue-append ((eq standard-event-queue) item)
56     "Append the item at the end of the queue."
57     (with-lock-held ((event-queue-lock eq))
58     (cond ((null (event-queue-tail eq))
59     (setf (event-queue-head eq) (cons item nil)
60     (event-queue-tail eq) (event-queue-head eq)))
61     (t
62     (setf (event-queue-tail eq)
63     (setf (cdr (event-queue-tail eq)) (cons item nil)))))))
64    
65     (defmethod event-queue-prepend ((eq standard-event-queue) item)
66     "Prepend the item to the beginning of the queue."
67     (with-lock-held ((event-queue-lock eq))
68     (cond ((null (event-queue-tail eq))
69     (setf (event-queue-head eq) (cons item nil)
70     (event-queue-tail eq) (event-queue-head eq)))
71     (t
72     (push item (event-queue-head eq))))))
73    
74 mikemac 1.7 (defmethod event-queue-peek ((eq standard-event-queue))
75     (with-lock-held ((event-queue-lock eq))
76     (first (event-queue-head eq))))
77    
78 gilbert 1.5 (defmethod event-queue-peek-if (predicate (eq standard-event-queue))
79     "Goes thru the whole event queue an returns the first event, which
80     satisfies 'predicate' and leaves the event in the queue.
81     Returns NIL, if there is no such event."
82     (with-lock-held ((event-queue-lock eq))
83     (find-if predicate (event-queue-head eq))))
84    
85     (defmethod event-queue-listen ((eq standard-event-queue))
86     (not (null (event-queue-head eq))))
87    
88 moore 1.8 (defmethod event-queue-listen-or-wait ((eq standard-event-queue) &key timeout)
89     (or (not (null (event-queue-peek eq)))
90     (flet ((pred ()
91     (not (null (event-queue-head eq)))))
92     (if timeout
93     (process-wait-with-timeout "Listening for event" timeout #'pred)
94     (process-wait "Listening for event" #'pred)))))
95    
96    
97 gilbert 1.5 ;; STANDARD-SHEET-INPUT-MIXIN
98    
99 mikemac 1.1 (defclass standard-sheet-input-mixin ()
100 mikemac 1.7 ((queue :initform (make-instance 'standard-event-queue)
101     :reader sheet-event-queue)
102 mikemac 1.1 (port :initform nil
103     :initarg :port
104     :reader port)
105     ))
106    
107 mikemac 1.7 (defmethod stream-input-buffer ((stream standard-sheet-input-mixin))
108     (sheet-event-queue stream))
109    
110     ;(defmethod dispatch-event ((sheet standard-sheet-input-mixin) event)
111     ; (if (typep event 'device-event)
112     ; (queue-event sheet event)
113     ; (handle-event sheet event)))
114    
115 mikemac 1.1 (defmethod dispatch-event ((sheet standard-sheet-input-mixin) event)
116 moore 1.9 (queue-event sheet event))
117 mikemac 1.1
118 gilbert 1.6 (defmethod dispatch-event ((sheet standard-sheet-input-mixin) (event device-event))
119     (queue-event sheet event))
120    
121 mikemac 1.1 (defmethod queue-event ((sheet standard-sheet-input-mixin) event)
122     (with-slots (queue) sheet
123 gilbert 1.5 (event-queue-append queue event)))
124 mikemac 1.1
125     (defmethod handle-event ((sheet standard-sheet-input-mixin) event)
126     ;; Standard practice is too ignore events
127     (declare (ignore event))
128     nil)
129    
130     (defmethod event-read ((sheet standard-sheet-input-mixin))
131     (with-slots (queue) sheet
132 gilbert 1.5 (event-queue-read queue)))
133 boninfan 1.3
134     (defmethod event-read-with-timeout ((sheet standard-sheet-input-mixin)
135     &key (timeout nil) (wait-function nil))
136 gilbert 1.5 ;; This one is not in the spec ;-( --GB
137 boninfan 1.3 (with-slots (queue) sheet
138 gilbert 1.5 (event-queue-read queue)))
139 mikemac 1.1
140     (defmethod event-read-no-hang ((sheet standard-sheet-input-mixin))
141     (with-slots (queue) sheet
142 gilbert 1.5 (event-queue-read-no-hang queue)))
143 mikemac 1.1
144     (defmethod event-peek ((sheet standard-sheet-input-mixin) &optional event-type)
145     (with-slots (queue) sheet
146     (if event-type
147 gilbert 1.5 (event-queue-peek-if (lambda (x)
148     (typep x event-type))
149     queue)
150     (event-queue-peek-if (lambda (x) (declare (ignore x)) t)
151     queue))))
152 mikemac 1.1
153     (defmethod event-unread ((sheet standard-sheet-input-mixin) event)
154     (with-slots (queue) sheet
155 gilbert 1.5 (event-queue-prepend queue event)))
156 mikemac 1.1
157     (defmethod event-listen ((sheet standard-sheet-input-mixin))
158     (with-slots (queue) sheet
159 gilbert 1.5 (event-queue-listen queue)))
160    
161     ;;;;
162 mikemac 1.1
163 moore 1.9 (defclass immediate-sheet-input-mixin ()
164     ())
165 mikemac 1.1
166     (defmethod dispatch-event ((sheet immediate-sheet-input-mixin) event)
167     (handle-event sheet event))
168    
169     (define-condition sheet-is-mute-for-input (error)
170     (
171     ))
172    
173 rouanet 1.4 (defclass sheet-mute-input-mixin ()
174 mikemac 1.1 (
175     ))
176    
177 rouanet 1.4 (defmethod dispatch-event ((sheet sheet-mute-input-mixin) event)
178 mikemac 1.1 (declare (ignore event))
179     (error 'sheet-is-mute-for-input))
180    
181 rouanet 1.4 (defmethod queue-event ((sheet sheet-mute-input-mixin) event)
182 mikemac 1.1 (declare (ignore event))
183     (error 'sheet-is-mute-for-input))
184    
185 rouanet 1.4 (defmethod handle-event ((sheet sheet-mute-input-mixin) event)
186 mikemac 1.1 (declare (ignore event))
187     (error 'sheet-is-mute-for-input))
188    
189 rouanet 1.4 (defmethod event-read ((sheet sheet-mute-input-mixin))
190 mikemac 1.1 (error 'sheet-is-mute-for-input))
191    
192 rouanet 1.4 (defmethod event-read-with-timeout ((sheet sheet-mute-input-mixin)
193 boninfan 1.3 &key (timeout nil) (wait-function nil))
194     (declare (ignore timeout wait-function))
195     (error 'sheet-is-mute-for-input))
196    
197 rouanet 1.4 (defmethod event-read-no-hang ((sheet sheet-mute-input-mixin))
198 mikemac 1.1 (error 'sheet-is-mute-for-input))
199    
200 rouanet 1.4 (defmethod event-peek ((sheet sheet-mute-input-mixin) &optional event-type)
201 mikemac 1.1 (declare (ignore event-type))
202     (error 'sheet-is-mute-for-input))
203    
204 rouanet 1.4 (defmethod event-unread ((sheet sheet-mute-input-mixin) event)
205 mikemac 1.1 (declare (ignore event))
206     (error 'sheet-is-mute-for-input))
207    
208 rouanet 1.4 (defmethod event-listen ((sheet sheet-mute-input-mixin))
209 mikemac 1.1 (error 'sheet-is-mute-for-input))
210    
211 gilbert 1.5 ;;;;
212    
213 mikemac 1.1 (defclass delegate-sheet-input-mixin ()
214     ((delegate :initform nil
215     :initarg :delegate
216 gilbert 1.5 :accessor delegate-sheet-delegate) ))
217 mikemac 1.1
218     (defmethod dispatch-event ((sheet delegate-sheet-input-mixin) event)
219     (dispatch-event (delegate-sheet-delegate sheet) event))
220    
221     (defmethod queue-event ((sheet delegate-sheet-input-mixin) event)
222     (queue-event (delegate-sheet-delegate sheet) event))
223    
224     (defmethod handle-event ((sheet delegate-sheet-input-mixin) event)
225     (handle-event (delegate-sheet-delegate sheet) event))
226    
227     (defmethod event-read ((sheet delegate-sheet-input-mixin))
228     (event-read (delegate-sheet-delegate sheet)))
229 boninfan 1.3
230     (defmethod event-read-with-timeout ((sheet delegate-sheet-input-mixin)
231     &key (timeout nil) (wait-function nil))
232     (event-read-with-timeout (delegate-sheet-delegate sheet)
233     :timeout timeout :wait-function wait-function))
234 mikemac 1.1
235     (defmethod event-read-no-hang ((sheet delegate-sheet-input-mixin))
236     (event-read-no-hang (delegate-sheet-delegate sheet)))
237    
238     (defmethod event-peek ((sheet delegate-sheet-input-mixin) &optional event-type)
239     (event-peek (delegate-sheet-delegate sheet) event-type))
240    
241     (defmethod event-unread ((sheet delegate-sheet-input-mixin) event)
242     (event-unread (delegate-sheet-delegate sheet) event))
243    
244     (defmethod event-listen ((sheet delegate-sheet-input-mixin))
245     (event-listen (delegate-sheet-delegate sheet)))
246 moore 1.9
247     ;;; Class actually used by panes.
248    
249     (defclass clim-sheet-input-mixin (#+clim-mp standard-sheet-input-mixin #-clim-mp immediate-sheet-input-mixin)
250     ())
251    
252     ;;; Utility for handling all the events on queues of child sheets
253    
254     (defun handle-events-over-sheets (sheet exclude)
255     "Utility for handling all the events on queues of child sheets. The
256     EXCLUDE argument is either nil, a sheet or a list of sheets to
257     ignore. This avoids various race conditions in event processing."
258     (flet ((handler (s)
259     (when (and exclude
260     (or (and (consp exclude)
261     (member s exclude :test #'eq))
262     (eq exclude s)))
263     (return-from handler nil))
264     (when (typep s 'standard-sheet-input-mixin)
265     (loop for event = (event-read-no-hang s)
266     while event
267     do (handle-event s event)))))
268     (declare (dynamic-extent handler))
269     (map-over-sheets #'handler sheet)))
270 mikemac 1.1

  ViewVC Help
Powered by ViewVC 1.1.5