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

Contents of /mcclim/input.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Wed Nov 29 19:51:45 2000 UTC (13 years, 4 months ago) by cvs
Branch: MAIN
Changes since 1.1: +3 -1 lines
dispatch-event handles window events immediately
1 ;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-
2
3 ;;; (c) copyright 1998,1999,2000 by Michael McDonald (mikemac@mikemac.com)
4
5 ;;; This library is free software; you can redistribute it and/or
6 ;;; modify it under the terms of the GNU Library General Public
7 ;;; License as published by the Free Software Foundation; either
8 ;;; version 2 of the License, or (at your option) any later version.
9 ;;;
10 ;;; This library is distributed in the hope that it will be useful,
11 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;;; Library General Public License for more details.
14 ;;;
15 ;;; You should have received a copy of the GNU Library General Public
16 ;;; License along with this library; if not, write to the
17 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
18 ;;; Boston, MA 02111-1307 USA.
19
20 (in-package :CLIM-INTERNALS)
21
22 ;;; Input Protocol Classes
23
24 (defclass standard-sheet-input-mixin ()
25 ((queue :initform nil)
26 (port :initform nil
27 :initarg :port
28 :reader port)
29 ))
30
31 (defmethod dispatch-event ((sheet standard-sheet-input-mixin) event)
32 (if (typep event 'device-event)
33 (queue-event sheet event)
34 (handle-event sheet event)))
35
36 (defmethod queue-event ((sheet standard-sheet-input-mixin) event)
37 (with-slots (queue) sheet
38 (setq queue (nconc queue (list event)))))
39
40 (defmethod handle-event ((sheet standard-sheet-input-mixin) event)
41 ;; Standard practice is too ignore events
42 (declare (ignore event))
43 nil)
44
45 (defmethod event-read ((sheet standard-sheet-input-mixin))
46 (with-slots (queue) sheet
47 (loop while (null queue)
48 do (process-next-event (port sheet)))
49 (pop queue)))
50
51 (defmethod event-read-no-hang ((sheet standard-sheet-input-mixin))
52 (with-slots (queue) sheet
53 (if (null queue)
54 nil
55 (pop queue))))
56
57 (defmethod event-peek ((sheet standard-sheet-input-mixin) &optional event-type)
58 (with-slots (queue) sheet
59 (if event-type
60 (loop while (and queue (not (typep (first queue) event-type)))
61 do (pop queue)))
62 (if (null queue)
63 nil
64 (first queue))))
65
66 (defmethod event-unread ((sheet standard-sheet-input-mixin) event)
67 (with-slots (queue) sheet
68 (push event queue)))
69
70 (defmethod event-listen ((sheet standard-sheet-input-mixin))
71 (with-slots (queue) sheet
72 (not (null queue))))
73
74 (defclass immediate-sheet-input-mixin (standard-sheet-input-mixin)
75 (
76 ))
77
78 (defmethod dispatch-event ((sheet immediate-sheet-input-mixin) event)
79 (handle-event sheet event))
80
81 (define-condition sheet-is-mute-for-input (error)
82 (
83 ))
84
85 (defclass mute-sheet-input-mixin ()
86 (
87 ))
88
89 (defmethod dispatch-event ((sheet mute-sheet-input-mixin) event)
90 (declare (ignore event))
91 (error 'sheet-is-mute-for-input))
92
93 (defmethod queue-event ((sheet mute-sheet-input-mixin) event)
94 (declare (ignore event))
95 (error 'sheet-is-mute-for-input))
96
97 (defmethod handle-event ((sheet mute-sheet-input-mixin) event)
98 (declare (ignore event))
99 (error 'sheet-is-mute-for-input))
100
101 (defmethod event-read ((sheet mute-sheet-input-mixin))
102 (error 'sheet-is-mute-for-input))
103
104 (defmethod event-read-no-hang ((sheet mute-sheet-input-mixin))
105 (error 'sheet-is-mute-for-input))
106
107 (defmethod event-peek ((sheet mute-sheet-input-mixin) &optional event-type)
108 (declare (ignore event-type))
109 (error 'sheet-is-mute-for-input))
110
111 (defmethod event-unread ((sheet mute-sheet-input-mixin) event)
112 (declare (ignore event))
113 (error 'sheet-is-mute-for-input))
114
115 (defmethod event-listen ((sheet mute-sheet-input-mixin))
116 (error 'sheet-is-mute-for-input))
117
118 (defclass delegate-sheet-input-mixin ()
119 ((delegate :initform nil
120 :initarg :delegate
121 :accessor delegate-sheet-delegate)
122 ))
123
124 (defmethod dispatch-event ((sheet delegate-sheet-input-mixin) event)
125 (dispatch-event (delegate-sheet-delegate sheet) event))
126
127 (defmethod queue-event ((sheet delegate-sheet-input-mixin) event)
128 (queue-event (delegate-sheet-delegate sheet) event))
129
130 (defmethod handle-event ((sheet delegate-sheet-input-mixin) event)
131 (handle-event (delegate-sheet-delegate sheet) event))
132
133 (defmethod event-read ((sheet delegate-sheet-input-mixin))
134 (event-read (delegate-sheet-delegate sheet)))
135
136 (defmethod event-read-no-hang ((sheet delegate-sheet-input-mixin))
137 (event-read-no-hang (delegate-sheet-delegate sheet)))
138
139 (defmethod event-peek ((sheet delegate-sheet-input-mixin) &optional event-type)
140 (event-peek (delegate-sheet-delegate sheet) event-type))
141
142 (defmethod event-unread ((sheet delegate-sheet-input-mixin) event)
143 (event-unread (delegate-sheet-delegate sheet) event))
144
145 (defmethod event-listen ((sheet delegate-sheet-input-mixin))
146 (event-listen (delegate-sheet-delegate sheet)))
147

  ViewVC Help
Powered by ViewVC 1.1.5