source: branches/1.9-appstore/source/cocoa-ide/preferences.lisp @ 16155

Last change on this file since 16155 was 16155, checked in by rme, 7 years ago

Modifications for Mac App Store pacakging.

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   (general-prefs :foreign-type :id :accessor general-prefs)
63   (hyperspec-path-button :foreign-type :id :accessor hyperspec-path-button)
64   (listener-tab-view-item :foreign-type :id :accessor listener-tab-view-item)
65   (tab-view :foreign-type :id :accessor tab-view)
66   (toolbar :foreign-type :id :accessor toolbar))
67  (:metaclass ns:+ns-object))
68
69(objc:defmethod #/init ((self preferences-window-controller))
70  (#/setValueTransformer:forName: ns:ns-value-transformer
71                                  (make-instance 'font-to-name-transformer)
72                                  #@"FontToName")
73
74  (#/initWithWindowNibName: self #@"preferences")
75  (#/addObserver:selector:name:object: (#/defaultCenter ns:ns-notification-center)
76                                       self
77                                       (@selector #/defaultsDidChange:)
78                                       #&NSUserDefaultsDidChangeNotification
79                                       (#/standardUserDefaults ns:ns-user-defaults))
80
81  self)
82
83(objc:defmethod (#/windowDidLoad :void) ((self preferences-window-controller))
84  (let* ((window (#/window self)))
85    (with-slots (toolbar) self
86      (setf toolbar (make-instance 'ns:ns-toolbar
87                                   :with-identifier #@"preferences-window-toolbar"))
88      (#/setDelegate: toolbar self)
89      (#/setSelectedItemIdentifier: toolbar #@"appearance")
90      (#/setToolbar: window toolbar)
91      ;; for some reason, setting this in IB doesn't work on Tiger/PPC32
92      (#/setShowsToolbarButton: window nil)
93      (#/release toolbar))
94    (#/showAppearancePrefs: self +null-ptr+)))
95 
96(objc:defmethod (#/showWindow: :void) ((self preferences-window-controller)
97                                       sender)
98  (#/center (#/window self))
99  (call-next-method sender))
100
101(objc:defmethod (#/defaultsDidChange: :void) ((self preferences-window-controller)
102                                              notification)
103  (declare (ignore notification))
104  (update-cocoa-defaults))
105
106(defconstant editor-font-button-tag 1)
107(defconstant listener-input-font-button-tag 2)
108(defconstant listener-output-font-button-tag 2)
109
110;;; Ugh.
111(defvar *listener-or-editor* nil)
112
113(objc:defmethod (#/showFontPanel: :void) ((self preferences-window-controller)
114                                         sender)
115  (let* ((tag (#/tag sender))
116         (font-manager (#/sharedFontManager ns:ns-font-manager))
117         (font nil)
118         (panel (#/window self)))
119    (ecase tag
120      (1
121       (setq font *editor-font*)
122       (setq *listener-or-editor* :editor))
123      (2
124       (setq font *listener-input-font*)
125       (setq *listener-or-editor* :listener-input))
126      (3
127       (setq font *listener-output-font*)
128       (setq *listener-or-editor* :listener-output)))
129    (#/makeFirstResponder: panel panel)
130    (#/setSelectedFont:isMultiple: font-manager font nil)
131    (#/orderFrontFontPanel: font-manager self)))
132
133;;; This message is sent to the first responder, which is why
134;;; we do the *listener-or-editor* thing.
135(objc:defmethod (#/changeFont: :void) ((self preferences-window-controller)
136                                            font-manager)
137  (let* ((defaults (#/standardUserDefaults ns:ns-user-defaults))
138         (data nil)
139         (font nil))
140    (ecase *listener-or-editor*
141      (:listener-input
142       (setq font (#/convertFont: font-manager *listener-input-font*))
143       (unless (%null-ptr-p font)
144         (setq data (#/archivedDataWithRootObject: ns:ns-keyed-archiver font))
145         (#/setObject:forKey: defaults data #@"listenerInputFont")))
146      (:listener-output
147       (setq font (#/convertFont: font-manager *listener-output-font*))
148       (unless (%null-ptr-p font)
149         (setq data (#/archivedDataWithRootObject: ns:ns-keyed-archiver font))
150         (#/setObject:forKey: defaults data #@"listenerOutputFont")))
151      (:editor
152       (setq font (#/convertFont: font-manager *editor-font*))
153       (unless (%null-ptr-p font)
154         (setq data (#/archivedDataWithRootObject: ns:ns-keyed-archiver font))
155         (#/setObject:forKey: defaults data #@"editorFont"))))))
156
157;;; toolbar delegate methods
158
159(objc:defmethod #/toolbar:itemForItemIdentifier:willBeInsertedIntoToolbar:
160                ((self preferences-window-controller)
161                 toolbar itemIdentifier (flag :<BOOL>))
162  (declare (ignore toolbar))
163  (let ((item +null-ptr+))
164    (cond
165     ((#/isEqualToString: itemIdentifier #@"general")
166      (setf item (make-instance 'ns:ns-toolbar-item
167                                :with-item-identifier itemIdentifier))
168      (#/setLabel: item #@"General")
169      (#/setImage: item (#/imageNamed: ns:ns-image
170                                       #&NSImageNamePreferencesGeneral))
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.