Index: /trunk/ccl/examples/cocoa-listener.lisp =================================================================== --- /trunk/ccl/examples/cocoa-listener.lisp (revision 705) +++ /trunk/ccl/examples/cocoa-listener.lisp (revision 706) @@ -25,31 +25,41 @@ (defloadvar *cocoa-listener-count* 0) - -(defun new-listener-process (procname input-fd output-fd) - (make-mcl-listener-process - procname - (make-fd-stream - input-fd - :elements-per-buffer (#_fpathconf - input-fd - #$_PC_MAX_INPUT)) - (make-fd-stream output-fd :direction :output - :elements-per-buffer - (#_fpathconf - output-fd - #$_PC_MAX_INPUT)) - #'(lambda () - (let* ((buf (find *current-process* hi:*buffer-list* - :key #'hi::buffer-process)) - (doc (if buf (hi::buffer-document buf)))) - (when doc - (setf (hi::buffer-process buf) nil) - (send doc - :perform-selector-on-main-thread (@selector "close") - :with-object (%null-ptr) - :wait-until-done nil)))) - #'(lambda () - (setq *listener-autorelease-pool* (create-autorelease-pool)) - (listener-function)))) +(defclass cocoa-listener-process (process) + ((input-stream :reader cocoa-listener-process-input-stream))) + +(defun new-cocoa-listener-process (procname input-fd output-fd) + (let* ((input-stream (make-selection-input-stream + input-fd + :peer-fd output-fd + :elements-per-buffer (#_fpathconf + input-fd + #$_PC_MAX_INPUT))) + (proc + (make-mcl-listener-process + procname + input-stream + (make-fd-stream output-fd :direction :output + :elements-per-buffer + (#_fpathconf + output-fd + #$_PC_MAX_INPUT)) + #'(lambda ()` + (let* ((buf (find *current-process* hi:*buffer-list* + :key #'hi::buffer-process)) + (doc (if buf (hi::buffer-document buf)))) + (when doc + (setf (hi::buffer-process buf) nil) + (send doc + :perform-selector-on-main-thread (@selector "close") + :with-object (%null-ptr) + :wait-until-done nil)))) + :initial-function + #'(lambda () + (setq *listener-autorelease-pool* (create-autorelease-pool)) + (listener-function)) + :class 'cocoa-listener-process))) + (setf (slot-value proc 'input-stream) input-stream) + proc)) + (defloadvar *NSFileHandleNotificationDataItem* @@ -61,5 +71,5 @@ -(defclass lisp-listener-window-controller (lisp-editor-window-controller) +(defclass hemlock-listener-window-controller (hemlock-editor-window-controller) ((filehandle :foreign-type :id) ;Filehandle for I/O (clientfd :foreign-type :int) ;Client (listener)'s side of pty @@ -69,5 +79,5 @@ (define-objc-method ((:id :init-with-window w) - lisp-listener-window-controller) + hemlock-listener-window-controller) (let* ((self (send-super :init-with-window w))) (unless (%null-ptr-p self) @@ -89,23 +99,31 @@ (define-objc-method ((:void :got-data notification) - lisp-listener-window-controller) + hemlock-listener-window-controller) (with-slots (filehandle) self (let* ((data (send (send notification 'user-info) :object-for-key *NSFileHandleNotificationDataItem*)) (document (send self 'document)) + (textstorage (slot-value document 'textstorage)) (data-length (send data 'length)) (buffer (hemlock-document-buffer document)) (string (make-string data-length)) (fh filehandle)) - (declare (dynamic-extent string)) (%copy-ptr-to-ivector (send data 'bytes) 0 string 0 data-length) - (let* ((input-mark (hi::variable-value 'hemlock::buffer-input-mark :buffer buffer))) - (hi:with-mark ((mark input-mark :left-inserting)) - (hi::insert-string mark string) - (hi::move-mark input-mark mark))) + (enqueue-buffer-operation + buffer + #'(lambda () + (let* ((input-mark (hi::variable-value 'hemlock::buffer-input-mark :buffer buffer))) + (hi:with-mark ((mark input-mark :left-inserting)) + (hi::insert-string mark string) + (hi::move-mark input-mark mark))) + (send textstorage + :perform-selector-on-main-thread + (@selector "ensureSelectionVisible") + :with-object (%null-ptr) + :wait-until-done t))) (send fh 'read-in-background-and-notify)))) #| -;;; The Lisp-Listener-Window-Controller is the textview's "delegate": it +;;; The Hemlock-Listener-Window-Controller is the textview's "delegate": it ;;; gets consulted before certain actions are performed, and can ;;; perform actions on behalf of the textview. @@ -114,5 +132,5 @@ :should-change-text-in-range (:ange range) :replacement-string replacement-string) - lisp-listener-window-controller) + hemlock-listener-window-controller) (declare (ignorable replacement-string)) (if (< (pref range :ange.location) (slot-value self 'outpos)) @@ -126,5 +144,5 @@ -(define-objc-method ((:void dealloc) lisp-listener-window-controller) +(define-objc-method ((:void dealloc) hemlock-listener-window-controller) (send (send (@class ns-notification-center) 'default-center) :remove-observer self) @@ -133,8 +151,8 @@ -;;; The LispListenerDocument class. - - -(defclass lisp-listener-document (lisp-editor-document) +;;; The HemlockListenerDocument class. + + +(defclass hemlock-listener-document (hemlock-editor-document) () (:metaclass ns:+ns-object)) @@ -153,5 +171,5 @@ -(define-objc-class-method ((:id top-listener) lisp-listener-document) +(define-objc-class-method ((:id top-listener) hemlock-listener-document) (let* ((all-documents (send *NSApp* 'ordered-Documents))) (dotimes (i (send all-documents 'count) (%null-ptr)) @@ -161,5 +179,5 @@ (defun symbol-value-in-top-listener-process (symbol) - (let* ((listenerdoc (send (@class lisp-listener-document) 'top-listener)) + (let* ((listenerdoc (send (@class hemlock-listener-document) 'top-listener)) (buffer (unless (%null-ptr-p listenerdoc) (hemlock-document-buffer listenerdoc))) @@ -171,10 +189,10 @@ -(define-objc-method ((: is-document-edited) lisp-listener-document) +(define-objc-method ((: is-document-edited) hemlock-listener-document) nil) (define-objc-method ((:id init) - lisp-listener-document) + hemlock-listener-document) (let* ((doc (send-super 'init))) (unless (%null-ptr-p doc) @@ -191,8 +209,8 @@ doc)) -(define-objc-method ((:void make-window-controllers) lisp-listener-document) +(define-objc-method ((:void make-window-controllers) hemlock-listener-document) (let* ((textstorage (slot-value self 'textstorage)) (controller (make-objc-instance - 'lisp-listener-window-controller + 'hemlock-listener-window-controller :with-window (%hemlock-frame-for-textstorage textstorage @@ -205,5 +223,5 @@ (setf (hi::buffer-process (hemlock-document-buffer self)) (let* ((tty (slot-value controller 'clientfd))) - (new-listener-process listener-name tty tty))) + (new-cocoa-listener-process listener-name tty tty))) controller)) @@ -214,5 +232,5 @@ (declare (ignorable sender-info)) (let* ((listener - (info-from-document (send (@class lisp-listener-document) + (info-from-document (send (@class hemlock-listener-document) 'top-listener)))) (when listener @@ -225,4 +243,12 @@ |# +(defun shortest-package-name (package) + (let* ((name (package-name package)) + (len (length name))) + (dolist (nick (package-nicknames package) name) + (let* ((nicklen (length nick))) + (if (< nicklen len) + (setq name nick len nicklen)))))) + (defun cocoa-ide-note-package (package) (process-interrupt *cocoa-event-process* @@ -232,10 +258,19 @@ (setf (hi::variable-value 'hemlock::current-package :buffer buf) name)))) *current-process* - (package-name package))) - -(defmethod ui-object-do-operation ((o cocoa-ide-ui-object) + (shortest-package-name package))) + +(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))) + + +(defmethod ui-object-do-operation ((o ns:ns-application) operation &rest args) (case operation - (:note-package (cocoa-ide-note-package (car args))))) + (:note-current-package (cocoa-ide-note-package (car args)))))