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

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

Different kludge to deal with NSFont objects
and def-cocoa-default.

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