/[cmucl]/src/code/serve-event.lisp
ViewVC logotype

Diff of /src/code/serve-event.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.29 by rtoy, Fri Mar 19 15:18:59 2010 UTC revision 1.30 by rtoy, Mon Apr 19 02:18:04 2010 UTC
# Line 125  Line 125 
125  ;;;    Look up the handler function for a given message ID.  ;;;    Look up the handler function for a given message ID.
126  ;;;  ;;;
127  (defun object-set-operation (object-set message-id)  (defun object-set-operation (object-set message-id)
128    _N"Return the handler function in Object-Set for the operation specified by    "Return the handler function in Object-Set for the operation specified by
129     Message-ID, if none, NIL is returned."     Message-ID, if none, NIL is returned."
130    (check-type object-set object-set)    (check-type object-set object-set)
131    (check-type message-id fixnum)    (check-type message-id fixnum)
# Line 141  Line 141 
141    (setf (gethash message-id (object-set-table object-set)) new-value))    (setf (gethash message-id (object-set-table object-set)) new-value))
142  ;;;  ;;;
143  (defsetf object-set-operation %set-object-set-operation  (defsetf object-set-operation %set-object-set-operation
144    _N"Sets the handler function for an object set operation.")    "Sets the handler function for an object set operation.")
145    
146    
147    
# Line 170  Line 170 
170            (handler-function handler)))            (handler-function handler)))
171    
172  (defvar *descriptor-handlers* nil  (defvar *descriptor-handlers* nil
173    _N"List of all the currently active handlers for file descriptors")    "List of all the currently active handlers for file descriptors")
174    
175  ;;; ADD-FD-HANDLER -- public  ;;; ADD-FD-HANDLER -- public
176  ;;;  ;;;
177  ;;;   Add a new handler to *descriptor-handlers*.  ;;;   Add a new handler to *descriptor-handlers*.
178  ;;;  ;;;
179  (defun add-fd-handler (fd direction function)  (defun add-fd-handler (fd direction function)
180    _N"Arange to call FUNCTION whenever FD is usable. DIRECTION should be    "Arange to call FUNCTION whenever FD is usable. DIRECTION should be
181    either :INPUT or :OUTPUT. The value returned should be passed to    either :INPUT or :OUTPUT. The value returned should be passed to
182    SYSTEM:REMOVE-FD-HANDLER when it is no longer needed."    SYSTEM:REMOVE-FD-HANDLER when it is no longer needed."
183    (assert (member direction '(:input :output))    (assert (member direction '(:input :output))
# Line 192  Line 192 
192  ;;;   Remove an old handler from *descriptor-handlers*.  ;;;   Remove an old handler from *descriptor-handlers*.
193  ;;;  ;;;
194  (defun remove-fd-handler (handler)  (defun remove-fd-handler (handler)
195    _N"Removes HANDLER from the list of active handlers."    "Removes HANDLER from the list of active handlers."
196    (setf *descriptor-handlers*    (setf *descriptor-handlers*
197          (delete handler *descriptor-handlers*          (delete handler *descriptor-handlers*
198                  :test #'eq)))                  :test #'eq)))
# Line 202  Line 202 
202  ;;;   Search *descriptor-handlers* for any reference to fd, and nuke 'em.  ;;;   Search *descriptor-handlers* for any reference to fd, and nuke 'em.
203  ;;;  ;;;
204  (defun invalidate-descriptor (fd)  (defun invalidate-descriptor (fd)
205    _N"Remove any handers refering to FD. This should only be used when attempting    "Remove any handers refering to FD. This should only be used when attempting
206    to recover from a detected inconsistency."    to recover from a detected inconsistency."
207    (setf *descriptor-handlers*    (setf *descriptor-handlers*
208          (delete fd *descriptor-handlers*          (delete fd *descriptor-handlers*
# Line 213  Line 213 
213  ;;; Add the handler to *descriptor-handlers* for the duration of BODY.  ;;; Add the handler to *descriptor-handlers* for the duration of BODY.
214  ;;;  ;;;
215  (defmacro with-fd-handler ((fd direction function) &rest body)  (defmacro with-fd-handler ((fd direction function) &rest body)
216    _N"Establish a handler with SYSTEM:ADD-FD-HANDLER for the duration of BODY.    "Establish a handler with SYSTEM:ADD-FD-HANDLER for the duration of BODY.
217     DIRECTION should be either :INPUT or :OUTPUT, FD is the file descriptor to     DIRECTION should be either :INPUT or :OUTPUT, FD is the file descriptor to
218     use, and FUNCTION is the function to call whenever FD is usable."     use, and FUNCTION is the function to call whenever FD is usable."
219    (let ((handler (gensym)))    (let ((handler (gensym)))
# Line 289  Line 289 
289  ;;; the meantime.  ;;; the meantime.
290  ;;;  ;;;
291  (defun wait-until-fd-usable (fd direction &optional timeout)  (defun wait-until-fd-usable (fd direction &optional timeout)
292    _N"Wait until FD is usable for DIRECTION. DIRECTION should be either :INPUT or    "Wait until FD is usable for DIRECTION. DIRECTION should be either :INPUT or
293    :OUTPUT. TIMEOUT, if supplied, is the number of seconds to wait before giving    :OUTPUT. TIMEOUT, if supplied, is the number of seconds to wait before giving
294    up."    up."
295    (declare (type (or real null) timeout))    (declare (type (or real null) timeout))
# Line 336  Line 336 
336    
337    
338  (defvar *display-event-handlers* nil  (defvar *display-event-handlers* nil
339    _N"This is an alist mapping displays to user functions to be called when    "This is an alist mapping displays to user functions to be called when
340     SYSTEM:SERVE-EVENT notices input on a display connection.  Do not modify     SYSTEM:SERVE-EVENT notices input on a display connection.  Do not modify
341     this directly; use EXT:ENABLE-CLX-EVENT-HANDLING.  A given display     this directly; use EXT:ENABLE-CLX-EVENT-HANDLING.  A given display
342     should be represented here only once.")     should be represented here only once.")
# Line 347  Line 347 
347  ;;; pending events are processed before returning.  ;;; pending events are processed before returning.
348  ;;;  ;;;
349  (defun serve-all-events (&optional timeout)  (defun serve-all-events (&optional timeout)
350    _N"SERVE-ALL-EVENTS calls SERVE-EVENT with the specified timeout.  If    "SERVE-ALL-EVENTS calls SERVE-EVENT with the specified timeout.  If
351    SERVE-EVENT does something (returns T) it loops over SERVE-EVENT with timeout    SERVE-EVENT does something (returns T) it loops over SERVE-EVENT with timeout
352    0 until all events have been served.  SERVE-ALL-EVENTS returns T if    0 until all events have been served.  SERVE-ALL-EVENTS returns T if
353    SERVE-EVENT did something and NIL if not."    SERVE-EVENT did something and NIL if not."
# Line 362  Line 362 
362  ;;;   Serve a single event.  ;;;   Serve a single event.
363  ;;;  ;;;
364  (defun serve-event (&optional timeout)  (defun serve-event (&optional timeout)
365    _N"Receive on all ports and Xevents and dispatch to the appropriate handler    "Receive on all ports and Xevents and dispatch to the appropriate handler
366    function.  If timeout is specified, server will wait the specified time (in    function.  If timeout is specified, server will wait the specified time (in
367    seconds) and then return, otherwise it will wait until something happens.    seconds) and then return, otherwise it will wait until something happens.
368    Server returns T if something happened and NIL otherwise."    Server returns T if something happened and NIL otherwise."

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.30

  ViewVC Help
Powered by ViewVC 1.1.5