source: trunk/source/cocoa-ide/apropos-window.lisp @ 8522

Last change on this file since 8522 was 8522, checked in by rme, 12 years ago

Some easy apropos window changes.

  • work with new inspector (no more GUI::CINSPECT, so we just call INSPECT)
  • apropos window is now a plain window, not a utility panel
  • double-clicking a row now shows the source
  • the "inspect" and "edit source" contextual menu items work

(cf. ticket:226, ticket:176)

File size: 8.6 KB
Line 
1;;;-*-Mode: LISP; Package: GUI -*-
2;;;
3;;;   Copyright (C) 2007 Clozure Associates
4
5(in-package "GUI")
6
7(defclass package-combo-box (ns:ns-combo-box)
8  ((packages :initform nil))
9  (:metaclass ns:+ns-object))
10
11;;; This is a premature optimization.  Instead of calling LIST-ALL-PACKAGES
12;;; so frequently, just get a fresh copy when the user clicks in the
13;;; combo box.
14(objc:defmethod (#/becomeFirstResponder :<BOOL>) ((self package-combo-box))
15  (with-slots (packages) self
16    (setf packages (coerce (list-all-packages) 'vector))
17    (setf packages (sort packages #'string-lessp :key #'package-name)))
18  (call-next-method))
19
20(defclass apropos-window-controller (ns:ns-window-controller)
21  ((apropos-array :foreign-type :id :initform +null-ptr+
22                  :reader apropos-array
23                  :documentation "Bound to NSArrayController in nib file")
24   (array-controller :foreign-type :id :accessor array-controller)
25   (combo-box :foreign-type :id :accessor combo-box)
26   (table-view :foreign-type :id :accessor table-view)
27   (text-view :foreign-type :id :accessor text-view)
28   (external-symbols-checkbox :foreign-type :id
29                              :accessor external-symbols-checkbox)
30   (shows-external-symbols :initform nil)
31   (symbol-list :initform nil)
32   (package :initform nil)
33   (input :initform nil)
34   (previous-input :initform nil :accessor previous-input
35                   :documentation "Last string entered"))
36  (:metaclass ns:+ns-object))
37
38(defmethod (setf apropos-array) (value (self apropos-window-controller))
39  (with-slots (apropos-array) self
40    (unless (eql value apropos-array)
41      (#/release apropos-array)
42      (setf apropos-array (#/retain value)))))
43
44;;; Diasable automatic KVO notifications, since having our class swizzled
45;;; out from underneath us confuses CLOS.  (Leopard doesn't hose us,
46;;; and we can use automatic KVO notifications there.)
47(objc:defmethod (#/automaticallyNotifiesObserversForKey: :<BOOL>) ((self +apropos-window-controller)
48                                                                  key)
49  (declare (ignore key))
50  nil)
51
52(objc:defmethod (#/awakeFromNib :void) ((self apropos-window-controller))
53  (with-slots (table-view text-view) self
54    (#/setString: text-view #@"")
55    (#/setDelegate: table-view self)
56    (#/setDoubleAction: table-view (@selector #/definitionForSelectedSymbol:))))
57
58(objc:defmethod #/init ((self apropos-window-controller))
59  (prog1
60      (#/initWithWindowNibName: self #@"apropos")
61    (#/setShouldCascadeWindows: self nil)
62    (#/setWindowFrameAutosaveName: self #@"apropos panel")
63    (setf (apropos-array self) (#/array ns:ns-mutable-array))))
64
65(objc:defmethod (#/dealloc :void) ((self apropos-window-controller))
66  (#/release (slot-value self 'apropos-array))
67  (call-next-method))
68
69(objc:defmethod (#/toggleShowsExternalSymbols: :void)
70    ((self apropos-window-controller) sender)
71  (declare (ignore sender))
72  (with-slots (shows-external-symbols) self
73    (setf shows-external-symbols (not shows-external-symbols))
74    (update-symbol-list self)
75    (update-apropos-array self)))
76
77(objc:defmethod (#/setPackage: :void) ((self apropos-window-controller)
78                                       sender)
79  (with-slots (combo-box package) self
80    (assert (eql sender combo-box))
81    (with-slots (packages) sender
82      (let ((index (#/indexOfSelectedItem sender)))
83        (if (minusp index)
84          (setf package nil)            ;search all packages
85          (setf package (svref packages index))))))
86  (update-symbol-list self)
87  (update-apropos-array self))
88
89(defmethod update-symbol-list ((self apropos-window-controller))
90  (with-slots (input package shows-external-symbols symbol-list) self
91    (when (plusp (length input))
92      (setf symbol-list nil)
93      (if package
94        (if shows-external-symbols
95          (do-external-symbols (sym package)
96            (when (ccl::%apropos-substring-p input (symbol-name sym))
97              (push sym symbol-list)))
98          (do-symbols (sym package)
99            (when (ccl::%apropos-substring-p input (symbol-name sym))
100              (push sym symbol-list))))
101        (if shows-external-symbols
102          (dolist (p (list-all-packages))
103            (do-external-symbols (sym p)
104              (when (ccl::%apropos-substring-p input (symbol-name sym))
105                (push sym symbol-list))))
106          (do-all-symbols (sym)
107            (when (ccl::%apropos-substring-p input (symbol-name sym))
108              (push sym symbol-list)))))
109      (setf symbol-list (sort symbol-list #'string-lessp)))))
110
111(defmethod update-apropos-array ((self apropos-window-controller))
112  (with-slots (input apropos-array symbol-list package) self
113    (when (plusp (length input))
114      (let ((new-array (#/array ns:ns-mutable-array))
115            (*package* (or package (find-package "COMMON-LISP-USER")))
116            (n 0))
117        (dolist (s symbol-list)
118          (#/addObject: new-array (#/dictionaryWithObjectsAndKeys:
119                                   ns:ns-dictionary
120                                   (#/autorelease
121                                    (%make-nsstring
122                                     (prin1-to-string s)))
123                                   #@"symbol"
124                                   (#/numberWithInt: ns:ns-number n)
125                                   #@"index"
126                                   (#/autorelease
127                                    (%make-nsstring
128                                     (inspector::symbol-type-line s)))
129                                   #@"kind"
130                                   +null-ptr+))
131          (incf n))
132        (#/willChangeValueForKey: self #@"aproposArray")
133        (setf apropos-array new-array)
134        (#/didChangeValueForKey: self #@"aproposArray")))))
135
136(objc:defmethod (#/apropos: :void) ((self apropos-window-controller) sender)
137  (let* ((input (lisp-string-from-nsstring (#/stringValue sender))))
138    (when (and (plusp (length input))
139               (not (string-equal input (previous-input self))))
140      (setf (slot-value self 'input) input)
141      (setf (previous-input self) input)
142      (update-symbol-list self)
143      (update-apropos-array self))))
144
145(objc:defmethod (#/inspectSelectedSymbol: :void) ((self apropos-window-controller) sender)
146  (declare (ignorable sender))
147  (let* ((row (#/clickedRow (table-view self))))
148    (unless (minusp row)
149      (with-slots (array-controller symbol-list) self
150        (let* ((number (#/valueForKeyPath: array-controller #@"selection.index"))
151               (i (#/intValue number))
152               (sym (elt symbol-list i)))
153          (inspect sym))))))
154
155(objc:defmethod (#/definitionForSelectedSymbol: :void) ((self apropos-window-controller) sender)
156  (declare (ignorable sender))
157  (let* ((row (#/clickedRow (table-view self))))
158    (unless (minusp row)
159      (with-slots (array-controller symbol-list) self
160        (let* ((number (#/valueForKeyPath: array-controller #@"selection.index"))
161               (i (#/intValue number))
162               (sym (elt symbol-list i)))
163          (hemlock::edit-definition sym))))))
164
165;;; Data source methods for package combo box
166
167(objc:defmethod (#/numberOfItemsInComboBox: :<NSI>nteger) ((self apropos-window-controller)
168                                                   combo-box)
169  (declare (ignore combo-box))
170  (length (list-all-packages)))
171
172(objc:defmethod #/comboBox:objectValueForItemAtIndex: ((self apropos-window-controller)
173                                                       combo-box
174                                                       (index :<NSI>nteger))
175  (with-slots (packages) combo-box
176    (let* ((pkg-name (package-name (svref packages index))))
177      (if pkg-name
178        (#/autorelease (%make-nsstring pkg-name))
179        +null-ptr+))))
180
181(objc:defmethod #/comboBox:completedString: ((self apropos-window-controller)
182                                             combo-box
183                                             partial-string)
184  (flet ((string-prefix-p (s1 s2)
185           "Is s1 a prefix of s2?"
186           (string-equal s1 s2 :end2 (min (length s1) (length s2)))))
187    (with-slots (packages) combo-box
188      (let* ((s (lisp-string-from-nsstring partial-string)))
189        (dotimes (i (length packages) +null-ptr+)
190          (let ((name (package-name (svref packages i))))
191            (when (string-prefix-p s name)
192              (return (#/autorelease (%make-nsstring name))))))))))
193
194(objc:defmethod (#/comboBox:indexOfItemWithStringValue: :<NSUI>nteger)
195    ((self apropos-window-controller)
196     combo-box
197     string)
198  (with-slots (packages) combo-box
199    (let* ((s (lisp-string-from-nsstring string)))
200      (or (position s packages :test #'(lambda (str pkg)
201                                         (string-equal str (package-name pkg))))
202          #$NSNotFound))))
203
204
205;;; Table view delegate methods
206
207(objc:defmethod (#/tableViewSelectionDidChange: :void) ((self apropos-window-controller)
208                                                        notification)
209  (with-slots (array-controller symbol-list text-view) self
210    (let* ((tv (#/object notification))
211           (row (#/selectedRow tv)))
212      (unless (minusp row)
213        (let* ((number (#/valueForKeyPath:
214                        array-controller #@"selection.index"))
215               (i (#/intValue number))
216               (sym (elt symbol-list i))
217               (info (make-array '(0) :element-type 'base-char
218                                 :fill-pointer 0 :adjustable t)))
219          (with-output-to-string (s info)
220            (dolist (doctype '(compiler-macro function method-combination
221                               setf structure t type variable))
222              (let ((docstring (documentation sym doctype)))
223                (when docstring
224                  (format s "~&~a" docstring))
225                (when (eq doctype 'function)
226                  (format s "~&arglist: ~s" (arglist sym))))))
227          (if (plusp (length info))
228            (#/setString: text-view (#/autorelease (%make-nsstring info)))
229            (#/setString: text-view #@"")))))))
230
231
Note: See TracBrowser for help on using the repository browser.