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

Last change on this file since 12117 was 12117, checked in by mikel, 11 years ago

Added more error checking around the construction of string values for the wank port and wire-protocol version displays

File size: 11.2 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  ((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   (swank-port-field :foreign-type :id :accessor swank-port-field)
67   (swank-protocol-label :foreign-type :id :accessor swank-protocol-label)
68   (tab-view :foreign-type :id :accessor tab-view)
69   (toolbar :foreign-type :id :accessor toolbar))
70  (:metaclass ns:+ns-object))
71
72(objc:defmethod #/init ((self preferences-window-controller))
73  (#/setValueTransformer:forName: ns:ns-value-transformer
74                                  (make-instance 'font-to-name-transformer)
75                                  #@"FontToName")
76
77  (#/initWithWindowNibName: self #@"preferences")
78  (#/addObserver:selector:name:object: (#/defaultCenter ns:ns-notification-center)
79                                       self
80                                       (@selector #/defaultsDidChange:)
81                                       #&NSUserDefaultsDidChangeNotification
82                                       (#/standardUserDefaults ns:ns-user-defaults))
83
84  self)
85
86(eval-when (:compile-toplevel :load-toplevel :execute)
87    (require :swank))
88
89(objc:defmethod (#/windowDidLoad :void) ((self preferences-window-controller))
90  (let* ((window (#/window self))
91         (swank-protocol-version swank::*swank-wire-protocol-version*)
92         (protocol-label (swank-protocol-label self))
93         (port-field (swank-port-field self))
94         (swank-port (or (preference-swank-port) *default-gui-swank-port*)))
95    (with-slots (toolbar) self
96      (setf toolbar (make-instance 'ns:ns-toolbar
97                                   :with-identifier #@"preferences-window-toolbar"))
98      (#/setDelegate: toolbar self)
99      (#/setSelectedItemIdentifier: toolbar #@"appearance")
100      (#/setToolbar: window toolbar)
101      ;; for some reason, setting this in IB doesn't work on Tiger/PPC32
102      (#/setShowsToolbarButton: window nil)
103      (#/release toolbar))
104    (ccl::with-autoreleased-nsstring (label-str (format nil "Swank protocol version: ~A" (or swank-protocol-version
105                                                                                             "unknown")))
106      (#/setStringValue: protocol-label label-str))
107    (ccl::with-autoreleased-nsstring (port-string (format nil "~A" (or swank-port "")))
108      (#/setStringValue: port-field port-string))
109    (#/showAppearancePrefs: self +null-ptr+)))
110 
111(objc:defmethod (#/showWindow: :void) ((self preferences-window-controller)
112                                       sender)
113  (#/center (#/window self))
114  (call-next-method sender))
115
116(objc:defmethod (#/defaultsDidChange: :void) ((self preferences-window-controller)
117                                              notification)
118  (declare (ignore notification))
119  (update-cocoa-defaults))
120
121(defconstant editor-font-button-tag 1)
122(defconstant listener-input-font-button-tag 2)
123(defconstant listener-output-font-button-tag 2)
124
125;;; Ugh.
126(defvar *listener-or-editor* nil)
127
128(objc:defmethod (#/showFontPanel: :void) ((self preferences-window-controller)
129                                         sender)
130  (let* ((tag (#/tag sender))
131         (font-manager (#/sharedFontManager ns:ns-font-manager))
132         (font nil)
133         (panel (#/window self)))
134    (ecase tag
135      (1
136       (setq font *editor-font*)
137       (setq *listener-or-editor* :editor))
138      (2
139       (setq font *listener-input-font*)
140       (setq *listener-or-editor* :listener-input))
141      (3
142       (setq font *listener-output-font*)
143       (setq *listener-or-editor* :listener-output)))
144    (#/makeFirstResponder: panel panel)
145    (#/setSelectedFont:isMultiple: font-manager font nil)
146    (#/orderFrontFontPanel: font-manager self)))
147
148(objc:defmethod (#/startSwankServer: :void) ((self preferences-window-controller)
149                                         sender)
150  (unless (or *ccl-swank-active-p* 
151              (try-starting-swank :force t))
152    (alert-window :message "Unable to start the Swank server.")))
153
154;;; This message is sent to the first responder, which is why
155;;; we do the *listener-or-editor* thing.
156(objc:defmethod (#/changeFont: :void) ((self preferences-window-controller)
157                                            font-manager)
158  (let* ((defaults (#/standardUserDefaults ns:ns-user-defaults))
159         (data nil)
160         (font nil))
161    (ecase *listener-or-editor*
162      (:listener-input
163       (setq font (#/convertFont: font-manager *listener-input-font*))
164       (unless (%null-ptr-p font)
165         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
166         (#/setObject:forKey: defaults data #@"listenerInputFont")))
167      (:listener-output
168       (setq font (#/convertFont: font-manager *listener-output-font*))
169       (unless (%null-ptr-p font)
170         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
171         (#/setObject:forKey: defaults data #@"listenerOutputFont")))
172      (:editor
173       (setq font (#/convertFont: font-manager *editor-font*))
174       (unless (%null-ptr-p font)
175         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
176         (#/setObject:forKey: defaults data #@"editorFont"))))))
177
178;;; toolbar delegate methods
179
180(objc:defmethod #/toolbar:itemForItemIdentifier:willBeInsertedIntoToolbar:
181                ((self preferences-window-controller)
182                 toolbar itemIdentifier (flag :<BOOL>))
183  (declare (ignore toolbar))
184  (let ((item +null-ptr+))
185    (cond
186     ((#/isEqualToString: itemIdentifier #@"general")
187      (setf item (make-instance 'ns:ns-toolbar-item
188                                :with-item-identifier itemIdentifier))
189      (#/setLabel: item #@"General")
190      (#/setImage: item (#/imageNamed: ns:ns-image #@"General"))
191      (#/setTarget: item self)
192      (#/setAction: item (@selector #/showGeneralPrefs:)))
193     ((#/isEqualToString: itemIdentifier #@"appearance")
194      (setf item (make-instance 'ns:ns-toolbar-item
195                                :with-item-identifier itemIdentifier))
196      (#/setLabel: item #@"Appearance")
197      (#/setImage: item (#/imageNamed: ns:ns-image #@"Appearance"))
198      (#/setTarget: item self)
199      (#/setAction: item (@selector #/showAppearancePrefs:)))
200     ((#/isEqualToString: itemIdentifier #@"documentation")
201      (setf item (make-instance 'ns:ns-toolbar-item
202                                :with-item-identifier itemIdentifier))
203      (#/setLabel: item #@"Documentation")
204      (#/setImage: item (#/imageNamed: ns:ns-image #@"Documentation"))
205      (#/setTarget: item self)
206      (#/setAction: item (@selector #/showDocumentationPrefs:)))
207     ((#/isEqualToString: itemIdentifier #@"encodings")
208      (setf item (make-instance 'ns:ns-toolbar-item
209                                :with-item-identifier itemIdentifier))
210      (#/setLabel: item #@"Encodings")
211      (#/setImage: item (#/imageNamed: ns:ns-image #@"Encodings"))
212      (#/setTarget: item self)
213      (#/setAction: item (@selector #/showEncodingsPrefs:))))
214    (#/autorelease item)))
215
216(objc:defmethod #/toolbarDefaultItemIdentifiers:
217                ((self preferences-window-controller) toolbar)
218  (declare (ignore toolbar))
219  (#/arrayWithObjects: ns:ns-array #@"general"
220                       #@"appearance"
221                       #@"documentation"
222                       #@"encodings"
223                       +null-ptr+)) ; don't even think about putting nil here
224
225(objc:defmethod #/toolbarAllowedItemIdentifiers:
226                ((self preferences-window-controller) toolbar)
227  (declare (ignore toolbar))
228  (#/arrayWithObjects: ns:ns-array #@"general"
229                       #@"appearance"
230                       #@"documentation"
231                       #@"encodings"
232                       +null-ptr+))
233
234(objc:defmethod #/toolbarSelectableItemIdentifiers:
235                ((self preferences-window-controller) toolbar)
236  (declare (ignore toolbar))
237  (#/arrayWithObjects: ns:ns-array #@"general"
238                       #@"appearance"
239                       #@"documentation"
240                       #@"encodings"
241                       +null-ptr+))
242
243(defun switch-content-view (window view)
244  (#/setContentView: window view)
245  (let* ((frame (#/frame window))
246         (min-size (#/minSize window))
247         (new-frame nil)
248         (content-rect (#/contentRectForFrameRect: window frame))
249         (dy (- (height view)
250                (ns-height content-rect))))
251    (decf (ns:ns-rect-y content-rect) dy)
252    (incf (ns:ns-rect-height content-rect) dy)
253    (setf (ns:ns-rect-width content-rect) (max (width view)
254                                               (ns:ns-size-width min-size)))
255    (setq new-frame (#/frameRectForContentRect: window content-rect))
256    (#/setFrame:display:animate: window new-frame t t)))
257
258;;; toolbar actions
259
260(objc:defmethod (#/showGeneralPrefs: :void) ((self preferences-window-controller)
261                                                sender)
262  (declare (ignore sender))
263  (#/setTitle: (#/window self) #@"General")
264  (switch-content-view (#/window self) (general-prefs self)))
265
266(objc:defmethod (#/showAppearancePrefs: :void) ((self preferences-window-controller)
267                                                sender)
268  (declare (ignore sender))
269  (#/setTitle: (#/window self) #@"Appearance")
270  (switch-content-view (#/window self) (appearance-prefs self)))
271
272(objc:defmethod (#/showDocumentationPrefs: :void) ((self preferences-window-controller)
273                                                sender)
274  (declare (ignore sender))
275  (#/setTitle: (#/window self) #@"Documentation")
276  (switch-content-view (#/window self) (documentation-prefs self)))
277
278(objc:defmethod (#/showEncodingsPrefs: :void) ((self preferences-window-controller)
279                                                sender)
280  (declare (ignore sender))
281  (#/setTitle: (#/window self) #@"Encodings")
282  (switch-content-view (#/window self) (encodings-prefs self)))
Note: See TracBrowser for help on using the repository browser.