Changeset 706


Ignore:
Timestamp:
Mar 22, 2004, 5:40:30 PM (15 years ago)
Author:
gb
Message:

New listener process/selection-stream stuff.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/examples/cocoa-listener.lisp

    r663 r706  
    2525(defloadvar *cocoa-listener-count* 0)
    2626
    27 
    28 (defun new-listener-process (procname input-fd output-fd)
    29   (make-mcl-listener-process
    30    procname
    31    (make-fd-stream
    32                    input-fd
    33                    :elements-per-buffer (#_fpathconf
    34                                          input-fd
    35                                          #$_PC_MAX_INPUT))
    36    (make-fd-stream output-fd :direction :output
    37                                    :elements-per-buffer
    38                                    (#_fpathconf
    39                                     output-fd
    40                                     #$_PC_MAX_INPUT))
    41    #'(lambda ()
    42        (let* ((buf (find *current-process* hi:*buffer-list*
    43                          :key #'hi::buffer-process))
    44               (doc (if buf (hi::buffer-document buf))))
    45          (when doc
    46            (setf (hi::buffer-process buf) nil)
    47            (send doc
    48                  :perform-selector-on-main-thread (@selector "close")
    49                  :with-object (%null-ptr)
    50                  :wait-until-done nil))))
    51    #'(lambda ()
    52        (setq *listener-autorelease-pool* (create-autorelease-pool))
    53        (listener-function))))
     27(defclass cocoa-listener-process (process)
     28    ((input-stream :reader cocoa-listener-process-input-stream)))
     29
     30(defun new-cocoa-listener-process (procname input-fd output-fd)
     31  (let* ((input-stream (make-selection-input-stream
     32                        input-fd
     33                        :peer-fd output-fd
     34                        :elements-per-buffer (#_fpathconf
     35                                              input-fd
     36                                              #$_PC_MAX_INPUT)))
     37         (proc
     38          (make-mcl-listener-process
     39           procname
     40           input-stream
     41           (make-fd-stream output-fd :direction :output
     42                           :elements-per-buffer
     43                           (#_fpathconf
     44                            output-fd
     45                            #$_PC_MAX_INPUT))
     46           #'(lambda ()`
     47               (let* ((buf (find *current-process* hi:*buffer-list*
     48                                 :key #'hi::buffer-process))
     49                      (doc (if buf (hi::buffer-document buf))))
     50                 (when doc
     51                   (setf (hi::buffer-process buf) nil)
     52                   (send doc
     53                         :perform-selector-on-main-thread (@selector "close")
     54                         :with-object (%null-ptr)
     55                         :wait-until-done nil))))
     56           :initial-function
     57           #'(lambda ()
     58               (setq *listener-autorelease-pool* (create-autorelease-pool))
     59               (listener-function))
     60           :class 'cocoa-listener-process)))
     61    (setf (slot-value proc 'input-stream) input-stream)
     62    proc))
     63         
    5464
    5565(defloadvar *NSFileHandleNotificationDataItem*
     
    6171
    6272
    63 (defclass lisp-listener-window-controller (lisp-editor-window-controller)
     73(defclass hemlock-listener-window-controller (hemlock-editor-window-controller)
    6474    ((filehandle :foreign-type :id)     ;Filehandle for I/O
    6575     (clientfd :foreign-type :int)      ;Client (listener)'s side of pty
     
    6979
    7080(define-objc-method ((:id :init-with-window w)
    71                      lisp-listener-window-controller)
     81                     hemlock-listener-window-controller)
    7282  (let* ((self (send-super :init-with-window w)))
    7383    (unless (%null-ptr-p self)
     
    8999
    90100(define-objc-method ((:void :got-data notification)
    91                      lisp-listener-window-controller)
     101                     hemlock-listener-window-controller)
    92102  (with-slots (filehandle) self
    93103    (let* ((data (send (send notification 'user-info)
    94104                       :object-for-key *NSFileHandleNotificationDataItem*))
    95105           (document (send self 'document))
     106           (textstorage (slot-value document 'textstorage))
    96107           (data-length (send data 'length))
    97108           (buffer (hemlock-document-buffer document))
    98109           (string (make-string data-length))
    99110           (fh filehandle))
    100       (declare (dynamic-extent string))
    101111      (%copy-ptr-to-ivector (send data 'bytes) 0 string 0 data-length)
    102       (let* ((input-mark (hi::variable-value 'hemlock::buffer-input-mark :buffer buffer)))
    103         (hi:with-mark ((mark input-mark :left-inserting))
    104           (hi::insert-string mark string)
    105           (hi::move-mark input-mark mark)))
     112      (enqueue-buffer-operation
     113       buffer
     114       #'(lambda ()
     115           (let* ((input-mark (hi::variable-value 'hemlock::buffer-input-mark :buffer buffer)))
     116             (hi:with-mark ((mark input-mark :left-inserting))
     117               (hi::insert-string mark string)
     118               (hi::move-mark input-mark mark)))
     119           (send textstorage
     120                 :perform-selector-on-main-thread
     121                 (@selector "ensureSelectionVisible")
     122                 :with-object (%null-ptr)
     123                 :wait-until-done t)))
    106124      (send fh 'read-in-background-and-notify))))
    107125             
    108126#|   
    109 ;;; The Lisp-Listener-Window-Controller is the textview's "delegate": it
     127;;; The Hemlock-Listener-Window-Controller is the textview's "delegate": it
    110128;;; gets consulted before certain actions are performed, and can
    111129;;; perform actions on behalf of the textview.
     
    114132                              :should-change-text-in-range (:<NSR>ange range)
    115133                              :replacement-string replacement-string)
    116                      lisp-listener-window-controller)
     134                     hemlock-listener-window-controller)
    117135  (declare (ignorable replacement-string))
    118136  (if (< (pref range :<NSR>ange.location) (slot-value self 'outpos))
     
    126144
    127145
    128 (define-objc-method ((:void dealloc) lisp-listener-window-controller)
     146(define-objc-method ((:void dealloc) hemlock-listener-window-controller)
    129147  (send (send (@class ns-notification-center) 'default-center)
    130148        :remove-observer self)
     
    133151
    134152
    135 ;;; The LispListenerDocument class.
    136 
    137 
    138 (defclass lisp-listener-document (lisp-editor-document)
     153;;; The HemlockListenerDocument class.
     154
     155
     156(defclass hemlock-listener-document (hemlock-editor-document)
    139157    ()
    140158  (:metaclass ns:+ns-object))
     
    153171
    154172
    155 (define-objc-class-method ((:id top-listener) lisp-listener-document)
     173(define-objc-class-method ((:id top-listener) hemlock-listener-document)
    156174  (let* ((all-documents (send *NSApp* 'ordered-Documents)))
    157175    (dotimes (i (send all-documents 'count) (%null-ptr))
     
    161179
    162180(defun symbol-value-in-top-listener-process (symbol)
    163   (let* ((listenerdoc (send (@class lisp-listener-document) 'top-listener))
     181  (let* ((listenerdoc (send (@class hemlock-listener-document) 'top-listener))
    164182         (buffer (unless (%null-ptr-p listenerdoc)
    165183                   (hemlock-document-buffer listenerdoc)))
     
    171189
    172190
    173 (define-objc-method ((:<BOOL> is-document-edited) lisp-listener-document)
     191(define-objc-method ((:<BOOL> is-document-edited) hemlock-listener-document)
    174192  nil)
    175193
    176194
    177195(define-objc-method ((:id init)
    178                      lisp-listener-document)
     196                     hemlock-listener-document)
    179197  (let* ((doc (send-super 'init)))
    180198    (unless (%null-ptr-p doc)
     
    191209    doc))
    192210
    193 (define-objc-method ((:void make-window-controllers) lisp-listener-document)
     211(define-objc-method ((:void make-window-controllers) hemlock-listener-document)
    194212  (let* ((textstorage (slot-value self 'textstorage))
    195213         (controller (make-objc-instance
    196                       'lisp-listener-window-controller
     214                      'hemlock-listener-window-controller
    197215                      :with-window (%hemlock-frame-for-textstorage
    198216                                    textstorage
     
    205223    (setf (hi::buffer-process (hemlock-document-buffer self))
    206224          (let* ((tty (slot-value controller 'clientfd)))
    207             (new-listener-process listener-name tty tty)))
     225            (new-cocoa-listener-process listener-name tty tty)))
    208226    controller))
    209227
     
    214232  (declare (ignorable sender-info))
    215233  (let* ((listener
    216           (info-from-document (send (@class lisp-listener-document)
     234          (info-from-document (send (@class hemlock-listener-document)
    217235                                    'top-listener))))
    218236    (when listener
     
    225243|#
    226244
     245(defun shortest-package-name (package)
     246  (let* ((name (package-name package))
     247         (len (length name)))
     248    (dolist (nick (package-nicknames package) name)
     249      (let* ((nicklen (length nick)))
     250        (if (< nicklen len)
     251          (setq name nick len nicklen))))))
     252
    227253(defun cocoa-ide-note-package (package)
    228254  (process-interrupt *cocoa-event-process*
     
    232258                               (setf (hi::variable-value 'hemlock::current-package :buffer buf) name))))
    233259                       *current-process*
    234                        (package-name package)))
    235 
    236 (defmethod ui-object-do-operation ((o cocoa-ide-ui-object)
     260                       (shortest-package-name package)))
     261
     262(defmethod hi::send-string-to-listener-process ((process cocoa-listener-process)
     263                                                string &key path package)
     264  (let* ((selection (make-input-selection :package package
     265                                          :source-file path
     266                                          :string-stream
     267                                          (make-string-input-stream string))))
     268    (enqueue-input-selection (cocoa-listener-process-input-stream process) selection)))
     269 
     270
     271(defmethod ui-object-do-operation ((o ns:ns-application)
    237272                                   operation &rest args)
    238273  (case operation
    239     (:note-package (cocoa-ide-note-package (car args)))))
     274    (:note-current-package (cocoa-ide-note-package (car args)))))
    240275
    241276       
Note: See TracChangeset for help on using the changeset viewer.