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

Last change on this file since 15188 was 15188, checked in by rme, 10 years ago

Drop the swank listener feature.

We may want to add something like this back in later, but
based on our own swink protocol.

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-keyed-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  ((appearance-prefs :foreign-type :id :accessor appearance-prefs)
60   (documentation-prefs :foreign-type :id :accessor documentation-prefs)
61   (editor-tab-view-item :foreign-type :id :accessor editor-tab-view-item)
62   (encodings-prefs :foreign-type :id :accessor encodings-prefs)
63   (general-prefs :foreign-type :id :accessor general-prefs)
64   (hyperspec-path-button :foreign-type :id :accessor hyperspec-path-button)
65   (listener-tab-view-item :foreign-type :id :accessor listener-tab-view-item)
66   (tab-view :foreign-type :id :accessor tab-view)
67   (toolbar :foreign-type :id :accessor toolbar))
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-keyed-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-keyed-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-keyed-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.