source: trunk/ccl/cocoa-ide/app-delegate.lisp @ 7577

Last change on this file since 7577 was 7577, checked in by rme, 13 years ago

Leave out debugging code, duh.

File size: 4.9 KB
Line 
1(in-package "CCL")
2
3(require "COCOA-DEFAULTS")
4(require "PREFERENCES")
5(require "PROCESSES-WINDOW")
6
7(defclass lisp-application-delegate (ns:ns-object)
8    ()
9  (:metaclass ns:+ns-object))
10
11;;; This method is a good place to:
12;;;  * register value transformer names
13;;;  * register default user defaults
14(objc:defmethod (#/initialize :void) ((self +lisp-application-delegate))
15  (#/setValueTransformer:forName: ns:ns-value-transformer
16                                  (make-instance 'font-to-name-transformer)
17                                  #@"FontToName")
18
19  (let* ((domain (#/standardUserDefaults ns:ns-user-defaults))
20         (initial-values (cocoa-defaults-initial-values))
21         (dict (#/mutableCopy initial-values)))
22    ;; The lispy def-cocoa-default macro doesn't work with
23    ;; Objective-C objects, so initialize them here by hand.
24    ;; This is not nice.  We have to do something better.
25    (#/setObject:forKey: dict
26                         (#/archivedDataWithRootObject:
27                          ns:ns-archiver
28                          (#/fontWithName:size: ns:ns-font #@"Monaco" 10.0))
29                         #@"editorFont")
30    (#/setObject:forKey: dict
31                         (#/archivedDataWithRootObject:
32                          ns:ns-archiver
33                          (#/fontWithName:size: ns:ns-font #@"Monaco" 10.0))
34                         #@"listenerInputFont")
35    (#/setObject:forKey: dict
36                         (#/archivedDataWithRootObject:
37                          ns:ns-archiver
38                          (#/fontWithName:size: ns:ns-font #@"Monaco" 10.0))
39                         #@"listenerOutputFont")
40    (#/registerDefaults: domain dict)
41    (#/release dict)
42    (update-cocoa-defaults)))
43
44(objc:defmethod (#/applicationWillFinishLaunching: :void)
45    ((self lisp-application-delegate) notification)
46  (declare (ignore notification))
47  (initialize-user-interface))
48
49(objc:defmethod (#/applicationWillTerminate: :void)
50                ((self lisp-application-delegate) notification)
51  (declare (ignore notification))
52  ;; UI has decided to quit; terminate other lisp threads.
53  (ccl::prepare-to-quit))
54
55(defloadvar *preferences-window-controller* nil)
56
57(objc:defmethod (#/showPreferences: :void) ((self lisp-application-delegate)
58                                            sender)
59  (declare (ignore sender))
60  (when (null *preferences-window-controller*)
61    (setf *preferences-window-controller*
62          (make-instance 'preferences-window-controller)))
63  (#/showWindow: *preferences-window-controller* self))
64
65(defloadvar *processes-window-controller* nil)
66
67(objc:defmethod (#/showProcessesWindow: :void) ((self lisp-application-delegate)
68                                                sender)
69  (declare (ignore sender))
70  (when (null *processes-window-controller*)
71    (setf *processes-window-controller*
72          (make-instance 'processes-window-controller)))
73  (#/showWindow: *processes-window-controller* self))
74
75(objc:defmethod (#/newListener: :void) ((self lisp-application-delegate)
76                                        sender)
77  (declare (ignore sender))
78  (#/openUntitledDocumentOfType:display:
79   (#/sharedDocumentController ns:ns-document-controller) #@"Listener" t))
80
81(objc:defmethod (#/showListener: :void) ((self lisp-application-delegate)
82                                        sender)
83  (declare (ignore sender))
84  (let* ((all-windows (#/orderedWindows *NSApp*))
85         (key-window (#/keyWindow *NSApp*))
86         (listener-windows ())
87         (top-listener nil))
88    (dotimes (i (#/count all-windows))
89      (let* ((w (#/objectAtIndex: all-windows i))
90             (wc (#/windowController w)))
91        (when (eql (#/class wc) hemlock-listener-window-controller)
92          (push w listener-windows))))
93    (setq listener-windows (nreverse listener-windows))
94    (setq top-listener (car listener-windows))
95    (cond 
96     ((null listener-windows)
97      (#/newListener: self +null-ptr+))
98     ((eql key-window top-listener)
99      ;; The current window is a listener.  If there is more than
100      ;; one listener, bring the rear-most forward.
101      (let* ((w (car (last listener-windows))))
102        (if (eql top-listener w)
103          (#_NSBeep)
104          (#/makeKeyAndOrderFront: w +null-ptr+))))
105     (t
106      (#/makeKeyAndOrderFront: top-listener +null-ptr+)))))
107
108(objc:defmethod (#/ensureListener: :void) ((self lisp-application-delegate)
109                                           sender)
110  (declare (ignore sender))
111  (let ((top-listener-document (#/topListener hemlock-listener-document)))
112    (when (eql top-listener-document +null-ptr+)
113      (let* ((dc (#/sharedDocumentController ns:ns-document-controller))
114             (wc nil))
115        (setq top-listener-document
116              (#/makeUntitledDocumentOfType:error: dc #@"Listener" +null-ptr+))
117        (#/addDocument: dc top-listener-document)
118        (#/makeWindowControllers top-listener-document)
119        (setq wc (#/lastObject (#/windowControllers top-listener-document)))
120        (#/orderFront: (#/window wc) +null-ptr+)))))
121
122(defvar *cocoa-application-finished-launching* (make-semaphore)
123  "Semaphore that's signaled when the application's finished launching ...")
124
125(objc:defmethod (#/applicationDidFinishLaunching: :void)
126    ((self lisp-application-delegate) notification)
127  (declare (ignore notification))
128  (signal-semaphore *cocoa-application-finished-launching*))
129
130(objc:defmethod (#/applicationOpenUntitledFile: :<BOOL>)
131    ((self lisp-application-delegate) app)
132  (when (zerop *cocoa-listener-count*)
133    (#/newListener: self app)
134    t))
Note: See TracBrowser for help on using the repository browser.