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

Contents of /mcclim/input.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide 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 mikemac 1.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 cvs 1.2 (if (typep event 'device-event)
33     (queue-event sheet event)
34     (handle-event sheet event)))
35 mikemac 1.1
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