Changeset 15100

Timestamp:

Dec 1, 2011, 2:44:22 PM (13 years ago)

Author:

gz

Message:

Add abortable stream-peek-char and stream-listen methods for listener input stream

File:

• trunk/source/cocoa-ide/cocoa-listener.lisp (modified) (3 diffs)

trunk/source/cocoa-ide/cocoa-listener.lisp

@@ -58 +58 @@
 
 
-
-(defmethod dequeue-listener-char ((stream cocoa-listener-input-stream) wait-p)
+(defmethod queued-listener-char ((stream cocoa-listener-input-stream) wait-p dequeue-p)
   (with-slots (queue queue-lock read-lock queue-semaphore text-semaphore cur-string cur-string-pos) stream
     (with-lock-grabbed (read-lock)
       (or (with-lock-grabbed (queue-lock)
             (when (< cur-string-pos (length cur-string))
-              (prog1 (aref cur-string cur-string-pos) (incf cur-string-pos))))
+              (prog1 (aref cur-string cur-string-pos) (and dequeue-p (incf cur-string-pos)))))
           (loop
             (unless (if wait-p
@@ -76 +75 @@
                 (setq queue (delq s queue 1))
                 (when (< 0 (length s))
-                  (setf cur-string s cur-string-pos 1)
+                  (setf cur-string s cur-string-pos (if dequeue-p 1 0))
                   (return (aref s 0))))))))))
 
@@ -133 +132 @@
 
 (defmethod enqueue-listener-input ((stream cocoa-listener-input-stream) string)
-  (with-slots (queue-lock queue queue-semaphore text-semaphore) stream
-    (with-lock-grabbed (queue-lock)
-      (setq queue (nconc queue (list string)))
-      (signal-semaphore queue-semaphore)
-      (signal-semaphore text-semaphore))))
+  (when (> (length string) 0)
+    (with-slots (queue-lock queue queue-semaphore text-semaphore) stream
+      (with-lock-grabbed (queue-lock)
+        (setq queue (nconc queue (list string)))
+        (signal-semaphore queue-semaphore)
+        (signal-semaphore text-semaphore)))))
 
 (defmethod stream-read-char-no-hang ((stream cocoa-listener-input-stream))
-  (dequeue-listener-char stream nil))
+  (queued-listener-char stream nil t))
 
 (defmethod stream-read-char ((stream cocoa-listener-input-stream))
-  (dequeue-listener-char stream t))
+  (queued-listener-char stream t t))
+
+;; The default implementation of peek-char will lose the character if aborted. This won't.
+(defmethod stream-peek-char ((stream cocoa-listener-input-stream))
+  (queued-listener-char stream t nil))
+
+(defmethod stream-listen ((stream cocoa-listener-input-stream))
+  (queued-listener-char stream nil nil))
 
 (defmethod stream-unread-char ((stream cocoa-listener-input-stream) char)