source: trunk/ccl/cocoa-ide/preferences.lisp @ 7698

Last change on this file since 7698 was 7698, checked in by gz, 14 years ago

A new package and a reorg:

I put all the cocoa-ide files (except for a greatly stripped-down
cocoa.lisp and cocoa-application.lisp) in a new package named "GUI".

The package is defined in defsystem.lisp, which also defines a
function to load all the files explicitly, putting the fasls in
cocoa-ide;fasls; I stripped out all pretense that the files can or
should be loaded individually. Also, it is no longer necessary or
appropriate to compile hemlock separately, as it now compiles as
needed as part of the normal loading sequence. (Over time I am hoping
to get hemlock more and more integrated into the IDE, and having to
maintain it as if it still were a separate package is an unnecessary
burden).

Updated the README file appropriately.

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.