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

Contents of /mcclim/input.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Thu Jun 8 22:01:12 2000 UTC (13 years, 10 months ago) by mikemac
Branch: MAIN
Branch point for: initial
Initial revision
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     (queue-event sheet event))
33    
34     (defmethod queue-event ((sheet standard-sheet-input-mixin) event)
35     (with-slots (queue) sheet
36     (setq queue (nconc queue (list event)))))
37    
38     (defmethod handle-event ((sheet standard-sheet-input-mixin) event)
39     ;; Standard practice is too ignore events
40     (declare (ignore event))
41     nil)
42    
43     (defmethod event-read ((sheet standard-sheet-input-mixin))
44     (with-slots (queue) sheet
45     (loop while (null queue)
46     do (process-next-event (port sheet)))
47     (pop queue)))
48    
49     (defmethod event-read-no-hang ((sheet standard-sheet-input-mixin))
50     (with-slots (queue) sheet
51     (if (null queue)
52     nil
53     (pop queue))))
54    
55     (defmethod event-peek ((sheet standard-sheet-input-mixin) &optional event-type)
56     (with-slots (queue) sheet
57     (if event-type
58     (loop while (and queue (not (typep (first queue) event-type)))
59     do (pop queue)))
60     (if (null queue)
61     nil
62     (first queue))))
63    
64     (defmethod event-unread ((sheet standard-sheet-input-mixin) event)
65     (with-slots (queue) sheet
66     (push event queue)))
67    
68     (defmethod event-listen ((sheet standard-sheet-input-mixin))
69     (with-slots (queue) sheet
70     (not (null queue))))
71    
72     (defclass immediate-sheet-input-mixin (standard-sheet-input-mixin)
73     (
74     ))
75    
76     (defmethod dispatch-event ((sheet immediate-sheet-input-mixin) event)
77     (handle-event sheet event))
78    
79     (define-condition sheet-is-mute-for-input (error)
80     (
81     ))
82    
83     (defclass mute-sheet-input-mixin ()
84     (
85     ))
86    
87     (defmethod dispatch-event ((sheet mute-sheet-input-mixin) event)
88     (declare (ignore event))
89     (error 'sheet-is-mute-for-input))
90    
91     (defmethod queue-event ((sheet mute-sheet-input-mixin) event)
92     (declare (ignore event))
93     (error 'sheet-is-mute-for-input))
94    
95     (defmethod handle-event ((sheet mute-sheet-input-mixin) event)
96     (declare (ignore event))
97     (error 'sheet-is-mute-for-input))
98    
99     (defmethod event-read ((sheet mute-sheet-input-mixin))
100     (error 'sheet-is-mute-for-input))
101    
102     (defmethod event-read-no-hang ((sheet mute-sheet-input-mixin))
103     (error 'sheet-is-mute-for-input))
104    
105     (defmethod event-peek ((sheet mute-sheet-input-mixin) &optional event-type)
106     (declare (ignore event-type))
107     (error 'sheet-is-mute-for-input))
108    
109     (defmethod event-unread ((sheet mute-sheet-input-mixin) event)
110     (declare (ignore event))
111     (error 'sheet-is-mute-for-input))
112    
113     (defmethod event-listen ((sheet mute-sheet-input-mixin))
114     (error 'sheet-is-mute-for-input))
115    
116     (defclass delegate-sheet-input-mixin ()
117     ((delegate :initform nil
118     :initarg :delegate
119     :accessor delegate-sheet-delegate)
120     ))
121    
122     (defmethod dispatch-event ((sheet delegate-sheet-input-mixin) event)
123     (dispatch-event (delegate-sheet-delegate sheet) event))
124    
125     (defmethod queue-event ((sheet delegate-sheet-input-mixin) event)
126     (queue-event (delegate-sheet-delegate sheet) event))
127    
128     (defmethod handle-event ((sheet delegate-sheet-input-mixin) event)
129     (handle-event (delegate-sheet-delegate sheet) event))
130    
131     (defmethod event-read ((sheet delegate-sheet-input-mixin))
132     (event-read (delegate-sheet-delegate sheet)))
133    
134     (defmethod event-read-no-hang ((sheet delegate-sheet-input-mixin))
135     (event-read-no-hang (delegate-sheet-delegate sheet)))
136    
137     (defmethod event-peek ((sheet delegate-sheet-input-mixin) &optional event-type)
138     (event-peek (delegate-sheet-delegate sheet) event-type))
139    
140     (defmethod event-unread ((sheet delegate-sheet-input-mixin) event)
141     (event-unread (delegate-sheet-delegate sheet) event))
142    
143     (defmethod event-listen ((sheet delegate-sheet-input-mixin))
144     (event-listen (delegate-sheet-delegate sheet)))
145    

  ViewVC Help
Powered by ViewVC 1.1.5