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

Last change on this file since 13448 was 13448, checked in by palter, 10 years ago

Switch to NSKeyedArchiver/NSKeyedUnarchiver and enable
encoding/decoding of colors and fonts under Cocotron

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