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

Contents of /mcclim/input.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (hide annotations)
Tue Mar 12 21:05:06 2002 UTC (12 years, 1 month ago) by moore
Branch: MAIN
Changes since 1.7: +9 -0 lines
Checkin to get context sensitive input working with multi-threaded
process-next-event.

Set input focus in run-frame-top-level.  Assume that someday, in the
presence of multiple frames, we'll do the right thing with switching
the input focus from frame to frame.

Added a frame-intercept-event-queue to frames.  process-next-event
examines the frame associated with the pane that has input focus and
puts device events on that frame's queue if desired.

Rewrote stream-input-wait, stream-read-gesture and the
with-input-context input-test and input-handler functions per
mikemac's suggestions.  The with-input-context stuff uses the
intercept queue mechanism now.

Fixed a typo in gadgets.lisp.
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 mikemac 1.7 (handle-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     (defclass immediate-sheet-input-mixin (standard-sheet-input-mixin)
164     (
165     ))
166    
167     (defmethod dispatch-event ((sheet immediate-sheet-input-mixin) event)
168     (handle-event sheet event))
169    
170     (define-condition sheet-is-mute-for-input (error)
171     (
172     ))
173    
174 rouanet 1.4 (defclass sheet-mute-input-mixin ()
175 mikemac 1.1 (
176     ))
177    
178 rouanet 1.4 (defmethod dispatch-event ((sheet sheet-mute-input-mixin) event)
179 mikemac 1.1 (declare (ignore event))
180     (error 'sheet-is-mute-for-input))
181    
182 rouanet 1.4 (defmethod queue-event ((sheet sheet-mute-input-mixin) event)
183 mikemac 1.1 (declare (ignore event))
184     (error 'sheet-is-mute-for-input))
185    
186 rouanet 1.4 (defmethod handle-event ((sheet sheet-mute-input-mixin) event)
187 mikemac 1.1 (declare (ignore event))
188     (error 'sheet-is-mute-for-input))
189    
190 rouanet 1.4 (defmethod event-read ((sheet sheet-mute-input-mixin))
191 mikemac 1.1 (error 'sheet-is-mute-for-input))
192    
193 rouanet 1.4 (defmethod event-read-with-timeout ((sheet sheet-mute-input-mixin)
194 boninfan 1.3 &key (timeout nil) (wait-function nil))
195     (declare (ignore timeout wait-function))
196     (error 'sheet-is-mute-for-input))
197    
198 rouanet 1.4 (defmethod event-read-no-hang ((sheet sheet-mute-input-mixin))
199 mikemac 1.1 (error 'sheet-is-mute-for-input))
200    
201 rouanet 1.4 (defmethod event-peek ((sheet sheet-mute-input-mixin) &optional event-type)
202 mikemac 1.1 (declare (ignore event-type))
203     (error 'sheet-is-mute-for-input))
204    
205 rouanet 1.4 (defmethod event-unread ((sheet sheet-mute-input-mixin) event)
206 mikemac 1.1 (declare (ignore event))
207     (error 'sheet-is-mute-for-input))
208    
209 rouanet 1.4 (defmethod event-listen ((sheet sheet-mute-input-mixin))
210 mikemac 1.1 (error 'sheet-is-mute-for-input))
211    
212 gilbert 1.5 ;;;;
213    
214 mikemac 1.1 (defclass delegate-sheet-input-mixin ()
215     ((delegate :initform nil
216     :initarg :delegate
217 gilbert 1.5 :accessor delegate-sheet-delegate) ))
218 mikemac 1.1
219     (defmethod dispatch-event ((sheet delegate-sheet-input-mixin) event)
220     (dispatch-event (delegate-sheet-delegate sheet) event))
221    
222     (defmethod queue-event ((sheet delegate-sheet-input-mixin) event)
223     (queue-event (delegate-sheet-delegate sheet) event))
224    
225     (defmethod handle-event ((sheet delegate-sheet-input-mixin) event)
226     (handle-event (delegate-sheet-delegate sheet) event))
227    
228     (defmethod event-read ((sheet delegate-sheet-input-mixin))
229     (event-read (delegate-sheet-delegate sheet)))
230 boninfan 1.3
231     (defmethod event-read-with-timeout ((sheet delegate-sheet-input-mixin)
232     &key (timeout nil) (wait-function nil))
233     (event-read-with-timeout (delegate-sheet-delegate sheet)
234     :timeout timeout :wait-function wait-function))
235 mikemac 1.1
236     (defmethod event-read-no-hang ((sheet delegate-sheet-input-mixin))
237     (event-read-no-hang (delegate-sheet-delegate sheet)))
238    
239     (defmethod event-peek ((sheet delegate-sheet-input-mixin) &optional event-type)
240     (event-peek (delegate-sheet-delegate sheet) event-type))
241    
242     (defmethod event-unread ((sheet delegate-sheet-input-mixin) event)
243     (event-unread (delegate-sheet-delegate sheet) event))
244    
245     (defmethod event-listen ((sheet delegate-sheet-input-mixin))
246     (event-listen (delegate-sheet-delegate sheet)))
247    

  ViewVC Help
Powered by ViewVC 1.1.5