Changeset 706
- Timestamp:
- Mar 22, 2004, 9:40:30 AM (21 years ago)
- File:
-
- 1 edited
-
trunk/ccl/examples/cocoa-listener.lisp (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/examples/cocoa-listener.lisp
r663 r706 25 25 (defloadvar *cocoa-listener-count* 0) 26 26 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 54 64 55 65 (defloadvar *NSFileHandleNotificationDataItem* … … 61 71 62 72 63 (defclass lisp-listener-window-controller (lisp-editor-window-controller)73 (defclass hemlock-listener-window-controller (hemlock-editor-window-controller) 64 74 ((filehandle :foreign-type :id) ;Filehandle for I/O 65 75 (clientfd :foreign-type :int) ;Client (listener)'s side of pty … … 69 79 70 80 (define-objc-method ((:id :init-with-window w) 71 lisp-listener-window-controller)81 hemlock-listener-window-controller) 72 82 (let* ((self (send-super :init-with-window w))) 73 83 (unless (%null-ptr-p self) … … 89 99 90 100 (define-objc-method ((:void :got-data notification) 91 lisp-listener-window-controller)101 hemlock-listener-window-controller) 92 102 (with-slots (filehandle) self 93 103 (let* ((data (send (send notification 'user-info) 94 104 :object-for-key *NSFileHandleNotificationDataItem*)) 95 105 (document (send self 'document)) 106 (textstorage (slot-value document 'textstorage)) 96 107 (data-length (send data 'length)) 97 108 (buffer (hemlock-document-buffer document)) 98 109 (string (make-string data-length)) 99 110 (fh filehandle)) 100 (declare (dynamic-extent string))101 111 (%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))) 106 124 (send fh 'read-in-background-and-notify)))) 107 125 108 126 #| 109 ;;; The Lisp-Listener-Window-Controller is the textview's "delegate": it127 ;;; The Hemlock-Listener-Window-Controller is the textview's "delegate": it 110 128 ;;; gets consulted before certain actions are performed, and can 111 129 ;;; perform actions on behalf of the textview. … … 114 132 :should-change-text-in-range (:<NSR>ange range) 115 133 :replacement-string replacement-string) 116 lisp-listener-window-controller)134 hemlock-listener-window-controller) 117 135 (declare (ignorable replacement-string)) 118 136 (if (< (pref range :<NSR>ange.location) (slot-value self 'outpos)) … … 126 144 127 145 128 (define-objc-method ((:void dealloc) lisp-listener-window-controller)146 (define-objc-method ((:void dealloc) hemlock-listener-window-controller) 129 147 (send (send (@class ns-notification-center) 'default-center) 130 148 :remove-observer self) … … 133 151 134 152 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) 139 157 () 140 158 (:metaclass ns:+ns-object)) … … 153 171 154 172 155 (define-objc-class-method ((:id top-listener) lisp-listener-document)173 (define-objc-class-method ((:id top-listener) hemlock-listener-document) 156 174 (let* ((all-documents (send *NSApp* 'ordered-Documents))) 157 175 (dotimes (i (send all-documents 'count) (%null-ptr)) … … 161 179 162 180 (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)) 164 182 (buffer (unless (%null-ptr-p listenerdoc) 165 183 (hemlock-document-buffer listenerdoc))) … … 171 189 172 190 173 (define-objc-method ((:<BOOL> is-document-edited) lisp-listener-document)191 (define-objc-method ((:<BOOL> is-document-edited) hemlock-listener-document) 174 192 nil) 175 193 176 194 177 195 (define-objc-method ((:id init) 178 lisp-listener-document)196 hemlock-listener-document) 179 197 (let* ((doc (send-super 'init))) 180 198 (unless (%null-ptr-p doc) … … 191 209 doc)) 192 210 193 (define-objc-method ((:void make-window-controllers) lisp-listener-document)211 (define-objc-method ((:void make-window-controllers) hemlock-listener-document) 194 212 (let* ((textstorage (slot-value self 'textstorage)) 195 213 (controller (make-objc-instance 196 ' lisp-listener-window-controller214 'hemlock-listener-window-controller 197 215 :with-window (%hemlock-frame-for-textstorage 198 216 textstorage … … 205 223 (setf (hi::buffer-process (hemlock-document-buffer self)) 206 224 (let* ((tty (slot-value controller 'clientfd))) 207 (new- listener-process listener-name tty tty)))225 (new-cocoa-listener-process listener-name tty tty))) 208 226 controller)) 209 227 … … 214 232 (declare (ignorable sender-info)) 215 233 (let* ((listener 216 (info-from-document (send (@class lisp-listener-document)234 (info-from-document (send (@class hemlock-listener-document) 217 235 'top-listener)))) 218 236 (when listener … … 225 243 |# 226 244 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 227 253 (defun cocoa-ide-note-package (package) 228 254 (process-interrupt *cocoa-event-process* … … 232 258 (setf (hi::variable-value 'hemlock::current-package :buffer buf) name)))) 233 259 *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) 237 272 operation &rest args) 238 273 (case operation 239 (:note- package (cocoa-ide-note-package (car args)))))274 (:note-current-package (cocoa-ide-note-package (car args))))) 240 275 241 276
Note:
See TracChangeset
for help on using the changeset viewer.
