source: branches/working-0711/ccl/cocoa-ide/preferences.lisp @ 7804

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

sync with trunk

File size: 11.0 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   (ccl-path-button :foreign-type :id :accessor ccl-path-button)
63   (hyperspec-path-button :foreign-type :id :accessor hyperspec-path-button)
64   (toolbar :foreign-type :id :accessor toolbar)
65   (general-prefs :foreign-type :id :accessor general-prefs)
66   (appearance-prefs :foreign-type :id :accessor appearance-prefs)
67   (documentation-prefs :foreign-type :id :accessor documentation-prefs)
68   (encodings-prefs :foreign-type :id :accessor encodings-prefs))
69  (:metaclass ns:+ns-object))
70
71(objc:defmethod #/init ((self preferences-window-controller))
72  (#/setValueTransformer:forName: ns:ns-value-transformer
73                                  (make-instance 'font-to-name-transformer)
74                                  #@"FontToName")
75
76  (#/initWithWindowNibName: self #@"preferences")
77  (#/addObserver:selector:name:object: (#/defaultCenter ns:ns-notification-center)
78                                       self
79                                       (@selector #/defaultsDidChange:)
80                                       #&NSUserDefaultsDidChangeNotification
81                                       (#/standardUserDefaults ns:ns-user-defaults))
82
83  self)
84
85(objc:defmethod (#/windowDidLoad :void) ((self preferences-window-controller))
86  (let* ((window (#/window self)))
87    (with-slots (toolbar) self
88      (setf toolbar (make-instance 'ns:ns-toolbar
89                                   :with-identifier #@"preferences-window-toolbar"))
90      (#/setDelegate: toolbar self)
91      (#/setSelectedItemIdentifier: toolbar #@"appearance")
92      (#/setToolbar: window toolbar)
93      ;; for some reason, setting this in IB doesn't work on Tiger/PPC32
94      (#/setShowsToolbarButton: window nil)
95      (#/release toolbar))
96    (#/showAppearancePrefs: self +null-ptr+)))
97 
98(objc:defmethod (#/showWindow: :void) ((self preferences-window-controller)
99                                       sender)
100  (#/center (#/window self))
101  (call-next-method sender))
102
103(objc:defmethod (#/defaultsDidChange: :void) ((self preferences-window-controller)
104                                              notification)
105  (declare (ignore notification))
106  (update-cocoa-defaults))
107
108(defconstant editor-font-button-tag 1)
109(defconstant listener-input-font-button-tag 2)
110(defconstant listener-output-font-button-tag 2)
111
112;;; Ugh.
113(defvar *listener-or-editor* nil)
114
115(objc:defmethod (#/showFontPanel: :void) ((self preferences-window-controller)
116                                         sender)
117  (let* ((tag (#/tag sender))
118         (font-manager (#/sharedFontManager ns:ns-font-manager))
119         (font nil)
120         (panel (#/window self)))
121    (ecase tag
122      (1
123       (setq font *editor-font*)
124       (setq *listener-or-editor* :editor))
125      (2
126       (setq font *listener-input-font*)
127       (setq *listener-or-editor* :listener-input))
128      (3
129       (setq font *listener-output-font*)
130       (setq *listener-or-editor* :listener-output)))
131    (#/makeFirstResponder: panel panel)
132    (#/setSelectedFont:isMultiple: font-manager font nil)
133    (#/orderFrontFontPanel: font-manager self)))
134
135;;; This message is sent to the first responder, which is why
136;;; we do the *listener-or-editor* thing.
137(objc:defmethod (#/changeFont: :void) ((self preferences-window-controller)
138                                            font-manager)
139  (let* ((defaults (#/standardUserDefaults ns:ns-user-defaults))
140         (data nil)
141         (font nil))
142    (ecase *listener-or-editor*
143      (:listener-input
144       (setq font (#/convertFont: font-manager *listener-input-font*))
145       (unless (%null-ptr-p font)
146         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
147         (#/setObject:forKey: defaults data #@"listenerInputFont")))
148      (:listener-output
149       (setq font (#/convertFont: font-manager *listener-output-font*))
150       (unless (%null-ptr-p font)
151         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
152         (#/setObject:forKey: defaults data #@"listenerOutputFont")))
153      (:editor
154       (setq font (#/convertFont: font-manager *editor-font*))
155       (unless (%null-ptr-p font)
156         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
157         (#/setObject:forKey: defaults data #@"editorFont"))))))
158
159(objc:defmethod (#/selectCCLDirectory: :void) ((self preferences-window-controller)
160                                          sender)
161  (declare (ignore sender))
162  (let* ((panel (#/openPanel ns:ns-open-panel))
163         (dc (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
164         (values (#/values dc))
165         (key #@"cclDirectory"))
166    (#/setAllowsMultipleSelection: panel nil)
167    (#/setCanChooseDirectories: panel t)
168    (#/setCanChooseFiles: panel nil)
169    (when (eql (#/runModalForDirectory:file:types: panel
170                                                   (#/valueForKey: values key)
171                                                   +null-ptr+
172                                                   +null-ptr+)
173               #$NSOKButton)
174      ;; #/stringByStandardizingPath seems to strip trailing slashes
175      (let* ((filename (#/stringByAppendingString:
176                        (#/stringByStandardizingPath
177                         (#/objectAtIndex: (#/filenames panel) 0))
178                        #@"/")))
179        (#/setValue:forKey: values filename key)))))
180
181
182;;; toolbar delegate methods
183
184(objc:defmethod #/toolbar:itemForItemIdentifier:willBeInsertedIntoToolbar:
185                ((self preferences-window-controller)
186                 toolbar itemIdentifier (flag :<BOOL>))
187  (declare (ignore toolbar))
188  (let ((item +null-ptr+))
189    (cond
190     ((#/isEqualToString: itemIdentifier #@"general")
191      (setf item (make-instance 'ns:ns-toolbar-item
192                                :with-item-identifier itemIdentifier))
193      (#/setLabel: item #@"General")
194      (#/setImage: item (#/imageNamed: ns:ns-image #@"General"))
195      (#/setTarget: item self)
196      (#/setAction: item (@selector #/showGeneralPrefs:)))
197     ((#/isEqualToString: itemIdentifier #@"appearance")
198      (setf item (make-instance 'ns:ns-toolbar-item
199                                :with-item-identifier itemIdentifier))
200      (#/setLabel: item #@"Appearance")
201      (#/setImage: item (#/imageNamed: ns:ns-image #@"Appearance"))
202      (#/setTarget: item self)
203      (#/setAction: item (@selector #/showAppearancePrefs:)))
204     ((#/isEqualToString: itemIdentifier #@"documentation")
205      (setf item (make-instance 'ns:ns-toolbar-item
206                                :with-item-identifier itemIdentifier))
207      (#/setLabel: item #@"Documentation")
208      (#/setImage: item (#/imageNamed: ns:ns-image #@"Documentation"))
209      (#/setTarget: item self)
210      (#/setAction: item (@selector #/showDocumentationPrefs:)))
211     ((#/isEqualToString: itemIdentifier #@"encodings")
212      (setf item (make-instance 'ns:ns-toolbar-item
213                                :with-item-identifier itemIdentifier))
214      (#/setLabel: item #@"Encodings")
215      (#/setImage: item (#/imageNamed: ns:ns-image #@"Encodings"))
216      (#/setTarget: item self)
217      (#/setAction: item (@selector #/showEncodingsPrefs:))))
218    (#/autorelease item)))
219
220(objc:defmethod #/toolbarDefaultItemIdentifiers:
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+)) ; don't even think about putting nil here
228
229(objc:defmethod #/toolbarAllowedItemIdentifiers:
230                ((self preferences-window-controller) toolbar)
231  (declare (ignore toolbar))
232  (#/arrayWithObjects: ns:ns-array #@"general"
233                       #@"appearance"
234                       #@"documentation"
235                       #@"encodings"
236                       +null-ptr+))
237
238(objc:defmethod #/toolbarSelectableItemIdentifiers:
239                ((self preferences-window-controller) toolbar)
240  (declare (ignore toolbar))
241  (#/arrayWithObjects: ns:ns-array #@"general"
242                       #@"appearance"
243                       #@"documentation"
244                       #@"encodings"
245                       +null-ptr+))
246
247(defun switch-content-view (window view)
248  (#/setContentView: window view)
249  (let* ((frame (#/frame window))
250         (min-size (#/minSize window))
251         (new-frame nil)
252         (content-rect (#/contentRectForFrameRect: window frame))
253         (dy (- (height view)
254                (ns-height content-rect))))
255    (decf (ns:ns-rect-y content-rect) dy)
256    (incf (ns:ns-rect-height content-rect) dy)
257    (setf (ns:ns-rect-width content-rect) (max (width view)
258                                               (ns:ns-size-width min-size)))
259    (setq new-frame (#/frameRectForContentRect: window content-rect))
260    (#/setFrame:display:animate: window new-frame t t)))
261
262;;; toolbar actions
263
264(objc:defmethod (#/showGeneralPrefs: :void) ((self preferences-window-controller)
265                                                sender)
266  (declare (ignore sender))
267  (#/setTitle: (#/window self) #@"General")
268  (switch-content-view (#/window self) (general-prefs self)))
269
270(objc:defmethod (#/showAppearancePrefs: :void) ((self preferences-window-controller)
271                                                sender)
272  (declare (ignore sender))
273  (#/setTitle: (#/window self) #@"Appearance")
274  (switch-content-view (#/window self) (appearance-prefs self)))
275
276(objc:defmethod (#/showDocumentationPrefs: :void) ((self preferences-window-controller)
277                                                sender)
278  (declare (ignore sender))
279  (#/setTitle: (#/window self) #@"Documentation")
280  (switch-content-view (#/window self) (documentation-prefs self)))
281
282(objc:defmethod (#/showEncodingsPrefs: :void) ((self preferences-window-controller)
283                                                sender)
284  (declare (ignore sender))
285  (#/setTitle: (#/window self) #@"Encodings")
286  (switch-content-view (#/window self) (encodings-prefs self)))
Note: See TracBrowser for help on using the repository browser.