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

Last change on this file since 11960 was 11960, checked in by rme, 11 years ago

Updates to the search files dialog.

Instead of combo box data sources, use the built-in combo box list. Enable
and disable the search button based on the state of the dialog. Run grep
in a separate thread. Use checkboxes instead of a menu for search options.

File size: 6.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    (declare (special *standalone-cocoa-ide*))
23    (#/registerDefaults: domain dict)
24    (#/release dict)
25    (update-cocoa-defaults)
26    (when *standalone-cocoa-ide*
27      (init-ccl-directory-for-ide))))
28
29(defun init-ccl-directory-for-ide ()
30  (let* ((bundle-path (#/bundlePath (#/mainBundle ns:ns-bundle)))
31         (parent (#/stringByDeletingLastPathComponent bundle-path))
32         (path (ccl::ensure-directory-pathname
33                (lisp-string-from-nsstring parent))))
34    (ccl::replace-base-translation "ccl:" path)))
35         
36
37(objc:defmethod (#/applicationWillFinishLaunching: :void)
38    ((self lisp-application-delegate) notification)
39  (declare (ignore notification))
40  (initialize-user-interface)
41  (let* ((c (#/init (#/alloc console-window))))
42    (unless (%null-ptr-p c)
43      (setf (console *nsapp*) c))))
44
45(objc:defmethod (#/applicationWillTerminate: :void)
46                ((self lisp-application-delegate) notification)
47  (declare (ignore notification))
48  ;; UI has decided to quit; terminate other lisp threads.
49  (ccl::prepare-to-quit))
50
51(defloadvar *preferences-window-controller* nil)
52
53(objc:defmethod (#/showPreferences: :void) ((self lisp-application-delegate)
54                                            sender)
55  (declare (ignore sender))
56  (when (null *preferences-window-controller*)
57    (setf *preferences-window-controller*
58          (make-instance 'preferences-window-controller)))
59  (#/showWindow: *preferences-window-controller* self))
60
61(defloadvar *processes-window-controller* nil)
62
63(objc:defmethod (#/showProcessesWindow: :void) ((self lisp-application-delegate)
64                                                sender)
65  (declare (ignore sender))
66  (when (null *processes-window-controller*)
67    (setf *processes-window-controller*
68          (make-instance 'processes-window-controller)))
69  (#/showWindow: *processes-window-controller* self))
70
71(defloadvar *apropos-window-controller* nil)
72
73(objc:defmethod (#/showAproposWindow: :void) ((self lisp-application-delegate)
74                                                sender)
75  (declare (ignore sender))
76  (when (null *apropos-window-controller*)
77    (setf *apropos-window-controller*
78          (make-instance 'apropos-window-controller)))
79  (#/showWindow: *apropos-window-controller* self))
80
81(objc:defmethod (#/showSearchFiles: :void) ((self lisp-application-delegate)
82                                            sender)
83  ;;If command key is pressed, always make a new window
84  ;;otherwise bring frontmost search files window to the front
85  (declare (ignore sender))
86  (let ((w nil))
87    (if (or (current-event-command-key-p)
88            (null (setf w (first-window-with-controller-type 'search-files-window-controller))))
89      (let* ((wc (make-instance 'search-files-window-controller)))
90        (setf w (#/window 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))
153
154(objc:defmethod (#/loadFile: :void) ((self lisp-application-delegate) sender)
155  (declare (ignore sender))
156  (let ((filename (cocoa-choose-file-dialog
157                   :button-string "Load"
158                   :file-types (list (pathname-type *.lisp-pathname*)
159                                     (pathname-type *.fasl-pathname*)))))
160    (when filename
161      (#/ensureListener: self nil)
162      (let* ((doc (#/topListener hemlock-listener-document))
163             (process (hemlock-document-process doc)))
164        (process-interrupt process #'(lambda ()
165                                       (load filename)
166                                       (fresh-line)))))))
167
168(objc:defmethod (#/compileFile: :void) ((self lisp-application-delegate) sender)
169  (declare (ignore sender))
170  (let ((filename (cocoa-choose-file-dialog
171                   :button-string "Compile"
172                   :file-types (list (pathname-type *.lisp-pathname*)))))
173    (when filename
174      (#/ensureListener: self nil)
175      (let* ((doc (#/topListener hemlock-listener-document))
176             (process (hemlock-document-process doc)))
177        (process-interrupt process #'(lambda ()
178                                       (compile-file filename)
179                                       (fresh-line)))))))
180
Note: See TracBrowser for help on using the repository browser.