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

Last change on this file since 11036 was 11036, checked in by gb, 12 years ago

If *standalone-cocoa-ide*, set the ccl directory to the parent of
the bundle in #/initialize.

File size: 5.7 KB
Line 
1;;;-*-Mode: LISP; Package: GUI -*-
2;;;
3;;;   Copyright (C) 2007 Clozure Associates
4
5(in-package "GUI")
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    (#/registerDefaults: domain dict)
23    (#/release dict)
24    (update-cocoa-defaults)
25    (when *standalone-cocoa-ide*
26      (init-ccl-directory-for-ide))))
27
28(defun init-ccl-directory-for-ide ()
29  (let* ((bundle-path (#/bundlePath (#/mainBundle ns:ns-bundle)))
30         (parent (#/stringByDeletingLastPathComponent bundle-path))
31         (path (ccl::ensure-directory-pathname
32                (lisp-string-from-nsstring parent))))
33    (ccl::replace-base-translation "ccl" path)))
34         
35
36(objc:defmethod (#/applicationWillFinishLaunching: :void)
37    ((self lisp-application-delegate) notification)
38  (declare (ignore notification))
39  (initialize-user-interface)
40  (let* ((c (#/init (#/alloc console-window))))
41    (unless (%null-ptr-p c)
42      (setf (console *nsapp*) c))))
43
44(objc:defmethod (#/applicationWillTerminate: :void)
45                ((self lisp-application-delegate) notification)
46  (declare (ignore notification))
47  ;; UI has decided to quit; terminate other lisp threads.
48  (ccl::prepare-to-quit))
49
50(defloadvar *preferences-window-controller* nil)
51
52(objc:defmethod (#/showPreferences: :void) ((self lisp-application-delegate)
53                                            sender)
54  (declare (ignore sender))
55  (when (null *preferences-window-controller*)
56    (setf *preferences-window-controller*
57          (make-instance 'preferences-window-controller)))
58  (#/showWindow: *preferences-window-controller* self))
59
60(defloadvar *processes-window-controller* nil)
61
62(objc:defmethod (#/showProcessesWindow: :void) ((self lisp-application-delegate)
63                                                sender)
64  (declare (ignore sender))
65  (when (null *processes-window-controller*)
66    (setf *processes-window-controller*
67          (make-instance 'processes-window-controller)))
68  (#/showWindow: *processes-window-controller* self))
69
70(defloadvar *apropos-window-controller* nil)
71
72(objc:defmethod (#/showAproposWindow: :void) ((self lisp-application-delegate)
73                                                sender)
74  (declare (ignore sender))
75  (when (null *apropos-window-controller*)
76    (setf *apropos-window-controller*
77          (make-instance 'apropos-window-controller)))
78  (#/showWindow: *apropos-window-controller* self))
79
80(objc:defmethod (#/showSearchFiles: :void) ((self lisp-application-delegate)
81                                            sender)
82  ;;If command key is pressed, always make a new window
83  ;;otherwise bring frontmost search files window to the front
84  (declare (ignore sender))
85  (let ((w nil))
86    (if (or (current-event-command-key-p)
87            (null (setf w (first-window-with-controller-type 'search-files-window-controller))))
88      (let* ((wc (make-instance 'search-files-window-controller)))
89        (setf w (#/window wc))
90        (#/setWindowController: w wc))
91      (#/makeKeyAndOrderFront: w self))))
92
93(objc:defmethod (#/newListener: :void) ((self lisp-application-delegate)
94                                        sender)
95  (declare (ignore sender))
96  (#/openUntitledDocumentOfType:display:
97   (#/sharedDocumentController ns:ns-document-controller) #@"Listener" t))
98
99(objc:defmethod (#/showListener: :void) ((self lisp-application-delegate)
100                                        sender)
101  (declare (ignore sender))
102  (let* ((all-windows (#/orderedWindows *NSApp*))
103         (key-window (#/keyWindow *NSApp*))
104         (listener-windows ())
105         (top-listener nil))
106    (dotimes (i (#/count all-windows))
107      (let* ((w (#/objectAtIndex: all-windows i))
108             (wc (#/windowController w)))
109        (when (eql (#/class wc) hemlock-listener-window-controller)
110          (push w listener-windows))))
111    (setq listener-windows (nreverse listener-windows))
112    (setq top-listener (car listener-windows))
113    (cond 
114     ((null listener-windows)
115      (#/newListener: self +null-ptr+))
116     ((eql key-window top-listener)
117      ;; The current window is a listener.  If there is more than
118      ;; one listener, bring the rear-most forward.
119      (let* ((w (car (last listener-windows))))
120        (if (eql top-listener w)
121          (#_NSBeep)
122          (#/makeKeyAndOrderFront: w +null-ptr+))))
123     (t
124      (#/makeKeyAndOrderFront: top-listener +null-ptr+)))))
125
126(objc:defmethod (#/ensureListener: :void) ((self lisp-application-delegate)
127                                           sender)
128  (declare (ignore sender))
129  (let ((top-listener-document (#/topListener hemlock-listener-document)))
130    (when (eql top-listener-document +null-ptr+)
131      (let* ((dc (#/sharedDocumentController ns:ns-document-controller))
132             (wc nil))
133        (setq top-listener-document
134              (#/makeUntitledDocumentOfType:error: dc #@"Listener" +null-ptr+))
135        (#/addDocument: dc top-listener-document)
136        (#/makeWindowControllers top-listener-document)
137        (setq wc (#/lastObject (#/windowControllers top-listener-document)))
138        (#/orderFront: (#/window wc) +null-ptr+)))))
139
140(defvar *cocoa-application-finished-launching* (make-semaphore)
141  "Semaphore that's signaled when the application's finished launching ...")
142
143(objc:defmethod (#/applicationDidFinishLaunching: :void)
144    ((self lisp-application-delegate) notification)
145  (declare (ignore notification))
146  (signal-semaphore *cocoa-application-finished-launching*))
147
148(objc:defmethod (#/applicationOpenUntitledFile: :<BOOL>)
149    ((self lisp-application-delegate) app)
150  (when (zerop *cocoa-listener-count*)
151    (#/newListener: self app)
152    t))
Note: See TracBrowser for help on using the repository browser.