Changeset 16526


Ignore:
Timestamp:
Sep 2, 2015, 4:34:57 PM (4 years ago)
Author:
wws
Message:

Make HI::WITH-OUTPUT-TO-LISTENER work from the cocoa event process.
Do this by saving the output in a string and doing the actual output
via CCL:PROCESS-RUN-FUNCTION. This makes C-M, macroexpansion, work again.

refs #1307.

Location:
trunk/source/cocoa-ide
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-listener.lisp

    r16525 r16526  
    220220;; so ignore all attempts.
    221221(defun call-with-dob-data (thunk dob)
    222   (unless (typep *current-process* 'appkit-process)
     222  (unless (eq *current-process* *cocoa-event-process*)
    223223    (with-lock-grabbed ((dob-data-lock dob))
    224224      (funcall thunk (dob-data dob)))))
  • trunk/source/cocoa-ide/hemlock/src/listener.lisp

    r16245 r16526  
    645645     (let* ((*print-pretty* t)
    646646            (expansion (funcall expander expr)))
    647        (format t "~&~s~&" expansion)))))
     647       (format t "~%~s~&" expansion)))))
    648648
    649649(defcommand "Editor Macroexpand-1 Expression" (p)
  • trunk/source/cocoa-ide/hemlock/src/macros.lisp

    r16343 r16526  
    501501
    502502(defmacro with-output-to-listener (&body body)
    503   `(let* ((*saved-standard-output* (or *saved-standard-output* *standard-output*))
    504           (*standard-output* (hemlock-ext:top-listener-output-stream)))   
    505      ,@body))
     503  (let ((thunk (gensym "THUNK")))
     504    `(flet ((,thunk () ,@body))
     505       (declare (dynamic-extent #',thunk))
     506       (call-with-output-to-listener #',thunk))))
     507
     508(defun cocoa-event-process-p ()
     509  (eq ccl:*current-process* ccl::*cocoa-event-process*))
     510
     511(defun write-to-top-listener (str)
     512  (let ((stream (hemlock-ext:top-listener-output-stream)))
     513    (if (cocoa-event-process-p)
     514        (ccl:process-run-function "write-to-top-listener"
     515                                  (lambda ()
     516                                    (write-string str stream)))
     517        (write-string str stream))))
     518
     519(defun call-with-output-to-listener (thunk)
     520  (let* ((*saved-standard-output* (or *saved-standard-output* *standard-output*)))
     521    (cond ((cocoa-event-process-p)
     522           (cond ((typep *standard-output* 'ccl:string-output-stream)
     523                  (funcall thunk))
     524                 (t (let* ((values nil)
     525                           (str (with-output-to-string (*standard-output*)
     526                                  (setf values (multiple-value-list
     527                                                (funcall thunk))))))
     528                      (write-to-top-listener str)
     529                      (apply #'values values)))))
     530          (t (let ((*standard-output* (hemlock-ext:top-listener-output-stream)))
     531               (funcall thunk))))))
    506532
    507533(defmacro with-standard-standard-output (&body body)
Note: See TracChangeset for help on using the changeset viewer.