Changeset 7929


Ignore:
Timestamp:
Dec 21, 2007, 11:12:48 AM (17 years ago)
Author:
gz
Message:

Define a stream class for output to the listener and use it instead of the
pty as the output stream for listener repl's. This fixes the deadlock
with writing to the listener from the cocoa thread.

Some more API massaging: hemlock-ext:send-string-to-listener,
hemlock-ext:buffer-process-description.

Some more internal massaging: store the listener repl process object
in the document rather than buffer. Call ccl::housekeeping-loop rather
than duplicating it.

Location:
branches/event-ide/ccl/cocoa-ide
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • branches/event-ide/ccl/cocoa-ide/cocoa-editor.lisp

    r7919 r7929  
    766766                (slot-value hemlock-string 'cache) nil
    767767                (hi::buffer-document buffer) nil)
    768           (let* ((p (hi::buffer-process buffer)))
    769             (when p
    770               (setf (hi::buffer-process buffer) nil)
    771               (process-kill p)))
    772768          (when (eq buffer hi::*current-buffer*)
    773769            (setf hi::*current-buffer* nil))
    … …  
    10691065(objc:defmethod (#/evalSelection: :void) ((self hemlock-text-view) sender)
    10701066  (declare (ignore sender))
    1071   (let* ((dc (#/sharedDocumentController ns:ns-document-controller))
    1072          (doc (#/documentForWindow: dc (#/window self)))
    1073          (buffer (hemlock-document-buffer doc))
     1067  (let* ((buffer (hemlock-buffer self))
    10741068         (package-name (hi::variable-value 'hemlock::current-package :buffer buffer))
    10751069         (pathname (hi::buffer-pathname buffer))
    … …  
    10841078(objc:defmethod (#/loadBuffer: :void) ((self hemlock-text-view) sender)
    10851079  (declare (ignore sender))
    1086   (let* ((dc (#/sharedDocumentController ns:ns-document-controller))
    1087          (doc (#/documentForWindow: dc (#/window self)))
    1088          (buffer (hemlock-document-buffer doc))
     1080  (let* ((buffer (hemlock-buffer self))
    10891081         (package-name (hi::variable-value 'hemlock::current-package :buffer buffer))
    10901082         (pathname (hi::buffer-pathname buffer)))
    … …  
    10931085(objc:defmethod (#/compileBuffer: :void) ((self hemlock-text-view) sender)
    10941086  (declare (ignore sender))
    1095   (let* ((dc (#/sharedDocumentController ns:ns-document-controller))
    1096          (doc (#/documentForWindow: dc (#/window self)))
    1097          (buffer (hemlock-document-buffer doc))
     1087  (let* ((buffer (hemlock-buffer self))
    10981088         (package-name (hi::variable-value 'hemlock::current-package :buffer buffer))
    10991089         (pathname (hi::buffer-pathname buffer)))
    … …  
    11021092(objc:defmethod (#/compileAndLoadBuffer: :void) ((self hemlock-text-view) sender)
    11031093  (declare (ignore sender))
    1104   (let* ((dc (#/sharedDocumentController ns:ns-document-controller))
    1105          (doc (#/documentForWindow: dc (#/window self)))
    1106          (buffer (hemlock-document-buffer doc))
     1094  (let* ((buffer (hemlock-buffer self))
    11071095         (package-name (hi::variable-value 'hemlock::current-package :buffer buffer))
    11081096         (pathname (hi::buffer-pathname buffer)))
    … …  
    22612249                                  :encoding encoding
    22622250                                  :error +null-ptr+))
    2263          (buffer (hemlock-document-buffer self))
     2251         (buffer (hemlock-buffer self))
    22642252         (old-length (hemlock-buffer-length buffer))
    22652253         (hi::*current-buffer* buffer)
    … …  
    23212309                 (#/path url)
    23222310                 (#/absoluteString url))))
    2323              (buffer (or (hemlock-document-buffer self)
     2311             (buffer (or (hemlock-buffer self)
    23242312                         (make-buffer-for-document self pathname)))
    23252313             (selected-encoding (slot-value (#/sharedDocumentController (find-class 'hemlock-document-controller)) 'last-encoding))
    … …  
    24012389             
    24022390
    2403 (defmethod hemlock-document-buffer (document)
    2404   (hemlock-buffer document))
    2405 
    24062391(defmethod hemlock-view ((frame hemlock-frame))
    24072392  (let ((pane (slot-value frame 'pane)))
    … …  
    24302415  (with-slots (encoding) self
    24312416    (setq encoding (nsinteger-to-nsstring-encoding (#/selectedTag popup)))
    2432     (hi::note-modeline-change (hemlock-document-buffer self))))
     2417    (hi::note-modeline-change (hemlock-buffer self))))
    24332418
    24342419(objc:defmethod (#/prepareSavePanel: :<BOOL>) ((self hemlock-editor-document)
    … …  
    24542439  (with-slots (encoding textstorage) self
    24552440    (let* ((string (#/string textstorage))
    2456            (buffer (hemlock-document-buffer self)))
     2441           (buffer (hemlock-buffer self)))
    24572442      (case (when buffer (hi::buffer-line-termination buffer))
    24582443        (:crlf (unless (typep string 'ns:ns-mutable-string)
    … …  
    24792464                                        url)
    24802465  (call-next-method url)
    2481   (let* ((buffer (hemlock-document-buffer self)))
     2466  (let* ((buffer (hemlock-buffer self)))
    24822467    (when buffer
    24832468      (let* ((new-pathname (lisp-string-from-nsstring (#/path url))))

  • branches/event-ide/ccl/cocoa-ide/cocoa-listener.lisp

    r7911 r7929  
    4949  pty)
    5050
     51(defparameter $listener-flush-limit 100)
     52
     53(defclass cocoa-listener-output-stream (fundamental-character-output-stream)
     54  ((lock :initform (make-lock))
     55   (hemlock-view :initarg :hemlock-view)
     56   (data :initform (make-array (1+ $listener-flush-limit)
     57                               :adjustable t :fill-pointer 0
     58                               :element-type 'character))))
     59
     60(defmethod stream-element-type ((stream cocoa-listener-output-stream))
     61  (with-slots (data) stream
     62    (array-element-type data)))
     63
     64(defmethod ccl:stream-write-char ((stream cocoa-listener-output-stream) char)
     65  (with-slots (data lock) stream
     66    (when (with-lock-grabbed (lock)
     67            (>= (vector-push-extend char data) $listener-flush-limit))
     68      (stream-force-output stream))))
     69
     70;; This isn't really thread safe, but it's not too bad...  I'll take a chance - trying
     71;; to get it to execute in the gui thread is too deadlock-prone.
     72(defmethod hemlock-listener-output-mark-column ((view hi::hemlock-view))
     73  (let* ((output-region (hi::variable-value 'hemlock::current-output-font-region
     74                                            :buffer (hi::hemlock-view-buffer view))))
     75    (hi::mark-charpos (hi::region-end output-region))))
     76
     77;; TODO: doesn't do the right thing for embedded tabs (in buffer or data)
     78(defmethod ccl:stream-line-column ((stream cocoa-listener-output-stream))
     79  (with-slots (hemlock-view data lock) stream
     80    (with-lock-grabbed (lock)
     81      (let* ((n (length data))
     82             (pos (position #\Newline data :from-end t)))
     83        (if (null pos)
     84          (+ (hemlock-listener-output-mark-column hemlock-view) n)
     85          (- n pos 1))))))
     86
     87(defmethod ccl:stream-fresh-line  ((stream cocoa-listener-output-stream))
     88  (with-slots (hemlock-view data lock) stream
     89    (when (with-lock-grabbed (lock)
     90            (let ((n (length data)))
     91              (unless (if (= n 0)
     92                        (= (hemlock-listener-output-mark-column hemlock-view) 0)
     93                        (eq (aref data (1- n)) #\Newline))
     94                (>= (vector-push-extend #\Newline data) $listener-flush-limit))))
     95      (stream-force-output stream))))
     96
     97(defmethod ccl::stream-finish-output ((stream cocoa-listener-output-stream))
     98  (stream-force-output stream))
     99
     100(defmethod ccl:stream-force-output ((stream cocoa-listener-output-stream))
     101  (if (typep *current-process* 'appkit-process)
     102    (with-slots (hemlock-view data lock) stream
     103      (with-lock-grabbed (lock)
     104        (when (> (fill-pointer data) 0)
     105          (append-output hemlock-view data)
     106          (setf (fill-pointer data) 0))))
     107    (with-slots (data) stream
     108      (when (> (fill-pointer data) 0)
     109        (queue-for-gui #'(lambda () (stream-force-output stream)))))))
     110
     111(defmethod ccl:stream-clear-output ((stream cocoa-listener-output-stream))
     112  (with-slots (data lock) stream
     113    (with-lock-grabbed (lock)
     114      (setf (fill-pointer data) 0))))
     115
     116(defmethod ccl:stream-line-length ((stream cocoa-listener-output-stream))
     117  ;; TODO: ** compute length from window size **
     118  80)
     119
    51120
    52121(defloadvar *cocoa-listener-count* 0)
    … …  
    58127     (backtrace-contexts :initform nil
    59128                         :accessor cocoa-listener-process-backtrace-contexts)
    60      (window :reader cocoa-listener-process-window)
    61      (buffer :initform nil :reader cocoa-listener-process-buffer)))
     129     (window :reader cocoa-listener-process-window)))
    62130 
    63131
    64 (defun new-cocoa-listener-process (procname input-fd output-fd peer-fd window buffer)
     132(defun new-cocoa-listener-process (procname input-fd peer-fd window)
    65133  (let* ((input-stream (ccl::make-selection-input-stream
    66134                        input-fd
    … …  
    70138                                              #$_PC_MAX_INPUT)
    71139                        :encoding :utf-8))
    72          (output-stream (ccl::make-fd-stream output-fd :direction :output
    73                                              :sharing :lock
    74                                              :elements-per-buffer
    75                                              (#_fpathconf
    76                                               output-fd
    77                                               #$_PC_MAX_INPUT)
    78                                              :encoding :utf-8))
    79140         (peer-stream (ccl::make-fd-stream peer-fd :direction :output
    80141                                           :sharing :lock
    … …  
    84145                                            #$_PC_MAX_INPUT)
    85146                                           :encoding :utf-8))
     147         (output-stream (make-instance 'cocoa-listener-output-stream
     148                          :hemlock-view (hemlock-view window)))
     149
    86150         (proc
    87151          (ccl::make-mcl-listener-process
    … …  
    89153           input-stream
    90154           output-stream
    91            #'(lambda ()`
    92                (let* ((buf (find *current-process* hi:*buffer-list*
    93                                  :key #'hi::buffer-process))
    94                       (doc (if buf (hi::buffer-document buf))))
    95                  (when doc
    96                    (setf (hi::buffer-process buf) nil)
    97                    (#/performSelectorOnMainThread:withObject:waitUntilDone:
    98                     doc
    99                     (@selector #/close)
    100                     +null-ptr+
    101                     nil))))
     155           ;; cleanup function
     156           #'(lambda ()
     157               (mapcar #'(lambda (buf)
     158                           (when (eq (buffer-process buf) *current-process*)
     159                             (let ((doc (hi::buffer-document buf)))
     160                               (when doc
     161                                 (setf (hemlock-document-process doc) nil) ;; so #/close doesn't kill it.
     162                                 (#/performSelectorOnMainThread:withObject:waitUntilDone:
     163                                  doc
     164                                  (@selector #/close)
     165                                  +null-ptr+
     166                                  nil)))))
     167                       hi:*buffer-list*))
    102168           :initial-function
    103169           #'(lambda ()
    104170               (setq ccl::*listener-autorelease-pool* (create-autorelease-pool))
    105171               (ccl::listener-function))
     172           :echoing nil
    106173           :class 'cocoa-listener-process)))
    107174    (setf (slot-value proc 'input-stream) input-stream)
    … …  
    109176    (setf (slot-value proc 'input-peer-stream) peer-stream)
    110177    (setf (slot-value proc 'window) window)
    111     (setf (slot-value proc 'buffer) buffer)
    112178    proc))
    113          
     179
    114180
    115181(defclass hemlock-listener-frame (hemlock-frame)
    … …  
    180246          (#_free xlate)
    181247          (setq xlate new translatebuf new bufsize need)))
    182       #+debug (#_NSLog #@"got %d bytes of data" :int data-length)
     248      #+debug :GZ (#_NSLog #@"got %d bytes of data" :int data-length)
    183249      (with-macptrs ((target (%inc-ptr xlate n)))
    184250        (#/getBytes:range: data target (ns:make-ns-range 0 data-length)))
    … …  
    217283            (not (%null-ptr-p (#/fileURL doc))))
    218284      (call-next-method name)
    219       (let* ((buffer (hemlock-document-buffer doc))
     285      (let* ((buffer (hemlock-buffer doc))
    220286             (bufname (if buffer (hi::buffer-name buffer))))
    221287        (if bufname
    … …  
    228294
    229295(defclass hemlock-listener-document (hemlock-editor-document)
    230     ()
     296  ((process :reader %hemlock-document-process :writer (setf hemlock-document-process)))
    231297  (:metaclass ns:+ns-object))
    232298(declaim (special hemlock-listener-document))
     299
     300(defgeneric hemlock-document-process (doc)
     301  (:method ((unknown t)) nil)
     302  (:method ((doc hemlock-listener-document)) (%hemlock-document-process doc)))
     303
     304;; Nowadays this is nil except for listeners.
     305(defun buffer-process (buffer)
     306  (hemlock-document-process (hi::buffer-document buffer)))
    233307
    234308(defmethod update-buffer-package ((doc hemlock-listener-document) buffer)
    … …  
    244318  *listener-background-color*)
    245319
    246 
    247 (defun hemlock::listener-document-send-string (document string)
    248   (let* ((buffer (hemlock-document-buffer document))
    249          (process (if buffer (hi::buffer-process buffer))))
    250     (if process
    251       (hi::send-string-to-listener-process process string))))
    252 
     320(defun hemlock-ext:send-string-to-listener (buffer string)
     321  (let* ((proc (buffer-process buffer)))
     322    (when proc
     323      (send-string-to-listener-process proc string))))
     324
     325;; For use with the :process-info listener modeline field
     326(defmethod hemlock-ext:buffer-process-description (buffer)
     327  (let ((proc (buffer-process buffer)))
     328    (when proc
     329      (format nil "~a(~d) [~a]"
     330              (ccl:process-name proc)
     331              (ccl::process-serial-number proc)
     332              ;; TODO: this doesn't really work as a modeline item, because the modeline
     333              ;; doesn't get notified when it changes.
     334              (ccl:process-whostate proc)))))
    253335
    254336(objc:defmethod #/topListener ((self +hemlock-listener-document))
    … …  
    260342
    261343(defun symbol-value-in-top-listener-process (symbol)
    262   (let* ((listenerdoc (#/topListener hemlock-listener-document))
    263          (buffer (unless (%null-ptr-p listenerdoc)
    264                    (hemlock-document-buffer listenerdoc)))
    265          (process (if buffer (hi::buffer-process buffer))))
     344  (let* ((process (hemlock-document-process (#/topListener hemlock-listener-document))))
    266345     (if process
    267346       (ignore-errors (symbol-value-in-process symbol process))
    … …  
    269348 
    270349(defun hemlock-ext:top-listener-output-stream ()
    271   (let* ((doc (#/topListener hemlock-listener-document)))
    272     (unless (%null-ptr-p doc)
    273       (let* ((buffer (hemlock-document-buffer doc))
    274              (process (if buffer (hi::buffer-process buffer))))
    275         (when (typep process 'cocoa-listener-process)
    276           (cocoa-listener-process-output-stream process))))))
     350  (let* ((process (hemlock-document-process (#/topListener hemlock-listener-document))))
     351    (when process
     352      (setq process (require-type process 'cocoa-listener-process))
     353      (cocoa-listener-process-output-stream process))))
    277354
    278355
    … …  
    290367                            (format nil
    291368                                    "Listener-~d" *cocoa-listener-count*)))
    292              (buffer (hemlock-document-buffer doc)))
     369             (buffer (hemlock-buffer doc)))
    293370        (setf (hi::buffer-pathname buffer) nil
    294371              (hi::buffer-minor-mode buffer "Listener") t
    … …  
    308385    (setq *next-listener-x-pos* nil
    309386          *next-listener-y-pos* nil))
     387  (let* ((p (shiftf (hemlock-document-process self) nil)))
     388    (when p
     389      (process-kill p)))
    310390  (call-next-method))
    311391
    … …  
    329409                      'hemlock-listener-window-controller
    330410                      :with-window window))
    331          (listener-name (hi::buffer-name (hemlock-document-buffer self))))
     411         (listener-name (hi::buffer-name (hemlock-buffer self))))
    332412    (with-slots (styles) textstorage
    333413      ;; We probably should be more disciplined about
    … …  
    354434        (setf *next-listener-x-pos* (ns:ns-point-x new-point)
    355435              *next-listener-y-pos* (ns:ns-point-y new-point))))
    356     (setf (hi::buffer-process (hemlock-document-buffer self))
     436    (setf (hemlock-document-process self)
    357437          (let* ((tty (slot-value controller 'clientfd))
    358438                 (peer-tty (#/fileDescriptor (slot-value controller 'filehandle))))
    359             (new-cocoa-listener-process listener-name tty tty peer-tty window (hemlock-document-buffer self))))
     439            (new-cocoa-listener-process listener-name tty peer-tty window)))
    360440    controller))
    361441
    … …  
    368448  (let* ((range-start (ns:ns-range-location range))
    369449         (range-end (+ range-start (ns:ns-range-length range)))
    370          (buffer (hemlock-document-buffer self))
     450         (buffer (hemlock-buffer self))
    371451         (protected-region (hi::buffer-protected-region buffer)))
    372452    (if protected-region
    … …  
    383463(objc:defmethod (#/interrupt: :void) ((self hemlock-listener-document) sender)
    384464  (declare (ignore sender))
    385   (let* ((buffer (hemlock-document-buffer self))
    386          (process (if buffer (hi::buffer-process buffer))))
    387     (when (typep process 'cocoa-listener-process)
     465  (let* ((process (hemlock-document-process self)))
     466    (when process
    388467      (ccl::force-break-in-listener process))))
    389468
    … …  
    392471(objc:defmethod (#/exitBreak: :void) ((self hemlock-listener-document) sender)
    393472  (declare (ignore sender))
    394   (let* ((buffer (hemlock-document-buffer self))
    395          (process (if buffer (hi::buffer-process buffer))))
    396     (log-debug  "~&exitBreak buffer ~s process ~s" buffer process)
    397     (when (typep process 'cocoa-listener-process)
     473  (let* ((process (hemlock-document-process self)))
     474    (log-debug  "~&exitBreak process ~s" process)
     475    (when process
    398476      (process-interrupt process #'abort-break))))
    399477
    … …  
    402480
    403481(objc:defmethod (#/backtrace: :void) ((self hemlock-listener-document) sender)
    404   (let* ((buffer (hemlock-document-buffer self))
    405          (process (if buffer (hi::buffer-process buffer))))
    406     (when (typep process 'cocoa-listener-process)
     482  (let* ((process (hemlock-document-process self)))
     483    (when process
    407484      (let* ((context (listener-backtrace-context process)))
    408485        (when context
    … …  
    435512                           
    436513(objc:defmethod (#/restarts: :void) ((self hemlock-listener-document) sender)
    437   (let* ((buffer (hemlock-document-buffer self))
    438          (process (if buffer (hi::buffer-process buffer))))
    439     (when (typep process 'cocoa-listener-process)
     514  (let* ((process (hemlock-document-process self)))
     515    (when process
    440516      (let* ((context (listener-backtrace-context process)))
    441517        (when context
    … …  
    444520(objc:defmethod (#/continue: :void) ((self hemlock-listener-document) sender)
    445521  (declare (ignore sender))
    446   (let* ((buffer (hemlock-document-buffer self))
    447          (process (if buffer (hi::buffer-process buffer))))
    448     (when (typep process 'cocoa-listener-process)
     522  (let* ((process (hemlock-document-process self)))
     523    (when process
    449524      (let* ((context (listener-backtrace-context process)))
    450525        (when context
    … …  
    464539  ;; So far, all actions demand that there be an underlying process, so
    465540  ;; check for that first.
    466   (let* ((buffer (hemlock-document-buffer doc))
    467          (process (if buffer (hi::buffer-process buffer))))
    468     (if (typep process 'cocoa-listener-process)
     541  (let* ((process (hemlock-document-process doc)))
     542    (if process
    469543      (let* ((action (#/action item)))
    470         #+GZ (log-debug "Validate menu item buffer: ~s process: ~s action: ~s context ~s" buffer process
    471                         (cond ((eql action (@selector #/revertDocumentToSaved:))
    472                                "revertDocumentToSaved:")
    473                               ((eql action (@selector #/saveDocument:))
    474                                "saveDocument:")
    475                               ((eql action (@selector #/saveDocumentAs:))
    476                                "saveDocumentAs:")
    477                               ((eql action (@selector #/interrupt:))
    478                                "interrupt")
    479                               ((eql action (@selector #/continue:))
    480                                "continue")
    481                               ((eql action (@selector #/backtrace:))
    482                                "backtrace")
    483                               ((eql action (@selector #/exitBreak:))
    484                                "exitBreak:")
    485                               ((eql action (@selector #/restarts:))
    486                                "restarts:")
    487                               (t action))
    488                         (cocoa-listener-process-backtrace-contexts process))
    489544        (cond
    490545          ((or (eql action (@selector #/revertDocumentToSaved:))
    … …  
    524579
    525580(defmethod ui-object-note-package ((app ns:ns-application) package)
    526   (with-autorelease-pool
    527       (process-interrupt *cocoa-event-process*
    528                          #'(lambda (proc name)
    529                              (dolist (buf hi::*buffer-list*)
    530                                (when (eq proc (hi::buffer-process buf))
    531                                  (setf (hi::variable-value 'hemlock::current-package :buffer buf) name))))
    532                          *current-process*
    533                          (shortest-package-name package))))
     581  (let ((proc *current-process*)
     582        (name (shortest-package-name package)))
     583    (execute-in-gui #'(lambda ()
     584                        (dolist (buf hi::*buffer-list*)
     585                          (when (eq proc (buffer-process buf))
     586                            (setf (hi::variable-value 'hemlock::current-package :buffer buf) name)))))))
    534587
    535588;;; This is basically used to provide INPUT to the listener process, by
    536589;;; writing to an fd which is conntected to that process's standard
    537590;;; input.
    538 (defmethod hi::send-string-to-listener-process ((process cocoa-listener-process)
    539                                                 string &key path package)
     591(defmethod send-string-to-listener-process ((process cocoa-listener-process)
     592                                            string &key path package)
    540593  (let* ((stream (cocoa-listener-process-input-peer-stream process)))
    541594    (labels ((out-raw-char (ch)
    … …  
    570623  (declare (ignore selection))
    571624  (#/performSelectorOnMainThread:withObject:waitUntilDone:
    572    (#/delegate *NSApp*) (@selector #/ensureListener:) +null-ptr+ #$YES)
    573   (let* ((top-listener-document (#/topListener hemlock-listener-document)))
    574     (if top-listener-document
    575       (let* ((buffer (hemlock-document-buffer top-listener-document)))
    576         (if buffer
    577           (let* ((proc (hi::buffer-process buffer)))
    578             (if (typep proc 'cocoa-listener-process)
    579               proc)))))))
     625   (#/delegate *NSApp*)
     626   (@selector #/ensureListener:)
     627   +null-ptr+
     628   #$YES)
     629  (hemlock-document-process (#/topListener hemlock-listener-document)))
    580630
    581631(defmethod ui-object-eval-selection ((app ns:ns-application)
    … …  
    583633  (let* ((target-listener (ui-object-choose-listener-for-selection
    584634                           app selection)))
    585     (if (typep target-listener 'cocoa-listener-process)
    586         (destructuring-bind (package path string) selection
    587         (hi::send-string-to-listener-process target-listener string :package package :path path)))))
     635    (when target-listener
     636      (destructuring-bind (package path string) selection
     637        (send-string-to-listener-process target-listener string :package package :path path)))))
    588638
    589639(defmethod ui-object-load-buffer ((app ns:ns-application) selection)
    590640  (let* ((target-listener (ui-object-choose-listener-for-selection app nil)))
    591     (if (typep target-listener 'cocoa-listener-process)
    592         (destructuring-bind (package path) selection
    593           (let ((string (format nil "(load ~S)" path)))
    594             (hi::send-string-to-listener-process target-listener string :package package :path path))))))
     641    (when target-listener
     642      (destructuring-bind (package path) selection
     643        (let ((string (format nil "(load ~S)" path)))
     644          (send-string-to-listener-process target-listener string :package package :path path))))))
    595645
    596646(defmethod ui-object-compile-buffer ((app ns:ns-application) selection)
    597647  (let* ((target-listener (ui-object-choose-listener-for-selection app nil)))
    598     (if (typep target-listener 'cocoa-listener-process)
    599         (destructuring-bind (package path) selection
    600           (let ((string (format nil "(compile-file ~S)" path)))
    601             (hi::send-string-to-listener-process target-listener string :package package :path path))))))
     648    (when target-listener
     649      (destructuring-bind (package path) selection
     650        (let ((string (format nil "(compile-file ~S)" path)))
     651          (send-string-to-listener-process target-listener string :package package :path path))))))
    602652
    603653(defmethod ui-object-compile-and-load-buffer ((app ns:ns-application) selection)
    604654  (let* ((target-listener (ui-object-choose-listener-for-selection app nil)))
    605     (if (typep target-listener 'cocoa-listener-process)
    606         (destructuring-bind (package path) selection
    607           (let ((string (format nil "(progn (compile-file ~S)(load ~S))"
    608                                 path
    609                                 (make-pathname :directory (pathname-directory path)
    610                                                :name (pathname-name path)
    611                                                :type (pathname-type path)))))
    612             (hi::send-string-to-listener-process target-listener string :package package :path path))))))
     655    (when target-listener
     656      (destructuring-bind (package path) selection
     657        (let ((string (format nil "(progn (compile-file ~S)(load ~S))"
     658                              path
     659                              (make-pathname :directory (pathname-directory path)
     660                                             :name (pathname-name path)
     661                                             :type (pathname-type path)))))
     662          (send-string-to-listener-process target-listener string :package package :path path))))))
    613663
    614664       
    615   
     665 

  • branches/event-ide/ccl/cocoa-ide/cocoa-window.lisp

    r7911 r7929  
    157157  (flet ((cocoa-startup ()
    158158           ;; Start up a thread to run periodic tasks.
    159            (process-run-function "housekeeping"
    160                                  #'(lambda ()
    161                                      (loop
    162                                        (ccl::%nanosleep ccl::*periodic-task-seconds*
    163                                                         ccl::*periodic-task-nanoseconds*)
    164                                        (ccl::housekeeping))))
    165            
     159           (process-run-function "housekeeping" #'ccl::housekeeping-loop)
    166160           (with-autorelease-pool
    167161             (enable-foreground)

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/lispmode.lisp

    r7913 r7929  
    331331    (unless (lisp-info-ending-quoted line-info)
    332332      (loop
    333         (find-lisp-char mark)
     333        (unless (find-lisp-char mark)
     334          (error "Expected at least a newline!"))
     335
    334336        (ecase (character-attribute :lisp-syntax (next-character mark))
    335337         

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/listener.lisp

    r7913 r7929  
    198198          (move-mark (value buffer-input-mark) (current-point))
    199199          (append-font-regions (current-buffer))
    200           (hi::send-string-to-listener-process (hi::buffer-process (current-buffer))
    201                                            string))))))
     200          (hemlock-ext:send-string-to-listener (current-buffer) string))))))
    202201
    203202(defparameter *pop-string* ":POP
    … …  
    212211      (if (and (null (next-character point))
    213212               (null (next-character input-mark)))
    214           (listener-document-send-string (hi::buffer-document (current-buffer)) *pop-string*)
    215           (delete-next-character-command p)))))
    216 
    217              
    218 
    219 
    220 
     213        (hemlock-ext:send-string-to-listener (current-buffer) *pop-string*)
     214        (delete-next-character-command p)))))
    221215
    222216
    … …  
    518512         (expr (with-input-from-region (s region)
    519513                 (read s))))
    520     (let* ((*print-pretty* t))
    521       (format t "~&~s~&" (funcall expander expr)))))
     514    (let* ((*print-pretty* t)
     515           (expansion (funcall expander expr)))
     516      (format t "~&~s~&" expansion))))
    522517
    523518(defcommand "Editor Macroexpand-1 Expression" (p)
    … …  
    548543(defcommand "Editor Evaluate Buffer" (p)
    549544  "Evaluates the text in the current buffer in the editor Lisp."
    550   "Evaluates the text in the current buffer redirecting *Standard-Output* to
    551    the echo area.  This occurs in the editor Lisp.  The prefix argument is
    552    ignored."
    553545  (declare (ignore p))
    554546  (message "Evaluating buffer in the editor ...")
    555547  (with-input-from-region (stream (buffer-region (current-buffer)))
    556     (let ((*standard-output* *echo-area-stream*))
    557       (in-lisp
    558        (do ((object (read stream nil lispbuf-eof)
    559                     (read stream nil lispbuf-eof)))
    560            ((eq object lispbuf-eof))
    561          (eval object))))
     548    (in-lisp
     549     (do ((object (read stream nil lispbuf-eof)
     550                  (read stream nil lispbuf-eof)))
     551         ((eq object lispbuf-eof))
     552       (eval object)))
    562553    (message "Evaluation complete.")))
    563554

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/modeline.lisp

    r7844 r7929  
    204204 :function #'(lambda (buffer window)
    205205               (declare (ignore window))
    206                (let* ((proc (buffer-process buffer)))
    207                  (when proc
    208                    (format nil "~a(~d) [~a]"
    209                            (ccl::process-name proc)
    210                            (ccl::process-serial-number proc)
    211                            (ccl::process-whostate proc))))))
     206               (hemlock-ext:buffer-process-description buffer)))
    212207
    213208(defparameter *default-modeline-fields*

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/package.lisp

    r7919 r7929  
    368368   #:edit-single-definition
    369369   #:change-active-pane
     370   #:send-string-to-listener
     371   #:buffer-process-description
    370372   ))
    371373

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/views.lisp

    r7919 r7929  
    178178
    179179(defmethod execute-hemlock-key ((view hemlock-view) key)
     180  #+gz (log-debug "~&execute-hemlock-key ~s" key)
    180181  (if (or (symbolp key) (functionp key))
    181182    (funcall key)
    … …  
    183184      (multiple-value-bind (main-binding transparent-bindings)
    184185                           (get-command-binding-for-key view key)
     186        #+gz (log-debug "~&  binding ~s ~s" main-binding transparent-bindings)
    185187        (when main-binding
    186188          (let* ((*last-last-command-type* (shiftf (hemlock-last-command-type view) nil))
Note: See TracChangeset for help on using the changeset viewer.