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

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

Get rid of the now-useless UI for setting the CCL directory as a
Cocoa preference (ticket:332).

File size: 10.1 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;;; This message is sent to the first responder, which is why
135;;; we do the *listener-or-editor* thing.
136(objc:defmethod (#/changeFont: :void) ((self preferences-window-controller)
137                                            font-manager)
138  (let* ((defaults (#/standardUserDefaults ns:ns-user-defaults))
139         (data nil)
140         (font nil))
141    (ecase *listener-or-editor*
142      (:listener-input
143       (setq font (#/convertFont: font-manager *listener-input-font*))
144       (unless (%null-ptr-p font)
145         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
146         (#/setObject:forKey: defaults data #@"listenerInputFont")))
147      (:listener-output
148       (setq font (#/convertFont: font-manager *listener-output-font*))
149       (unless (%null-ptr-p font)
150         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
151         (#/setObject:forKey: defaults data #@"listenerOutputFont")))
152      (:editor
153       (setq font (#/convertFont: font-manager *editor-font*))
154       (unless (%null-ptr-p font)
155         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
156         (#/setObject:forKey: defaults data #@"editorFont"))))))
157
158;;; toolbar delegate methods
159
160(objc:defmethod #/toolbar:itemForItemIdentifier:willBeInsertedIntoToolbar:
161                ((self preferences-window-controller)
162                 toolbar itemIdentifier (flag :<BOOL>))
163  (declare (ignore toolbar))
164  (let ((item +null-ptr+))
165    (cond
166     ((#/isEqualToString: itemIdentifier #@"general")
167      (setf item (make-instance 'ns:ns-toolbar-item
168                                :with-item-identifier itemIdentifier))
169      (#/setLabel: item #@"General")
170      (#/setImage: item (#/imageNamed: ns:ns-image #@"General"))
171      (#/setTarget: item self)
172      (#/setAction: item (@selector #/showGeneralPrefs:)))
173     ((#/isEqualToString: itemIdentifier #@"appearance")
174      (setf item (make-instance 'ns:ns-toolbar-item
175                                :with-item-identifier itemIdentifier))
176      (#/setLabel: item #@"Appearance")
177      (#/setImage: item (#/imageNamed: ns:ns-image #@"Appearance"))
178      (#/setTarget: item self)
179      (#/setAction: item (@selector #/showAppearancePrefs:)))
180     ((#/isEqualToString: itemIdentifier #@"documentation")
181      (setf item (make-instance 'ns:ns-toolbar-item
182                                :with-item-identifier itemIdentifier))
183      (#/setLabel: item #@"Documentation")
184      (#/setImage: item (#/imageNamed: ns:ns-image #@"Documentation"))
185      (#/setTarget: item self)
186      (#/setAction: item (@selector #/showDocumentationPrefs:)))
187     ((#/isEqualToString: itemIdentifier #@"encodings")
188      (setf item (make-instance 'ns:ns-toolbar-item
189                                :with-item-identifier itemIdentifier))
190      (#/setLabel: item #@"Encodings")
191      (#/setImage: item (#/imageNamed: ns:ns-image #@"Encodings"))
192      (#/setTarget: item self)
193      (#/setAction: item (@selector #/showEncodingsPrefs:))))
194    (#/autorelease item)))
195
196(objc:defmethod #/toolbarDefaultItemIdentifiers:
197                ((self preferences-window-controller) toolbar)
198  (declare (ignore toolbar))
199  (#/arrayWithObjects: ns:ns-array #@"general"
200                       #@"appearance"
201                       #@"documentation"
202                       #@"encodings"
203                       +null-ptr+)) ; don't even think about putting nil here
204
205(objc:defmethod #/toolbarAllowedItemIdentifiers:
206                ((self preferences-window-controller) toolbar)
207  (declare (ignore toolbar))
208  (#/arrayWithObjects: ns:ns-array #@"general"
209                       #@"appearance"
210                       #@"documentation"
211                       #@"encodings"
212                       +null-ptr+))
213
214(objc:defmethod #/toolbarSelectableItemIdentifiers:
215                ((self preferences-window-controller) toolbar)
216  (declare (ignore toolbar))
217  (#/arrayWithObjects: ns:ns-array #@"general"
218                       #@"appearance"
219                       #@"documentation"
220                       #@"encodings"
221                       +null-ptr+))
222
223(defun switch-content-view (window view)
224  (#/setContentView: window view)
225  (let* ((frame (#/frame window))
226         (min-size (#/minSize window))
227         (new-frame nil)
228         (content-rect (#/contentRectForFrameRect: window frame))
229         (dy (- (height view)
230                (ns-height content-rect))))
231    (decf (ns:ns-rect-y content-rect) dy)
232    (incf (ns:ns-rect-height content-rect) dy)
233    (setf (ns:ns-rect-width content-rect) (max (width view)
234                                               (ns:ns-size-width min-size)))
235    (setq new-frame (#/frameRectForContentRect: window content-rect))
236    (#/setFrame:display:animate: window new-frame t t)))
237
238;;; toolbar actions
239
240(objc:defmethod (#/showGeneralPrefs: :void) ((self preferences-window-controller)
241                                                sender)
242  (declare (ignore sender))
243  (#/setTitle: (#/window self) #@"General")
244  (switch-content-view (#/window self) (general-prefs self)))
245
246(objc:defmethod (#/showAppearancePrefs: :void) ((self preferences-window-controller)
247                                                sender)
248  (declare (ignore sender))
249  (#/setTitle: (#/window self) #@"Appearance")
250  (switch-content-view (#/window self) (appearance-prefs self)))
251
252(objc:defmethod (#/showDocumentationPrefs: :void) ((self preferences-window-controller)
253                                                sender)
254  (declare (ignore sender))
255  (#/setTitle: (#/window self) #@"Documentation")
256  (switch-content-view (#/window self) (documentation-prefs self)))
257
258(objc:defmethod (#/showEncodingsPrefs: :void) ((self preferences-window-controller)
259                                                sender)
260  (declare (ignore sender))
261  (#/setTitle: (#/window self) #@"Encodings")
262  (switch-content-view (#/window self) (encodings-prefs self)))
Note: See TracBrowser for help on using the repository browser.