Changeset 7556


Ignore:
Timestamp:
Oct 31, 2007, 2:34:28 AM (12 years ago)
Author:
rme
Message:

Move lisp-application-delegate class from cocoa.lisp into new
file app-delegate.lisp.

Location:
trunk/ccl/cocoa-ide
Files:
1 added
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/cocoa-ide/cocoa.lisp

    r7497 r7556  
    7373(require "COCOA-BACKTRACE")
    7474(require "COCOA-INSPECTOR")
    75 (require "PROCESSES-WINDOW")
     75(require "APP-DELEGATE")
     76
    7677
    7778(def-cocoa-default *ccl-directory* :string "" nil #'(lambda (old new)
     
    101102        (make-pathname :directory (butlast dir 3))
    102103        path)))
    103 
    104 
    105 
    106 ;;; The application delegate gets notified of state changes in the
    107 ;;; application object.
    108 (defclass lisp-application-delegate (ns:ns-object)
    109     ()
    110   (:metaclass ns:+ns-object))
    111 
    112 
    113 (objc:defmethod (#/applicationWillFinishLaunching: :void)
    114     ((self lisp-application-delegate) notification)
    115   (declare (ignore notification))
    116   (initialize-user-interface))
    117 
    118 (objc:defmethod (#/applicationWillTerminate: :void)
    119     ((self lisp-application-delegate) notification)
    120   (declare (ignore notification))
    121   ;; UI has decided to quit; terminate other lisp threads.
    122   (prepare-to-quit))
    123 
    124 (objc:defmethod (#/newListener: :void) ((self lisp-application-delegate)
    125                                         sender)
    126   (declare (ignore sender))
    127   (#/openUntitledDocumentOfType:display:
    128    (#/sharedDocumentController ns:ns-document-controller)
    129    #@"Listener"
    130    t))
    131 
    132 (objc:defmethod (#/showListener: :void) ((self lisp-application-delegate)
    133                                         sender)
    134   (declare (ignore sender))
    135   (let* ((all-windows (#/orderedWindows *NSApp*))
    136          (key-window (#/keyWindow *NSApp*))
    137          (listener-windows ())
    138          (top-listener nil))
    139     (dotimes (i (#/count all-windows))
    140       (let* ((w (#/objectAtIndex: all-windows i))
    141              (wc (#/windowController w)))
    142         (when (eql (#/class wc) hemlock-listener-window-controller)
    143           (push w listener-windows))))
    144     (setq listener-windows (nreverse listener-windows))
    145     (setq top-listener (car listener-windows))
    146     (cond
    147      ((null listener-windows)
    148       (#/newListener: self +null-ptr+))
    149      ((eql key-window top-listener)
    150       ;; The current window is a listener.  If there is more than
    151       ;; one listener, bring the rear-most forward.
    152       (let* ((w (car (last listener-windows))))
    153         (if (eql top-listener w)
    154           (#_NSBeep)
    155           (#/makeKeyAndOrderFront: w +null-ptr+))))
    156      (t
    157       (#/makeKeyAndOrderFront: top-listener +null-ptr+)))))
    158 
    159 (objc:defmethod (#/ensureListener: :void) ((self lisp-application-delegate)
    160                                            sender)
    161   "If no listener exists, create one and bring it to the front without making it the key or main window."
    162   (declare (ignore sender))
    163   (let ((top-listener-document (#/topListener hemlock-listener-document)))
    164     (when (eql top-listener-document +null-ptr+)
    165       (let* ((dc (#/sharedDocumentController ns:ns-document-controller))
    166              (wc nil))
    167         (setq top-listener-document
    168               (#/makeUntitledDocumentOfType:error: dc #@"Listener" +null-ptr+))
    169         (#/addDocument: dc top-listener-document)
    170         (#/makeWindowControllers top-listener-document)
    171         (setq wc (#/lastObject (#/windowControllers top-listener-document)))
    172         (#/orderFront: (#/window wc) +null-ptr+)))))
    173 
    174 (defloadvar *processes-window-controller* nil)
    175 
    176 (objc:defmethod (#/showProcessesWindow: :void) ((self lisp-application-delegate)
    177                                                 sender)
    178   (declare (ignore sender))
    179   (when (null *processes-window-controller*)
    180     (setf *processes-window-controller* (make-instance 'processes-window-controller)))
    181   (#/showWindow: *processes-window-controller* self))
    182 
    183 (defvar *cocoa-application-finished-launching* (make-semaphore)
    184   "Semaphore that's signaled when the application's finished launching ...")
    185 
    186 (objc:defmethod (#/applicationDidFinishLaunching: :void)
    187     ((self lisp-application-delegate) notification)
    188   (declare (ignore notification))
    189   (signal-semaphore *cocoa-application-finished-launching*))
    190 
    191 (objc:defmethod (#/applicationOpenUntitledFile: :<BOOL>)
    192     ((self lisp-application-delegate) app)
    193   (when (zerop *cocoa-listener-count*)
    194     (#/newListener: self app)
    195     t))
    196 
    197104
    198105(defmethod ui-object-do-operation ((o ns:ns-application)
Note: See TracChangeset for help on using the changeset viewer.