Index: /branches/ide-1.0/ccl/examples/cocoa-listener.lisp
===================================================================
--- /branches/ide-1.0/ccl/examples/cocoa-listener.lisp	(revision 6671)
+++ /branches/ide-1.0/ccl/examples/cocoa-listener.lisp	(revision 6672)
@@ -21,4 +21,5 @@
 ;;; Setup the server end of a pty pair.
 (defun setup-server-pty (pty)
+  (set-tty-raw pty)
   pty)
 
@@ -29,5 +30,8 @@
   ;; Has this been true for the last few years (native threads) ?
   ;(fd-set-flag pty #$O_NONBLOCK)
+  (set-tty-raw pty)
+  #+no
   (disable-tty-local-modes pty (logior #$ECHO #$ECHOCTL #$ISIG))
+  #+no
   (disable-tty-output-modes pty #$ONLCR)  
   pty)
@@ -38,9 +42,12 @@
 (defclass cocoa-listener-process (process)
     ((input-stream :reader cocoa-listener-process-input-stream)
+     (output-stream :reader cocoa-listener-process-output-stream)
      (backtrace-contexts :initform nil
-                         :accessor cocoa-listener-process-backtrace-contexts)))
+                         :accessor cocoa-listener-process-backtrace-contexts)
+     (window :reader cocoa-listener-process-window)
+     (buffer :initform nil :reader cocoa-listener-process-buffer)))
   
 
-(defun new-cocoa-listener-process (procname input-fd output-fd peer-fd)
+(defun new-cocoa-listener-process (procname input-fd output-fd peer-fd window buffer)
   (let* ((input-stream (make-selection-input-stream
                         input-fd
@@ -48,15 +55,18 @@
                         :elements-per-buffer (#_fpathconf
                                               input-fd
-                                              #$_PC_MAX_INPUT)))
+                                              #$_PC_MAX_INPUT)
+                        :encoding :utf-8))
+         (output-stream (make-fd-stream output-fd :direction :output
+                                        :sharing :lock
+                                        :elements-per-buffer
+                                        (#_fpathconf
+                                         output-fd
+                                         #$_PC_MAX_INPUT)
+                                        :encoding :utf-8))
          (proc
           (make-mcl-listener-process 
            procname
            input-stream
-           (make-fd-stream output-fd :direction :output
-                           :sharing :lock
-                           :elements-per-buffer
-                           (#_fpathconf
-                            output-fd
-                            #$_PC_MAX_INPUT))
+           output-stream
            #'(lambda ()`
                (let* ((buf (find *current-process* hi:*buffer-list*
@@ -76,4 +86,7 @@
            :class 'cocoa-listener-process)))
     (setf (slot-value proc 'input-stream) input-stream)
+    (setf (slot-value proc 'output-stream) output-stream)
+    (setf (slot-value proc 'window) window)
+    (setf (slot-value proc 'buffer) buffer)
     proc))
          
@@ -84,4 +97,7 @@
     ((filehandle :foreign-type :id)	;Filehandle for I/O
      (clientfd :foreign-type :int)	;Client (listener)'s side of pty
+     (nextra :foreign-type :int)        ;count of untranslated bytes remaining
+     (translatebuf :foreign-type :address) ;buffer for utf8 translation
+     (bufsize :foreign-type :int)       ;size of translatebuf
      )
   (:metaclass ns:+ns-object)
@@ -107,4 +123,9 @@
 	    (setf (slot-value new 'filehandle) fh)
 	    (setf (slot-value new 'clientfd) (setup-client-pty client))
+            (let* ((bufsize #$BUFSIZ)
+                   (buffer (#_malloc bufsize)))
+              (setf (slot-value new 'translatebuf) buffer
+                    (slot-value new 'bufsize) bufsize
+                    (slot-value new 'nextra) 0))
             (#/addObserver:selector:name:object:
              (#/defaultCenter ns:ns-notification-center)
@@ -118,18 +139,53 @@
 (objc:defmethod (#/gotData: :void) ((self hemlock-listener-window-controller)
                                     notification)
-  #+debug (#_NSLog #@"gotData: !")
-  (with-slots (filehandle) self
+  (with-slots (filehandle nextra translatebuf bufsize) self
     (let* ((data (#/objectForKey: (#/userInfo notification)
                                   #&NSFileHandleNotificationDataItem))
 	   (document (#/document self))
+           (encoding (load-time-value (get-character-encoding :utf-8)))
 	   (data-length (#/length data))
 	   (buffer (hemlock-document-buffer document))
-	   (string (%str-from-ptr (#/bytes data) data-length))
+           (n nextra)
+           (cursize bufsize)
+           (need (+ n data-length))
+           (xlate translatebuf)
 	   (fh filehandle))
-      (enqueue-buffer-operation
-       buffer
-       #'(lambda ()
-           (hemlock::append-buffer-output buffer string)))
-      (#/readInBackgroundAndNotify fh))))
+      (when (> need cursize)
+        (let* ((new (#_malloc need)))
+          (dotimes (i n) (setf (%get-unsigned-byte new i)
+                               (%get-unsigned-byte xlate i)))
+          (#_free xlate)
+          (setq xlate new translatebuf new bufsize need)))
+      #+debug (#_NSLog #@"got %d bytes of data" :int data-length)
+      (with-macptrs ((target (%inc-ptr xlate n)))
+        (#/getBytes:range: data target (ns:make-ns-range 0 data-length)))
+      (let* ((total (+ n data-length)))
+        (multiple-value-bind (nchars noctets-used)
+            (funcall (character-encoding-length-of-memory-encoding-function encoding)
+                     xlate
+                     total
+                     0)
+          (let* ((string (make-string nchars)))
+            (funcall (character-encoding-memory-decode-function encoding)
+                     xlate
+                     noctets-used
+                     0
+                     string)
+            (unless (zerop (setq n (- total noctets-used)))
+              ;; By definition, the number of untranslated octets
+              ;; can't be more than 3.
+              (dotimes (i n)
+                (setf (%get-unsigned-byte xlate i)
+                      (%get-unsigned-byte xlate (+ noctets-used i)))))
+            (setq nextra n)
+            (hi::enqueue-buffer-operation
+             buffer
+             #'(lambda ()
+                 (unwind-protect
+                      (progn
+                        (hi::buffer-document-begin-editing buffer)
+                        (hemlock::append-buffer-output buffer string))
+                   (hi::buffer-document-end-editing buffer))))
+            (#/readInBackgroundAndNotify fh)))))))
 	     
 
@@ -171,5 +227,5 @@
 (objc:defmethod #/topListener ((self +hemlock-listener-document))
   (let* ((all-documents (#/orderedDocuments *NSApp*)))
-    (dotimes (i (#/count all-documents) (%null-ptr))
+    (dotimes (i (#/count all-documents) +null-ptr+)
       (let* ((doc (#/objectAtIndex: all-documents i)))
 	(when (eql (#/class doc) self)
@@ -185,4 +241,12 @@
        (values nil t))))
   
+(defun hi::top-listener-output-stream ()
+  (let* ((doc (#/topListener hemlock-listener-document)))
+    (unless (%null-ptr-p doc)
+      (let* ((buffer (hemlock-document-buffer doc))
+             (process (if buffer (hi::buffer-process buffer))))
+        (when (typep process 'cocoa-listener-process)
+          (cocoa-listener-process-output-stream process))))))
+
 
 
@@ -242,5 +306,5 @@
 	  (let* ((tty (slot-value controller 'clientfd))
 		 (peer-tty (#/fileDescriptor (slot-value controller 'filehandle))))
-	    (new-cocoa-listener-process listener-name tty tty peer-tty)))
+	    (new-cocoa-listener-process listener-name tty tty peer-tty window (hemlock-document-buffer self))))
     controller))
 
@@ -264,4 +328,16 @@
         (when context
           (#/showWindow: (backtrace-controller-for-context context) +null-ptr+))))))
+
+(objc:defmethod (#/continue: :void) ((self hemlock-listener-document) sender)
+  (declare (ignore sender))
+  (let* ((buffer (hemlock-document-buffer self))
+         (process (if buffer (hi::buffer-process buffer))))
+    (when (typep process 'cocoa-listener-process)
+      (let* ((context (listener-backtrace-context process)))
+        (when context
+          (hi::send-string-to-listener-process process ":go
+"))))))
+
+
 
 ;;; Menu item action validation.  It'd be nice if we could distribute this a
@@ -312,11 +388,42 @@
 			 (shortest-package-name package))))
 
+;;; This is basically used to provide INPUT to the listener process, by
+;;; writing to an fd which is conntected to that process's standard
+;;; input.
 (defmethod hi::send-string-to-listener-process ((process cocoa-listener-process)
                                                 string &key path package)
-  (let* ((selection (make-input-selection :package package
-                                          :source-file path
-                                          :string-stream
-                                          (make-string-input-stream string))))
-    (enqueue-input-selection (cocoa-listener-process-input-stream process) selection)))
+  (let* ((fd (selection-input-stream-peer-fd (cocoa-listener-process-input-stream process))))
+    (%stack-block ((buf 512))
+      (let* ((nout 0))
+         (labels ((flush ()
+                    (when (> nout 0)
+                    (fd-write fd buf nout)
+                    (setq nout 0)))
+                  (out-raw-char (ch)
+                    (when (= nout 512)
+                      (flush))
+                    (let* ((code (char-code ch)))
+                      (if (> code 255)
+                        (setq code (char-code #\Sub)))
+                      (setf (%get-unsigned-byte buf nout) code)
+                      (incf nout)))
+                  (out-ch (ch)
+                      (when (or (eql ch #\^v)
+                                (eql ch #\^p)
+                                (eql ch #\newline)
+                                (eql ch #\^q))
+                        (out-raw-char #\^q))
+                      (out-raw-char ch))
+                  (out-string (s)
+                    (dotimes (i (length s))
+                      (out-ch (char s i)))))
+           (out-raw-char #\^p)
+           (when package (out-string package))
+           (out-raw-char #\newline)
+           (out-raw-char #\^v)
+           (when path (out-string path))
+           (out-raw-char #\newline)
+           (out-string string)
+           (flush))))))
 
 
@@ -340,7 +447,6 @@
 			   app selection)))
     (if (typep target-listener 'cocoa-listener-process)
-      (enqueue-input-selection (cocoa-listener-process-input-stream
-				target-listener)
-			       selection))))
+      (destructuring-bind (package path string) selection
+        (hi::send-string-to-listener-process target-listener string :package package :path path)))))