Changeset 715

Timestamp:

Mar 24, 2004, 12:49:58 AM (21 years ago)

Author:

Gary Byers

Message:

Get FDs right when starting a listener process. Note package correctly.

File:

• trunk/ccl/examples/cocoa-listener.lisp (modified) (3 diffs)

trunk/ccl/examples/cocoa-listener.lisp

@@ -28 +28 @@
     ((input-stream :reader cocoa-listener-process-input-stream)))
 
-(defun new-cocoa-listener-process (procname input-fd output-fd)
+(defun new-cocoa-listener-process (procname input-fd output-fd peer-fd)
   (let* ((input-stream (make-selection-input-stream
                         input-fd
-                        :peer-fd output-fd
+                        :peer-fd peer-fd
                         :elements-per-buffer (#_fpathconf
                                               input-fd
@@ -222 +222 @@
     (send controller 'release)
     (setf (hi::buffer-process (hemlock-document-buffer self))
-          (let* ((tty (slot-value controller 'clientfd)))
-            (new-cocoa-listener-process listener-name tty tty)))
+          (let* ((tty (slot-value controller 'clientfd))
+                 (peer-tty (send (slot-value controller 'filehandle)
+                                 'file-descriptor)))
+            (new-cocoa-listener-process listener-name tty tty peer-tty)))
     controller))
 
@@ -252 +254 @@
 
 (defun cocoa-ide-note-package (package)
-  (process-interrupt *cocoa-event-process*
-                       #'(lambda (proc name)
-                           (dolist (buf hi::*buffer-list*)
-                             (when (eq proc (hi::buffer-process buf))
-                               (setf (hi::variable-value 'hemlock::current-package :buffer buf) name))))
-                       *current-process*
-                       (shortest-package-name package)))
+  (with-autorelease-pool
+      (process-interrupt *cocoa-event-process*
+                         #'(lambda (proc name)
+                             (dolist (buf hi::*buffer-list*)
+                               (when (eq proc (hi::buffer-process buf))
+                                 (setf (hi::variable-value 'hemlock::current-package :buffer buf) name))))
+                         *current-process*
+                         (shortest-package-name package))))
 
 (defmethod hi::send-string-to-listener-process ((process cocoa-listener-process)