source: trunk/source/cocoa-ide/cocoa-prefs.lisp @ 11466

Last change on this file since 11466 was 11466, checked in by rme, 11 years ago

Get rid of the now-useless UI for setting the CCL directory as a
Cocoa preference (ticket:332).

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.3 KB
Line 
1;;;-*-Mode: LISP; Package: GUI -*-
2;;;
3;;;   Copyright (C) 2004 Clozure Associates
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17(in-package "GUI")
18
19(defloadvar *lisp-preferences-panel* nil)
20
21(defclass lisp-preferences-panel (ns:ns-panel)
22    ()
23  (:metaclass ns:+ns-object))
24
25(defclass font-name-transformer (ns:ns-value-transformer)
26    ()
27  (:metaclass ns:+ns-object))
28
29(objc:defmethod #/transformedNameClass ((self +font-name-transformer))
30  ns:ns-string)
31
32
33(objc:defmethod (#/allowsReverseTransformation :<BOOL>)
34    ((self +font-name-transformer))
35  nil)
36
37(objc:defmethod #/transformValue ((self font-name-transformer) value)
38  ;; Is there any better way of doing this that doesn't involve
39  ;; making a font ?
40  (#/displayName (make-instance ns:ns-font
41                                :with-name value
42                                :size (cgfloat 12.0))))
43
44
45
46(defclass lisp-preferences-window-controller (ns:ns-window-controller)
47    ()
48  (:metaclass ns:+ns-object))
49(declaim (special lisp-preferences-window-controller))
50
51(objc:defmethod (#/fontPanelForDefaultFont: :void)
52    ((self lisp-preferences-window-controller) sender)
53  (let* ((fm (#/sharedFontManager ns:ns-font-manager)))
54    (#/setSelectedFont:isMultiple: fm (default-font) nil)
55    (#/setEnabled: fm t)
56    (#/setTarget: fm self)
57    (#/setAction: fm (@selector #/changeDefaultFont:)))
58  (#/orderFrontFontPanel: *NSApp* sender))
59
60
61(objc:defmethod (#/fontPanelForModelineFont: :void)
62                ((self lisp-preferences-window-controller) sender)
63  (declare (special *modeline-font-name* *modeline-font-size*))
64  (let* ((fm (#/sharedFontManager ns:ns-font-manager)))
65    (#/setSelectedFont:isMultiple: fm (default-font
66                                          :name *modeline-font-name*
67                                        :size *modeline-font-size*)
68                                   nil)
69    (#/setTarget: fm self)
70    (#/setAction: fm (@selector #/changeModelineFont:)))
71  (#/orderFrontFontPanel: *NSApp* sender))
72
73
74(objc:defmethod (#/changeDefaultFont: :void) ((self lisp-preferences-window-controller) sender)
75  (let* ((f (#/convertFont: sender (default-font))))
76    (when (is-fixed-pitch-font f)
77      (let* ((values (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))))
78        (#/setValue:forKey: values (#/fontName f) #@"defaultFontName")
79        (#/setValue:forKey: values (#/stringWithFormat: ns:ns-string #@"%u" (round (#/pointSize f))) #@"defaultFontSize")))))
80
81(objc:defmethod (#/changeModelineFont: :void) ((self lisp-preferences-window-controller) sender)
82  (declare (special *modeline-font-name* *modeline-font-size*))
83  (let* ((f (#/convertFont: sender (default-font
84                                          :name *modeline-font-name*
85                                        :size *modeline-font-size*))))
86    (when (is-fixed-pitch-font f)
87      (let* ((values (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))))
88        (#/setValue:forKey: values (#/fontName f) #@"modelineFontName")
89        (#/setValue:forKey: values (#/stringWithFormat: ns:ns-string #@"%u" (round (#/pointSize f))) #@"modelineFontSize")))))
90
91
92(objc:defmethod (#/changeColor: :void) ((self lisp-preferences-panel)
93                                        sender)
94  (declare (ignore sender)))
95
96
97(objc:defmethod (#/selectHyperspecFileURL: :void)
98    ((self lisp-preferences-window-controller)
99     sender)
100  (declare (ignore sender))
101  (let* ((panel (make-instance 'ns:ns-open-panel))
102         (values (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))))
103    (#/setAllowsMultipleSelection: panel nil)
104    (#/setCanChooseDirectories: panel t)
105    (#/setCanChooseFiles: panel nil)
106    (when (eql
107           (#/runModalForDirectory:file:types:
108            panel
109            (#/valueForKey: values #@"hyperspecFileURLString")
110            +null-ptr+
111            +null-ptr+)
112           #$NSOKButton)
113      (let* ((filename (#/objectAtIndex: (#/filenames panel) 0)))
114        (#/setValue:forKey: values filename #@"hyperspecFileURLString")))))
115
116(objc:defmethod #/sharedPanel ((self +lisp-preferences-panel))
117  (cond (*lisp-preferences-panel*)
118        (t
119         (let* ((domain (#/standardUserDefaults ns:ns-user-defaults))
120                (initial-values (cocoa-defaults-initial-values)))
121           (#/registerDefaults: domain initial-values)
122           (update-cocoa-defaults)
123           (#/setValueTransformer:forName:
124            ns:ns-value-transformer
125            (make-instance 'font-name-transformer)
126            #@"FontNameTransformer")
127           (let* ((sdc (#/sharedUserDefaultsController ns:ns-user-defaults-controller)))
128             (#/setAppliesImmediately: sdc nil)
129             (#/setInitialValues: sdc initial-values)
130             (let* ((controller (make-instance lisp-preferences-window-controller
131                                             :with-window-nib-name #@"preferences"))
132                    (window (#/window controller)))
133               (unless (%null-ptr-p window)
134                 (#/setFloatingPanel: window t)
135                 (#/addObserver:selector:name:object:
136                  (#/defaultCenter ns:ns-notification-center)
137                  controller
138                  (@selector #/defaultsChanged:)
139                  #&NSUserDefaultsDidChangeNotification
140                  (#/standardUserDefaults ns:ns-user-defaults))
141                 (setq *lisp-preferences-panel* window))))))))
142
143 
144(objc:defmethod #/init ((self lisp-preferences-panel))
145  (let* ((class (class-of self)))
146    (#/dealloc self)
147    (#/sharedPanel class)))
148
149
150(objc:defmethod (#/makeKeyAndOrderFront: :void)
151    ((self lisp-preferences-panel) sender)
152  (let* ((color-panel (#/sharedColorPanel ns:ns-color-panel)))
153    (#/close color-panel)
154    (#/setAction: color-panel +null-ptr+)
155    (#/setShowsAlpha: color-panel t))
156  (call-next-method sender))
157
158(objc:defmethod (#/show :void) ((self lisp-preferences-panel))
159  (#/makeKeyAndOrderFront: self +null-ptr+))
160
161(objc:defmethod (#/defaultsChanged: :void)
162    ((self lisp-preferences-window-controller)
163     notification)
164  (declare (ignore notification))
165  (update-cocoa-defaults))
166 
167
168
Note: See TracBrowser for help on using the repository browser.