/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

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

revision 1.774 by heller, Wed Dec 7 18:27:17 2011 UTC revision 1.775 by heller, Wed Dec 7 21:06:30 2011 UTC
# Line 228  Backend code should treat the connection Line 228  Backend code should treat the connection
228                                        (:conc-name sconn.))                                        (:conc-name sconn.))
229    ;; The SIGINT handler we should restore when the connection is    ;; The SIGINT handler we should restore when the connection is
230    ;; closed.    ;; closed.
231    saved-sigint-handler)    saved-sigint-handler
232      ;; A queue of events.  Not all events can be processed in order and
233      ;; we need a place to stored them.
234      (event-queue '() :type list)
235      ;; A counter that is incremented whenever an event is added to the
236      ;; queue.  This is used to detected modifications to the event queue
237      ;; by interrupts.  The counter wraps around.
238      (events-enqueued 0 :type fixnum))
239    
240  (defstruct (multithreaded-connection (:include connection)  (defstruct (multithreaded-connection (:include connection)
241                                       (:conc-name mconn.))                                       (:conc-name mconn.))
# Line 1008  The processing is done in the extent of Line 1015  The processing is done in the extent of
1015    
1016  (defun send-event (thread event)  (defun send-event (thread event)
1017    (log-event "send-event: ~s ~s~%" thread event)    (log-event "send-event: ~s ~s~%" thread event)
1018    (cond ((use-threads-p) (send thread event))    (let ((c *emacs-connection*))
1019          (t (setf *event-queue* (nconc *event-queue* (list event)))      (etypecase c
1020             (setf *events-enqueued* (mod (1+ *events-enqueued*)        (multithreaded-connection
1021                                          most-positive-fixnum)))))         (send thread event))
1022          (singlethreaded-connection
1023           (setf (sconn.event-queue c) (nconc (sconn.event-queue c) (list event)))
1024           (setf (sconn.events-enqueued c) (mod (1+ (sconn.events-enqueued c))
1025                                                most-positive-fixnum))))))
1026    
1027  (defun send-to-emacs (event)  (defun send-to-emacs (event)
1028    "Send EVENT to Emacs."    "Send EVENT to Emacs."
# Line 1065  event was found." Line 1076  event was found."
1076    (assert (or (not timeout) (eq timeout t)))    (assert (or (not timeout) (eq timeout t)))
1077    (loop    (loop
1078     (check-slime-interrupts)     (check-slime-interrupts)
1079     (let ((event (poll-for-event pattern)))     (let ((event (poll-for-event connection pattern)))
1080       (when event (return (car event))))       (when event (return (car event))))
1081     (let ((events-enqueued *events-enqueued*)     (let ((events-enqueued (sconn.events-enqueued connection))
1082           (ready (wait-for-input (list (current-socket-io)) timeout)))           (ready (wait-for-input (list (current-socket-io)) timeout)))
1083       (cond ((and timeout (not ready))       (cond ((and timeout (not ready))
1084              (return (values nil t)))              (return (values nil t)))
1085             ((or (/= events-enqueued *events-enqueued*)             ((or (/= events-enqueued (sconn.events-enqueued connection))
1086                  (eq ready :interrupt))                  (eq ready :interrupt))
1087              ;; rescan event queue, interrupts may enqueue new events              ;; rescan event queue, interrupts may enqueue new events
1088              )              )
# Line 1080  event was found." Line 1091  event was found."
1091              (dispatch-event connection              (dispatch-event connection
1092                              (decode-message (current-socket-io))))))))                              (decode-message (current-socket-io))))))))
1093    
1094  (defun poll-for-event (pattern)  (defun poll-for-event (connection pattern)
1095    (let ((tail (member-if (lambda (e) (event-match-p e pattern))    (let* ((c connection)
1096                           *event-queue*)))           (tail (member-if (lambda (e) (event-match-p e pattern))
1097                              (sconn.event-queue c))))
1098      (when tail      (when tail
1099        (setq *event-queue* (nconc (ldiff *event-queue* tail)        (setf (sconn.event-queue c)
1100                                   (cdr tail)))              (nconc (ldiff (sconn.event-queue c) tail) (cdr tail)))
1101        tail)))        tail)))
1102    
1103  ;;; FIXME: Make this use SWANK-MATCH.  ;;; FIXME: Make this use SWANK-MATCH.

Legend:
Removed from v.1.774  
changed lines
  Added in v.1.775

  ViewVC Help
Powered by ViewVC 1.1.5