/[cmucl]/src/clx/input.lisp
ViewVC logotype

Diff of /src/clx/input.lisp

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

revision 1.4 by ram, Fri Sep 30 16:05:03 1994 UTC revision 1.5 by dtc, Fri Jun 5 02:45:28 1998 UTC
# Line 382  Line 382 
382  (defun read-input (display timeout force-output-p predicate &rest predicate-args)  (defun read-input (display timeout force-output-p predicate &rest predicate-args)
383    (declare (type display display)    (declare (type display display)
384             (type (or null number) timeout)             (type (or null number) timeout)
385             (type boolean force-output-p)             (type generalized-boolean force-output-p)
386             (dynamic-extent predicate-args))             (dynamic-extent predicate-args))
387    (declare (type function predicate)    (declare (type function predicate)
388             #+clx-ansi-common-lisp             #+clx-ansi-common-lisp
# Line 503  Line 503 
503  (defun wait-for-event (display timeout force-output-p)  (defun wait-for-event (display timeout force-output-p)
504    (declare (type display display)    (declare (type display display)
505             (type (or null number) timeout)             (type (or null number) timeout)
506             (type boolean force-output-p))             (type generalized-boolean force-output-p))
507    (let ((event-process-p (not (eql timeout 0))))    (let ((event-process-p (not (eql timeout 0))))
508      (declare (type boolean event-process-p))      (declare (type generalized-boolean event-process-p))
509      (unwind-protect      (unwind-protect
510          (loop          (loop
511            (when event-process-p            (when event-process-p
# Line 592  Line 592 
592    ;; in the event components.    ;; in the event components.
593    (declare (type display display)    (declare (type display display)
594             (type event-key event-key)             (type event-key event-key)
595             (type boolean append-p send-event-p)             (type generalized-boolean append-p send-event-p)
596             (dynamic-extent args))             (dynamic-extent args))
597    (unless (get event-key 'event-code)    (unless (get event-key 'event-code)
598      (x-type-error event-key 'event-key))      (x-type-error event-key 'event-key))
# Line 750  Line 750 
750                  ,(getf `(:display (the display ,display)                  ,(getf `(:display (the display ,display)
751                           :event-key (the keyword ,event-key)                           :event-key (the keyword ,event-key)
752                           :event-code (the card8 (logand #x7f (read-card8 0)))                           :event-code (the card8 (logand #x7f (read-card8 0)))
753                           :send-event-p (the boolean (logbitp 7 (read-card8 0)))                           :send-event-p (logbitp 7 (read-card8 0))
754                           ,@',(mapcar #'(lambda (form)                           ,@',(mapcar #'(lambda (form)
755                                           (clx-macroexpand form env))                                           (clx-macroexpand form env))
756                                       get-code))                                       get-code))
# Line 1025  Line 1025 
1025  (defun event-loop-step-before (display timeout force-output-p current-event-symbol)  (defun event-loop-step-before (display timeout force-output-p current-event-symbol)
1026    (declare (type display display)    (declare (type display display)
1027             (type (or null number) timeout)             (type (or null number) timeout)
1028             (type boolean force-output-p)             (type generalized-boolean force-output-p)
1029             (type symbol current-event-symbol)             (type symbol current-event-symbol)
1030             (clx-values event eof-or-timeout))             (clx-values event eof-or-timeout))
1031    (unless (symbol-value current-event-symbol)    (unless (symbol-value current-event-symbol)
# Line 1074  Line 1074 
1074          &optional aborted)          &optional aborted)
1075    (declare (type display display)    (declare (type display display)
1076             (type reply-buffer event)             (type reply-buffer event)
1077             (type boolean discard-p aborted)             (type generalized-boolean discard-p aborted)
1078             (type symbol current-event-symbol current-event-discarded-p-symbol))             (type symbol current-event-symbol current-event-discarded-p-symbol))
1079    (when (and discard-p    (when (and discard-p
1080               (not aborted)               (not aborted)
# Line 1097  Line 1097 
1097           (.discard-p. ,discard-p))           (.discard-p. ,discard-p))
1098       (declare (type display .display.)       (declare (type display .display.)
1099                (type (or null number) .timeout.)                (type (or null number) .timeout.)
1100                (type boolean .force-output-p. .discard-p.))                (type generalized-boolean .force-output-p. .discard-p.))
1101       (with-event-queue (.display. ,@(and timeout `(:timeout .timeout.)))       (with-event-queue (.display. ,@(and timeout `(:timeout .timeout.)))
1102         (multiple-value-bind (.progv-vars. .progv-vals.         (multiple-value-bind (.progv-vars. .progv-vals.
1103                               .current-event-symbol. .current-event-discarded-p-symbol.)                               .current-event-symbol. .current-event-discarded-p-symbol.)
# Line 1132  Line 1132 
1132    ;; inside even-case, event-cond or process-event when :peek-p is T and    ;; inside even-case, event-cond or process-event when :peek-p is T and
1133    ;; :discard-p is NIL.    ;; :discard-p is NIL.
1134    (declare (type display display)    (declare (type display display)
1135             (clx-values boolean))             (clx-values generalized-boolean))
1136    (let* ((symbols (display-current-event-symbol display))    (let* ((symbols (display-current-event-symbol display))
1137           (event           (event
1138             (let ((current-event-symbol (first symbols)))             (let ((current-event-symbol (first symbols)))
# Line 1172  Line 1172 
1172    
1173    (declare (type display display)    (declare (type display display)
1174             (type (or null number) timeout)             (type (or null number) timeout)
1175             (type boolean peek-p discard-p force-output-p))             (type generalized-boolean peek-p discard-p force-output-p))
1176    (declare (type t handler)    (declare (type t handler)
1177             #+clx-ansi-common-lisp             #+clx-ansi-common-lisp
1178             (dynamic-extent handler)             (dynamic-extent handler)
# Line 1324  Line 1324 
1324    (getf    (getf
1325      `(:display (the display ,display) :event-key (the keyword ,event-key) :event-code      `(:display (the display ,display) :event-key (the keyword ,event-key) :event-code
1326                 (the card8 (logand 127 (read-card8 0))) :send-event-p                 (the card8 (logand 127 (read-card8 0))) :send-event-p
1327                 (the boolean (logbitp 7 (read-card8 0))))                 (logbitp 7 (read-card8 0)))
1328      variable))      variable))
1329    
1330  (defmacro event-dispatch ((display event peek-p) &body clauses)  (defmacro event-dispatch ((display event peek-p) &body clauses)
# Line 1482  Line 1482 
1482  (defun make-error (display event asynchronous)  (defun make-error (display event asynchronous)
1483    (declare (type display display)    (declare (type display display)
1484             (type reply-buffer event)             (type reply-buffer event)
1485             (type boolean asynchronous))             (type generalized-boolean asynchronous))
1486    (reading-event (event)    (reading-event (event)
1487      (let* ((error-code (read-card8 1))      (let* ((error-code (read-card8 1))
1488             (error-key (get-error-key display error-code))             (error-key (get-error-key display error-code))

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

  ViewVC Help
Powered by ViewVC 1.1.5