Changeset 14216
- Timestamp:
- Aug 25, 2010, 6:34:02 PM (14 years ago)
- File:
-
- 1 edited
-
trunk/source/cocoa-ide/cocoa-listener.lisp (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/cocoa-ide/cocoa-listener.lisp
r13901 r14216 250 250 (backtrace-contexts :initform nil 251 251 :accessor cocoa-listener-process-backtrace-contexts) 252 (window :reader cocoa-listener-process-window )))252 (window :reader cocoa-listener-process-window :initform nil))) 253 253 254 254 (defloadvar *first-listener* t) … … 280 280 :initial-function 281 281 #'(lambda () 282 (setq ccl::*listener-autorelease-pool* (create-autorelease-pool)) 283 (when (and *standalone-cocoa-ide* 282 (setq ccl::*listener-autorelease-pool* (create-autorelease-pool)) (when (and *standalone-cocoa-ide* 284 283 (prog1 *first-listener* (setq *first-listener* nil))) 285 284 (ccl::startup-ccl (ccl::application-init-file ccl::*application*)) … … 302 301 (declare (ignorable edited))) 303 302 303 (objc:defmethod (#/windowShouldClose: #>BOOL) ((w hemlock-listener-frame) 304 sender) 305 (let* ((doc (#/document w))) 306 (if (or (%null-ptr-p doc) 307 (and (hemlock-document-process doc) 308 (perform-close-kills-process-p doc))) 309 t 310 (progn 311 (#/orderOut: w sender) 312 nil)))) 313 314 304 315 305 316 (defclass hemlock-listener-window-controller (hemlock-editor-window-controller) … … 333 344 334 345 (defclass hemlock-listener-document (hemlock-editor-document) 335 ((process :reader %hemlock-document-process :writer (setf hemlock-document-process) ))346 ((process :reader %hemlock-document-process :writer (setf hemlock-document-process) :initform nil)) 336 347 (:metaclass ns:+ns-object)) 337 348 (declaim (special hemlock-listener-document)) … … 369 380 370 381 (objc:defmethod #/topListener ((self +hemlock-listener-document)) 371 (let* ((all-documents (#/orderedDocuments *NSApp*))) 372 (dotimes (i (#/count all-documents) +null-ptr+) 373 (let* ((doc (#/objectAtIndex: all-documents i))) 374 (when (eql (#/class doc) self) 375 (return doc)))))) 382 (let* ((all-windows (#/orderedWindows *NSApp*))) 383 (dotimes (i (#/count all-windows) +null-ptr+) 384 (let* ((w (#/objectAtIndex: all-windows i))) 385 (when (#/isVisible w) 386 (let* ((wc (#/windowController w)) 387 (doc (#/document wc))) 388 (when (#/isKindOfClass: doc self) 389 (return doc)))))))) 376 390 377 391 (defun symbol-value-in-top-listener-process (symbol) … … 421 435 (defloadvar *next-listener-y-pos* nil) ; likewise 422 436 423 (objc:defmethod (#/ close:void) ((self hemlock-listener-document))437 (objc:defmethod (#/dealloc :void) ((self hemlock-listener-document)) 424 438 (if (zerop (decf *cocoa-listener-count*)) 425 439 (setq *next-listener-x-pos* nil … … 429 443 (process-kill p))) 430 444 (call-next-method)) 445 431 446 432 447 … … 473 488 (#/addWindowController: self controller) 474 489 (#/release controller) 475 (setf (hemlock-document-process self) 476 (new-cocoa-listener-process listener-name window)) 490 (unless (hemlock-document-process self) 491 (setf (hemlock-document-process self) 492 (new-cocoa-listener-process listener-name window))) 477 493 (when path 478 494 (unless (#/setFrameAutosaveName: window path) … … 485 501 (+ (ns:ns-rect-y frame) 486 502 (ns:ns-rect-height frame))) 487 488 489 490 (setq *next-listener-x-pos*491 (ns:ns-point-x next-point)492 *next-listener-y-pos*493 (ns:ns-point-y next-point)))))503 (let* ((next-point (#/cascadeTopLeftFromPoint: 504 window 505 current-point))) 506 (setq *next-listener-x-pos* 507 (ns:ns-point-x next-point) 508 *next-listener-y-pos* 509 (ns:ns-point-y next-point))))) 494 510 t)) 495 511 (ns:with-ns-point (current-point … … 635 651 (call-next-method item)))) 636 652 653 (defmethod perform-close-kills-process-p ((self hemlock-listener-document)) 654 t) 655 637 656 (defun shortest-package-name (package) 638 657 (let* ((name (package-name package)) … … 710 729 711 730 712 731 ;;; Support for background processes that acquire listener window/document/ 732 ;;; buffer infrastructure iff they try to do I/O to *TERMINAL-IO*. 733 734 (defclass hemlock-background-listener-document (hemlock-listener-document) 735 () 736 (:metaclass ns:+ns-object)) 737 738 (defmethod perform-close-kills-process-p ((self hemlock-background-listener-document)) 739 nil) 740 741 (defstruct deferred-cocoa-listener-stream-info 742 real-input-stream 743 real-output-stream 744 process 745 window) 746 747 748 (defclass deferred-cocoa-listener-stream (fundamental-character-stream) 749 ((info :initarg :info :accessor deferred-cocoa-listener-stream-info))) 750 751 (defmethod ensure-deferred-stream-info-for-io ((s deferred-cocoa-listener-stream)) 752 (let* ((info (slot-value s 'info))) 753 (when info 754 (unless (deferred-cocoa-listener-stream-info-window info) 755 (with-autorelease-pool 756 (let* ((doc (make-instance 'hemlock-background-listener-document)) 757 (buffer (hemlock-buffer doc)) 758 (process (deferred-cocoa-listener-stream-info-process info))) 759 (setf (hi::buffer-name buffer) 760 (format nil "~a(~d)" (process-name process) (process-serial-number process)) 761 (hemlock-document-process doc) process) 762 (execute-in-gui (lambda () (#/makeWindowControllers doc))) 763 (let* ((wc (#/lastObject (#/windowControllers doc))) 764 (window (#/window wc))) 765 (setf 766 (deferred-cocoa-listener-stream-info-real-input-stream info) 767 (make-instance 'cocoa-listener-input-stream) 768 (deferred-cocoa-listener-stream-info-real-output-stream info) 769 (make-instance 'cocoa-listener-output-stream 770 :hemlock-view (hemlock-view window)) 771 (deferred-cocoa-listener-stream-info-window info) 772 window 773 (slot-value process 'window) window) 774 (ui-object-note-package *nsapp* *package*)))))) 775 info)) 776 777 778 779 (defclass deferred-cocoa-listener-output-stream 780 (fundamental-character-output-stream deferred-cocoa-listener-stream) 781 ()) 782 783 (defmethod stream-element-type ((s deferred-cocoa-listener-output-stream)) 784 'character) 785 786 787 (defmethod underlying-output-stream ((s deferred-cocoa-listener-output-stream)) 788 (let* ((info (ensure-deferred-stream-info-for-io s))) 789 (if info 790 (progn 791 (let* ((window (deferred-cocoa-listener-stream-info-window info))) 792 (unless (#/isVisible window) 793 (execute-in-gui 794 (lambda () 795 (#/makeKeyAndOrderFront: window (%null-ptr))))) 796 (deferred-cocoa-listener-stream-info-real-output-stream info))) 797 (ccl::stream-is-closed s)))) 798 799 (defmethod ccl:stream-write-char ((s deferred-cocoa-listener-output-stream) 800 char) 801 (with-autorelease-pool 802 (stream-write-char (underlying-output-stream s) char))) 803 804 (defmethod ccl:stream-line-column ((s deferred-cocoa-listener-output-stream)) 805 (stream-line-column (underlying-output-stream s))) 806 807 (defmethod ccl:stream-fresh-line ((s deferred-cocoa-listener-output-stream)) 808 (stream-fresh-line (underlying-output-stream s))) 809 810 (defmethod ccl::stream-finish-output ((s deferred-cocoa-listener-output-stream)) 811 (stream-force-output s)) 812 813 (defmethod ccl:stream-force-output ((s deferred-cocoa-listener-output-stream)) 814 (let* ((info (slot-value s 'info))) 815 (if info 816 (let* ((out (deferred-cocoa-listener-stream-info-real-output-stream info))) 817 (if out 818 (stream-force-output out))) 819 (ccl::stream-is-closed s)))) 820 821 (defmethod ccl:stream-clear-output ((s deferred-cocoa-listener-output-stream)) 822 (stream-clear-output (underlying-output-stream s))) 823 824 (defmethod ccl:stream-line-length ((s deferred-cocoa-listener-output-stream)) 825 (stream-line-length (underlying-output-stream s))) 826 827 (defmethod close ((s deferred-cocoa-listener-output-stream) 828 &key abort) 829 (let* ((info (slot-value s 'info))) 830 (when info 831 (let* ((out (deferred-cocoa-listener-stream-info-real-output-stream info))) 832 (when out 833 (stream-force-output out) 834 (close out :abort abort))) 835 (setf (slot-value s 'info) nil) 836 t))) 837 838 839 (defclass deferred-cocoa-listener-input-stream 840 (fundamental-character-input-stream deferred-cocoa-listener-stream) 841 ((reading-line :initform nil :accessor hi:input-stream-reading-line))) 842 843 844 (defmethod underlying-input-stream ((s deferred-cocoa-listener-input-stream)) 845 (let* ((info (ensure-deferred-stream-info-for-io s))) 846 (if info 847 (progn 848 (let* ((window (deferred-cocoa-listener-stream-info-window info))) 849 (unless (#/isVisible window) 850 (execute-in-gui 851 (lambda () 852 (#/makeKeyAndOrderFront: window (%null-ptr))))) 853 (deferred-cocoa-listener-stream-info-real-input-stream info))) 854 (ccl::stream-is-closed s)))) 855 856 (defmethod interactive-stream-p ((s deferred-cocoa-listener-input-stream)) 857 t) 858 859 (defmethod ccl::read-toplevel-form ((s deferred-cocoa-listener-input-stream) 860 &key eof-value) 861 (ccl::read-toplevel-form (underlying-input-stream s) :eof-value eof-value)) 862 863 (defmethod enqueue-toplevel-form ((s deferred-cocoa-listener-input-stream) string &rest args) 864 (apply #'enqueue-toplevel-form (underlying-input-stream s) string args)) 865 866 (defmethod enqueue-listener-input ((s deferred-cocoa-listener-input-stream) string) 867 (enqueue-listener-input (underlying-input-stream s) string)) 868 869 (defmethod stream-read-char-no-hang ((s deferred-cocoa-listener-input-stream)) 870 (stream-read-char-no-hang (underlying-input-stream s))) 871 872 (defmethod stream-read-char ((s deferred-cocoa-listener-input-stream)) 873 (stream-read-char (underlying-input-stream s))) 874 875 (defmethod stream-unread-char ((s deferred-cocoa-listener-input-stream) char) 876 (stream-unread-char (underlying-input-stream s) char)) 877 878 (defmethod stream-clear-input ((s deferred-cocoa-listener-input-stream)) 879 (stream-clear-input (underlying-input-stream s))) 880 881 (defmethod stream-read-line ((s deferred-cocoa-listener-input-stream)) 882 (let* ((old-reading-line (hi:input-stream-reading-line s))) 883 (unwind-protect 884 (progn 885 (setf (hi::input-stream-reading-line s) t) 886 (stream-read-line (underlying-input-stream s))) 887 (setf (hi:input-stream-reading-line s) old-reading-line)))) 888 889 (defclass background-cocoa-listener-process (cocoa-listener-process) 890 ()) 891 892 (defun background-process-run-function (name function) 893 (let* ((process (make-process name :class 'background-cocoa-listener-process)) 894 (info (make-deferred-cocoa-listener-stream-info :process process)) 895 (input-stream (make-instance 'deferred-cocoa-listener-input-stream 896 :info info)) 897 (output-stream (make-instance 'deferred-cocoa-listener-output-stream 898 :info info))) 899 (setf (slot-value process 'input-stream) input-stream 900 (slot-value process 'output-stream) output-stream) 901 (process-preset process 902 (lambda () 903 (let* ((*terminal-io* (make-two-way-stream input-stream output-stream))) 904 (ccl::add-auto-flush-stream output-stream) 905 (unwind-protect 906 (funcall function) 907 (remove-auto-flush-stream output-stream) 908 (let* ((w (slot-value process 'window))) 909 (when w 910 (let* ((doc (#/document w))) 911 (unless (%null-ptr-p doc) 912 (when (eq *current-process* 913 (hemlock-document-process doc)) 914 (setf (hemlock-document-process doc) nil)))) 915 (cond ((#/isVisible w) 916 (format output-stream "~%~%{process ~s exiting}~%" *current-process*)) 917 (t 918 (#/performSelectorOnMainThread:withObject:waitUntilDone: 919 w 920 (@selector #/close) 921 +null-ptr+ 922 t))) 923 (close input-stream) 924 (close output-stream))))))) 925 (process-enable process)))
Note:
See TracChangeset
for help on using the changeset viewer.
