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

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

added a bunch of the server-side request-handling code for the swank-listener.

switched the swank loader back on (but made sure swank isn't loaded unless the user default says it should be)

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  (declare (ignore sender))
151  (unless (or *ccl-swank-active-p* 
152              (try-starting-swank :force t))
153    (alert-window :message "Unable to start the Swank server.")))
154
155;;; This message is sent to the first responder, which is why
156;;; we do the *listener-or-editor* thing.
157(objc:defmethod (#/changeFont: :void) ((self preferences-window-controller)
158                                            font-manager)
159  (let* ((defaults (#/standardUserDefaults ns:ns-user-defaults))
160         (data nil)
161         (font nil))
162    (ecase *listener-or-editor*
163      (:listener-input
164       (setq font (#/convertFont: font-manager *listener-input-font*))
165       (unless (%null-ptr-p font)
166         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
167         (#/setObject:forKey: defaults data #@"listenerInputFont")))
168      (:listener-output
169       (setq font (#/convertFont: font-manager *listener-output-font*))
170       (unless (%null-ptr-p font)
171         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
172         (#/setObject:forKey: defaults data #@"listenerOutputFont")))
173      (:editor
174       (setq font (#/convertFont: font-manager *editor-font*))
175       (unless (%null-ptr-p font)
176         (setq data (#/archivedDataWithRootObject: ns:ns-archiver font))
177         (#/setObject:forKey: defaults data #@"editorFont"))))))
178
179;;; toolbar delegate methods
180
181(objc:defmethod #/toolbar:itemForItemIdentifier:willBeInsertedIntoToolbar:
182                ((self preferences-window-controller)
183                 toolbar itemIdentifier (flag :<BOOL>))
184  (declare (ignore toolbar))
185  (let ((item +null-ptr+))
186    (cond
187     ((#/isEqualToString: itemIdentifier #@"general")
188      (setf item (make-instance 'ns:ns-toolbar-item
189                                :with-item-identifier itemIdentifier))
190      (#/setLabel: item #@"General")
191      (#/setImage: item (#/imageNamed: ns:ns-image #@"General"))
192      (#/setTarget: item self)
193      (#/setAction: item (@selector #/showGeneralPrefs:)))
194     ((#/isEqualToString: itemIdentifier #@"appearance")
195      (setf item (make-instance 'ns:ns-toolbar-item
196                                :with-item-identifier itemIdentifier))
197      (#/setLabel: item #@"Appearance")
198      (#/setImage: item (#/imageNamed: ns:ns-image #@"Appearance"))
199      (#/setTarget: item self)
200      (#/setAction: item (@selector #/showAppearancePrefs:)))
201     ((#/isEqualToString: itemIdentifier #@"documentation")
202      (setf item (make-instance 'ns:ns-toolbar-item
203                                :with-item-identifier itemIdentifier))
204      (#/setLabel: item #@"Documentation")
205      (#/setImage: item (#/imageNamed: ns:ns-image #@"Documentation"))
206      (#/setTarget: item self)
207      (#/setAction: item (@selector #/showDocumentationPrefs:)))
208     ((#/isEqualToString: itemIdentifier #@"encodings")
209      (setf item (make-instance 'ns:ns-toolbar-item
210                                :with-item-identifier itemIdentifier))
211      (#/setLabel: item #@"Encodings")
212      (#/setImage: item (#/imageNamed: ns:ns-image #@"Encodings"))
213      (#/setTarget: item self)
214      (#/setAction: item (@selector #/showEncodingsPrefs:))))
215    (#/autorelease item)))
216
217(objc:defmethod #/toolbarDefaultItemIdentifiers:
218                ((self preferences-window-controller) toolbar)
219  (declare (ignore toolbar))
220  (#/arrayWithObjects: ns:ns-array #@"general"
221                       #@"appearance"
222                       #@"documentation"
223                       #@"encodings"
224                       +null-ptr+)) ; don't even think about putting nil here
225
226(objc:defmethod #/toolbarAllowedItemIdentifiers:
227                ((self preferences-window-controller) toolbar)
228  (declare (ignore toolbar))
229  (#/arrayWithObjects: ns:ns-array #@"general"
230                       #@"appearance"
231                       #@"documentation"
232                       #@"encodings"
233                       +null-ptr+))
234
235(objc:defmethod #/toolbarSelectableItemIdentifiers:
236                ((self preferences-window-controller) toolbar)
237  (declare (ignore toolbar))
238  (#/arrayWithObjects: ns:ns-array #@"general"
239                       #@"appearance"
240                       #@"documentation"
241                       #@"encodings"
242                       +null-ptr+))
243
244(defun switch-content-view (window view)
245  (#/setContentView: window view)
246  (let* ((frame (#/frame window))
247         (min-size (#/minSize window))
248         (new-frame nil)
249         (content-rect (#/contentRectForFrameRect: window frame))
250         (dy (- (height view)
251                (ns-height content-rect))))
252    (decf (ns:ns-rect-y content-rect) dy)
253    (incf (ns:ns-rect-height content-rect) dy)
254    (setf (ns:ns-rect-width content-rect) (max (width view)
255                                               (ns:ns-size-width min-size)))
256    (setq new-frame (#/frameRectForContentRect: window content-rect))
257    (#/setFrame:display:animate: window new-frame t t)))
258
259;;; toolbar actions
260
261(objc:defmethod (#/showGeneralPrefs: :void) ((self preferences-window-controller)
262                                                sender)
263  (declare (ignore sender))
264  (#/setTitle: (#/window self) #@"General")
265  (switch-content-view (#/window self) (general-prefs self)))
266
267(objc:defmethod (#/showAppearancePrefs: :void) ((self preferences-window-controller)
268                                                sender)
269  (declare (ignore sender))
270  (#/setTitle: (#/window self) #@"Appearance")
271  (switch-content-view (#/window self) (appearance-prefs self)))
272
273(objc:defmethod (#/showDocumentationPrefs: :void) ((self preferences-window-controller)
274                                                sender)
275  (declare (ignore sender))
276  (#/setTitle: (#/window self) #@"Documentation")
277  (switch-content-view (#/window self) (documentation-prefs self)))
278
279(objc:defmethod (#/showEncodingsPrefs: :void) ((self preferences-window-controller)
280                                                sender)
281  (declare (ignore sender))
282  (#/setTitle: (#/window self) #@"Encodings")
283  (switch-content-view (#/window self) (encodings-prefs self)))
Note: See TracBrowser for help on using the repository browser.