source: branches/1.7-appstore/source/cocoa-ide/preferences.lisp @ 15070

Last change on this file since 15070 was 15070, checked in by rme, 8 years ago

Remove some unused/experimental/broken IDE stuff.

File size: 9.4 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    (#/autorelease item)))
188
189(objc:defmethod #/toolbarDefaultItemIdentifiers:
190                ((self preferences-window-controller) toolbar)
191  (declare (ignore toolbar))
192  (#/arrayWithObjects: ns:ns-array #@"general"
193                       #@"appearance"
194                       #@"documentation"
195                       +null-ptr+)) ; don't even think about putting nil here
196
197(objc:defmethod #/toolbarAllowedItemIdentifiers:
198                ((self preferences-window-controller) toolbar)
199  (declare (ignore toolbar))
200  (#/arrayWithObjects: ns:ns-array #@"general"
201                       #@"appearance"
202                       #@"documentation"
203                       +null-ptr+))
204
205(objc:defmethod #/toolbarSelectableItemIdentifiers:
206                ((self preferences-window-controller) toolbar)
207  (declare (ignore toolbar))
208  (#/arrayWithObjects: ns:ns-array #@"general"
209                       #@"appearance"
210                       #@"documentation"
211                       +null-ptr+))
212
213(defun switch-content-view (window view)
214  (#/setContentView: window view)
215  (let* ((frame (#/frame window))
216         (min-size (#/minSize window))
217         (new-frame nil)
218         (content-rect (#/contentRectForFrameRect: window frame))
219         (dy (- (height view)
220                (ns-height content-rect))))
221    (decf (ns:ns-rect-y content-rect) dy)
222    (incf (ns:ns-rect-height content-rect) dy)
223    (setf (ns:ns-rect-width content-rect) (max (width view)
224                                               (ns:ns-size-width min-size)))
225    (setq new-frame (#/frameRectForContentRect: window content-rect))
226    (#/setFrame:display:animate: window new-frame t t)))
227
228;;; toolbar actions
229
230(objc:defmethod (#/showGeneralPrefs: :void) ((self preferences-window-controller)
231                                                sender)
232  (declare (ignore sender))
233  (#/setTitle: (#/window self) #@"General")
234  (switch-content-view (#/window self) (general-prefs self)))
235
236(objc:defmethod (#/showAppearancePrefs: :void) ((self preferences-window-controller)
237                                                sender)
238  (declare (ignore sender))
239  (#/setTitle: (#/window self) #@"Appearance")
240  (switch-content-view (#/window self) (appearance-prefs self)))
241
242(objc:defmethod (#/showDocumentationPrefs: :void) ((self preferences-window-controller)
243                                                sender)
244  (declare (ignore sender))
245  (#/setTitle: (#/window self) #@"Documentation")
246  (switch-content-view (#/window self) (documentation-prefs self)))
Note: See TracBrowser for help on using the repository browser.