source: trunk/source/cocoa-ide/preferences.lisp @ 12115

Last change on this file since 12115 was 12115, checked in by mikel, 11 years ago

Added a "Start Now" button to the preferences pane for the swank server, so that now we can start the Swank server from the preference pane without having to restart CCL, and without necessarily enabling it to start up at launch.

File size: 10.3 KB
Line 
1;;;-*-Mode: LISP; Package: GUI -*-
2;;;
3;;;   Copyright (C) 2007 Clozure Associates
4;;;
5;;; How to add a new preference pane:
6;;;
7;;; 1. Open preferences.nib with IB.  Drag a Custom View instance from
8;;;    the palette.  Use the inpector to set its class to PreferencesView.
9;;; 2. Inspect File's Owner (which represents an instance of
10;;;    PreferencesWindowController).  Add an outlet for the new
11;;;    preferences view you just made.  Hook up the outlet.  You can
12;;;    add actions here too, if your preferences view will need them.
13;;; 3. Add controls to your view, binding them to the defaults controller.
14;;; 4. Save the nib file.
15;;; 5. In preferences.lisp (this file), edit the defclass form for
16;;;    preferences-window-controller and add a slot that matches the outlet
17;;;    you created in step 2.
18;;; 6. Edit the toolbar delegate methods to add a toolbar item for your
19;;;    new preference view.
20;;; 7. Implement a #/showFooPrefs: method to swap in the view when
21;;;    the toolbar item is clicked.  (See #/showGeneralPrefs: for an
22;;;    example.
23;;; 8. Implement actions, if needed.
24
25
26(in-package "GUI")
27
28;;; A view that keeps track of its initial size.
29(defclass preferences-view (ns:ns-view)
30  ((width :accessor width)
31   (height :accessor height))
32  (:metaclass ns:+ns-object))
33
34(objc:defmethod (#/awakeFromNib :void) ((self preferences-view))
35  (let* ((frame (#/frame self)))
36    (setf (width self) (ns-width frame)
37          (height self) (ns-height frame))))
38
39(defclass font-to-name-transformer (ns:ns-value-transformer)
40  ()
41  (:metaclass ns:+ns-object))
42
43(objc:defmethod (#/transformedValueClass :<C>lass)
44    ((self +font-to-name-transformer))
45  ns:ns-string)
46
47(objc:defmethod (#/allowsReverseTransformation :<BOOL>)
48    ((self +font-to-name-transformer))
49  nil)
50
51;;; Produce description of NSFont object, e.g., "Monaco 10"
52(objc:defmethod #/transformedValue: ((self font-to-name-transformer) value)
53  (let* ((font (#/unarchiveObjectWithData: ns:ns-unarchiver value))
54         (name (#/displayName font))
55         (size (float (#/pointSize font) 0.0d0)))
56    (#/stringWithFormat: ns:ns-string #@"%@ %.0f" :id name :double-float size)))
57
58(defclass preferences-window-controller (ns:ns-window-controller)
59  ((tab-view :foreign-type :id :accessor tab-view)
60   (editor-tab-view-item :foreign-type :id :accessor editor-tab-view-item)
61   (listener-tab-view-item :foreign-type :id :accessor listener-tab-view-item)
62   (hyperspec-path-button :foreign-type :id :accessor hyperspec-path-button)
63   (toolbar :foreign-type :id :accessor toolbar)
64   (general-prefs :foreign-type :id :accessor general-prefs)
65   (appearance-prefs :foreign-type :id :accessor appearance-prefs)
66   (documentation-prefs :foreign-type :id :accessor documentation-prefs)
67   (encodings-prefs :foreign-type :id :accessor encodings-prefs))
68  (:metaclass ns:+ns-object))
69
70(objc:defmethod #/init ((self preferences-window-controller))
71  (#/setValueTransformer:forName: ns:ns-value-transformer
72                                  (make-instance 'font-to-name-transformer)
73                                  #@"FontToName")
74
75  (#/initWithWindowNibName: self #@"preferences")
76  (#/addObserver:selector:name:object: (#/defaultCenter ns:ns-notification-center)
77                                       self
78                                       (@selector #/defaultsDidChange:)
79                                       #&NSUserDefaultsDidChangeNotification
80                                       (#/standardUserDefaults ns:ns-user-defaults))
81
82  self)
83
84(objc:defmethod (#/windowDidLoad :void) ((self preferences-window-controller))
85  (let* ((window (#/window self)))
86    (with-slots (toolbar) self
87      (setf toolbar (make-instance 'ns:ns-toolbar
88                                   :with-identifier #@"preferences-window-toolbar"))
89      (#/setDelegate: toolbar self)
90      (#/setSelectedItemIdentifier: toolbar #@"appearance")
91      (#/setToolbar: window toolbar)
92      ;; for some reason, setting this in IB doesn't work on Tiger/PPC32
93      (#/setShowsToolbarButton: window nil)
94      (#/release toolbar))
95    (#/showAppearancePrefs: self +null-ptr+)))
96 
97(objc:defmethod (#/showWindow: :void) ((self preferences-window-controller)
98                                       sender)
99  (#/center (#/window self))
100  (call-next-method sender))
101
102(objc:defmethod (#/defaultsDidChange: :void) ((self preferences-window-controller)
103                                              notification)
104  (declare (ignore notification))
105  (update-cocoa-defaults))
106
107(defconstant editor-font-button-tag 1)
108(defconstant listener-input-font-button-tag 2)
109(defconstant listener-output-font-button-tag 2)
110
111;;; Ugh.
112(defvar *listener-or-editor* nil)
113
114(objc:defmethod (#/showFontPanel: :void) ((self preferences-window-controller)
115                                         sender)
116  (let* ((tag (#/tag sender))
117         (font-manager (#/sharedFontManager ns:ns-font-manager))
118         (font nil)
119         (panel (#/window self)))
120    (ecase tag
121      (1
122       (setq font *editor-font*)
123       (setq *listener-or-editor* :editor))
124      (2
125       (setq font *listener-input-font*)
126       (setq *listener-or-editor* :listener-input))
127      (3
128       (setq font *listener-output-font*)
129       (setq *listener-or-editor* :listener-output)))
130    (#/makeFirstResponder: panel panel)
131    (#/setSelectedFont:isMultiple: font-manager font nil)
132    (#/orderFrontFontPanel: font-manager self)))
133
134(objc:defmethod (#/startSwankServer: :void) ((self preferences-window-controller)
135                                         sender)
136  (unless (or *ccl-swank-active-p* 
137              (try-starting-swank :force t))
138    (alert-window :message "Unable to start the Swank server.")))
139
140;;; This message is sent to the first responder, which is why
141;;; we do the *listener-or-editor* thing.
142(objc:defmethod (#/changeFont: :void) ((self preferences-window-controller)
143                                            font-manager)
144  (let* ((defaults (#/standardUserDefaults ns:ns-user-defaults))
145         (data nil)
146         (font nil))
147    (ecase *listener-or-editor*
148      (:listener-input
149       (setq font (#/convertFont: font-manager *listener-input-font*))
150       (unless (%null-ptr-p font)
151         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
152         (#/setObject:forKey: defaults data #@"listenerInputFont")))
153      (:listener-output
154       (setq font (#/convertFont: font-manager *listener-output-font*))
155       (unless (%null-ptr-p font)
156         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
157         (#/setObject:forKey: defaults data #@"listenerOutputFont")))
158      (:editor
159       (setq font (#/convertFont: font-manager *editor-font*))
160       (unless (%null-ptr-p font)
161         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
162         (#/setObject:forKey: defaults data #@"editorFont"))))))
163
164;;; toolbar delegate methods
165
166(objc:defmethod #/toolbar:itemForItemIdentifier:willBeInsertedIntoToolbar:
167                ((self preferences-window-controller)
168                 toolbar itemIdentifier (flag :<BOOL>))
169  (declare (ignore toolbar))
170  (let ((item +null-ptr+))
171    (cond
172     ((#/isEqualToString: itemIdentifier #@"general")
173      (setf item (make-instance 'ns:ns-toolbar-item
174                                :with-item-identifier itemIdentifier))
175      (#/setLabel: item #@"General")
176      (#/setImage: item (#/imageNamed: ns:ns-image #@"General"))
177      (#/setTarget: item self)
178      (#/setAction: item (@selector #/showGeneralPrefs:)))
179     ((#/isEqualToString: itemIdentifier #@"appearance")
180      (setf item (make-instance 'ns:ns-toolbar-item
181                                :with-item-identifier itemIdentifier))
182      (#/setLabel: item #@"Appearance")
183      (#/setImage: item (#/imageNamed: ns:ns-image #@"Appearance"))
184      (#/setTarget: item self)
185      (#/setAction: item (@selector #/showAppearancePrefs:)))
186     ((#/isEqualToString: itemIdentifier #@"documentation")
187      (setf item (make-instance 'ns:ns-toolbar-item
188                                :with-item-identifier itemIdentifier))
189      (#/setLabel: item #@"Documentation")
190      (#/setImage: item (#/imageNamed: ns:ns-image #@"Documentation"))
191      (#/setTarget: item self)
192      (#/setAction: item (@selector #/showDocumentationPrefs:)))
193     ((#/isEqualToString: itemIdentifier #@"encodings")
194      (setf item (make-instance 'ns:ns-toolbar-item
195                                :with-item-identifier itemIdentifier))
196      (#/setLabel: item #@"Encodings")
197      (#/setImage: item (#/imageNamed: ns:ns-image #@"Encodings"))
198      (#/setTarget: item self)
199      (#/setAction: item (@selector #/showEncodingsPrefs:))))
200    (#/autorelease item)))
201
202(objc:defmethod #/toolbarDefaultItemIdentifiers:
203                ((self preferences-window-controller) toolbar)
204  (declare (ignore toolbar))
205  (#/arrayWithObjects: ns:ns-array #@"general"
206                       #@"appearance"
207                       #@"documentation"
208                       #@"encodings"
209                       +null-ptr+)) ; don't even think about putting nil here
210
211(objc:defmethod #/toolbarAllowedItemIdentifiers:
212                ((self preferences-window-controller) toolbar)
213  (declare (ignore toolbar))
214  (#/arrayWithObjects: ns:ns-array #@"general"
215                       #@"appearance"
216                       #@"documentation"
217                       #@"encodings"
218                       +null-ptr+))
219
220(objc:defmethod #/toolbarSelectableItemIdentifiers:
221                ((self preferences-window-controller) toolbar)
222  (declare (ignore toolbar))
223  (#/arrayWithObjects: ns:ns-array #@"general"
224                       #@"appearance"
225                       #@"documentation"
226                       #@"encodings"
227                       +null-ptr+))
228
229(defun switch-content-view (window view)
230  (#/setContentView: window view)
231  (let* ((frame (#/frame window))
232         (min-size (#/minSize window))
233         (new-frame nil)
234         (content-rect (#/contentRectForFrameRect: window frame))
235         (dy (- (height view)
236                (ns-height content-rect))))
237    (decf (ns:ns-rect-y content-rect) dy)
238    (incf (ns:ns-rect-height content-rect) dy)
239    (setf (ns:ns-rect-width content-rect) (max (width view)
240                                               (ns:ns-size-width min-size)))
241    (setq new-frame (#/frameRectForContentRect: window content-rect))
242    (#/setFrame:display:animate: window new-frame t t)))
243
244;;; toolbar actions
245
246(objc:defmethod (#/showGeneralPrefs: :void) ((self preferences-window-controller)
247                                                sender)
248  (declare (ignore sender))
249  (#/setTitle: (#/window self) #@"General")
250  (switch-content-view (#/window self) (general-prefs self)))
251
252(objc:defmethod (#/showAppearancePrefs: :void) ((self preferences-window-controller)
253                                                sender)
254  (declare (ignore sender))
255  (#/setTitle: (#/window self) #@"Appearance")
256  (switch-content-view (#/window self) (appearance-prefs self)))
257
258(objc:defmethod (#/showDocumentationPrefs: :void) ((self preferences-window-controller)
259                                                sender)
260  (declare (ignore sender))
261  (#/setTitle: (#/window self) #@"Documentation")
262  (switch-content-view (#/window self) (documentation-prefs self)))
263
264(objc:defmethod (#/showEncodingsPrefs: :void) ((self preferences-window-controller)
265                                                sender)
266  (declare (ignore sender))
267  (#/setTitle: (#/window self) #@"Encodings")
268  (switch-content-view (#/window self) (encodings-prefs self)))
Note: See TracBrowser for help on using the repository browser.