source: trunk/source/cocoa-ide/inspector.lisp @ 12846

Last change on this file since 12846 was 12846, checked in by gz, 10 years ago

Make the gui inspector show function disassembly. Extend the inspector protocol to support this a little better. Fix a number of bugs in closing and method inspectors.

File size: 12.1 KB
Line 
1(in-package "GUI")
2
3#|
4Implements inspector windows in Cocoa
5
6This builds heavily on the inspector objects defined in ccl/lib/describe.lisp.
7
8An inspector-item is an Objective-C object that contains a lisp-inspector, and a vector of child inspector-items
9that are filled in lazily as required.
10
11To Do: 
12Make scroll bars work
13Make command-left-arrow and command-right-arrow go back and forward
14Add tabs
15Set window title based on object
16Add "Inspect" menu item (Key equivalent: command-I) - and make it work in many situations
17  If an inspector is on top, inspect selection in place
18  If an editor is on top
19    If there is a selection, eval and inspect
20    If no selection look for a nearby form to eval and inspect
21  If listener is on top and insertion point is after prompt, inspect *
22  Inspect selection of other windows, backtrace, apropos, etc.
23
24Make meta-dot edit source in many places, have menu item which is disabled when it doesn't make sense
25Handle comments, and static inspector items
26Make editing in place work in some situations
27Make command-double-click bring up new inspector window
28Make command-T inspect in a new tab
29add bookmarks for commonly inspected objects - forms to evaluate
30Add set-package widget to many places to effect printed representations and evaluation contexts
31Make a way to get inspected object to listener, possibly set *
32  (to be consistent with editor windows, make enter print it in listener setting *
33    make command-enter, do that and bring listener to the front)
34In some situations, remember and display form that was evaluated to get currently inspected object
35When form is shown, refresh re-evaluates form
36Possibly add splitter
37Possibly add linked panes
38Maybe get rid of contextual menus when main menu handles everything
39Make preferences for fonts, key commands
40|#
41
42(defvar @ nil)
43(defvar @@ nil)
44(defvar @@@ nil)
45
46(defclass ninspector-window-controller (ns:ns-window-controller)
47  ((table-view :foreign-type :id :accessor table-view) ;IBOutlet set by nib file
48   (property-column :foreign-type :id :accessor property-column) ;IBOutlet
49   (value-column :foreign-type :id :accessor value-column) ;IBOutlet
50   (object-label :foreign-type :id :accessor object-label) ;IBOutlet
51   (back-button :foreign-type :id :accessor back-button) ;IBOutlet
52   (forward-button :foreign-type :id :accessor forward-button) ;IBOutlet
53   (refresh-button :foreign-type :id :accessor refresh-button) ;IBOutlet
54   (item-menu :foreign-type :id :accessor item-menu) ;IBOutlet
55   (viewed-inspector-items :initform (make-array 10 :fill-pointer 0 :adjustable t)  :accessor viewed-inspector-items)
56   (next-index :initform 0 :accessor next-index 
57               :documentation "The index of the next inspector-item in viewed-inspector-items.
58               The index of the inspector-item currently being viewed is one less")
59   (inspector-item :initarg :inspector-item :reader inspector-item))
60  (:metaclass ns:+ns-object))
61
62(objc:defmethod #/init ((self ninspector-window-controller))
63  (#/setShouldCascadeWindows: self t)
64  (#/initWithWindowNibName: self #@"inspector"))
65
66(defmethod lisp-inspector ((wc ninspector-window-controller))
67  (lisp-inspector (inspector-item wc)))
68
69(defmethod set-current-inspector-item ((wc ninspector-window-controller) index)
70  (with-slots (next-index viewed-inspector-items) wc
71    (when (< -1 index (fill-pointer viewed-inspector-items))
72      (setf next-index (1+ index))
73      (set-enabled wc)
74      (setf (inspector-item wc) (aref viewed-inspector-items index)))))
75
76(defmethod set-enabled ((wc ninspector-window-controller))
77  "Enables or disables buttons based on current state of viewed-inspector-items and next-index"
78  (with-slots (forward-button back-button next-index viewed-inspector-items) wc
79    (#/setEnabled: back-button (> next-index 1))
80    (#/setEnabled: forward-button (< next-index (fill-pointer viewed-inspector-items)))))
81
82;;Lifted from apropos-window.lisp, not sure if it's really needed...
83(objc:defmethod (#/automaticallyNotifiesObserversForKey: :<BOOL>) ((self +ninspector-window-controller)
84                                                                  key)
85  (declare (ignore key))
86  nil)
87
88(objc:defmethod (#/awakeFromNib :void) ((self ninspector-window-controller))
89  (with-slots (table-view back-button forward-button refresh-button item-menu) self
90    (#/setTarget: back-button self)
91    (#/setAction: back-button (@selector #/goBack:))
92    (#/setTarget: forward-button self)
93    (#/setAction: forward-button (@selector #/goForward:))
94    (#/setTarget: refresh-button self)
95    (#/setAction: refresh-button (@selector #/doRefresh:))
96    (#/setTarget: table-view self)
97    (#/setDoubleAction: table-view (@selector #/inspectSelectionInPlace:))
98    (set-enabled self)
99    (let ((mi0 (#/itemAtIndex: item-menu 0)) ;Inspect in new window
100          (mi1 (#/itemAtIndex: item-menu 1)) ;Inspect in new tab
101          (mi2 (#/itemAtIndex: item-menu 2))) ;Edit Source
102      (#/setEnabled: mi0 t)
103      (#/setTarget: mi0 self)
104      (#/setAction: mi0 (@selector #/inspectSelectionInNewWindow:))
105      (#/setEnabled: mi1 nil)
106      (#/setTarget: mi1 self)
107      (#/setAction: mi1 (@selector #/inspectSelectionInNewTab:))
108      (#/setEnabled: mi2 nil) ;TODO why isn't this working?
109      (#/setTarget: mi2 self)
110      (#/setAction: mi2 (@selector #/editSelectionSource:)))
111    (#/setMenu: table-view item-menu)
112    ))
113
114(objc:defmethod (#/inspectSelectionInPlace: :void) ((wc ninspector-window-controller) sender)
115  (let* ((row (#/clickedRow sender)))
116    (unless (minusp row)
117      (with-slots (next-index viewed-inspector-items) wc
118        (let ((ii (get-child (inspector-item wc) row)))
119          (when (lisp-inspector ii)
120            (if (and (< next-index (fill-pointer viewed-inspector-items))
121                     (eql ii (aref viewed-inspector-items next-index)))
122                ;;If the ii is the same as the next history item, then just go forward in history
123                (set-current-inspector-item wc next-index)
124                ;;Otherwise forget the forward history
125                (push-inspector-item wc ii))))))))
126
127(objc:defmethod (#/inspectSelectionInNewWindow: :void) ((wc ninspector-window-controller) sender)
128  (declare (ignore sender))
129  (let* ((row (#/clickedRow (table-view wc))))
130    (unless (minusp row)
131      (with-slots (next-index viewed-inspector-items) wc
132        (let* ((ii (get-child (inspector-item wc) row))
133               (li (lisp-inspector ii)))
134          (when li
135            (make-inspector-window li)))))))
136
137(objc:defmethod (#/inspectSelectionInSameWindow: :void) ((wc ninspector-window-controller) sender)
138  (declare (ignore sender)))
139
140(objc:defmethod (#/editSelectionSource: :void) ((wc ninspector-window-controller) sender)
141  (declare (ignore sender)))
142
143(objc:defmethod (#/goBack: :void) ((wc ninspector-window-controller) sender)
144  (declare (ignore sender))
145  (set-current-inspector-item wc (- (next-index wc) 2)))
146
147(objc:defmethod (#/goForward: :void) ((wc ninspector-window-controller) sender)
148  (declare (ignore sender))
149  (set-current-inspector-item wc (next-index wc)))
150
151(objc:defmethod (#/doRefresh: :void) ((wc ninspector-window-controller) sender)
152  (declare (ignore sender))
153  (let ((inspector::*inspector-disassembly* t))
154    (push-inspector-item wc (make-inspector-item (inspector::refresh-inspector (lisp-inspector wc))))))
155
156(defclass inspector-item (ns:ns-object)
157  ((lisp-inspector :accessor lisp-inspector) ;; null for non-inspectable
158   (label :accessor inspector-item-label) ;NSString
159   (ob-string :accessor inspector-item-ob-string) ;NSString
160   (children :initform nil)) ;initialized lazily
161  (:metaclass ns:+ns-object))
162
163(defmethod inspector-item-children ((ii inspector-item))
164  (or (slot-value ii 'children)
165      (setf (slot-value ii 'children)
166            (make-array (inspector-line-count ii) :initial-element nil))))
167
168(defmethod inspector-object ((ii inspector-item))
169  (let ((li (lisp-inspector ii)))
170    (and li (inspector::inspector-object li))))
171
172(defmethod inspector-line-count ((ii inspector-item))
173  (let ((li (lisp-inspector ii)))
174    (or  (and (null li) 0)
175         (inspector::inspector-line-count li)
176         (progn
177           (inspector::update-line-count li)
178           (inspector::inspector-line-count li)))))
179
180(defun inspector-object-nsstring (li)
181  (let ((ob (inspector::inspector-object li))
182        (*print-readably* nil)
183        (*signal-printing-errors* nil)
184        (*print-circle* t)
185        (*print-length* 20)
186        (*print-pretty* nil))
187    (%make-nsstring (prin1-to-string ob))))
188
189(defun make-inspector-item (li &optional label-string value-string)
190  (let* ((item (make-instance 'inspector-item)))
191    (setf (lisp-inspector item) li
192          (inspector-item-ob-string item) (if value-string
193                                            (%make-nsstring value-string)
194                                            (inspector-object-nsstring li))
195          (inspector-item-label item) (%make-nsstring (or label-string "")))
196    item))
197 
198(defun make-inspector (ob)
199  (let ((inspector::*inspector-disassembly* t))
200    (make-inspector-window (inspector::make-inspector ob))))
201
202(defun make-inspector-window (li)
203  (let* ((wc (make-instance 'ninspector-window-controller))
204         (ii (make-inspector-item li)))
205    (push-inspector-item wc ii)
206    (#/showWindow: wc nil)
207    wc))
208
209(defmethod push-inspector-item ((wc ninspector-window-controller) (ii inspector-item))
210  (with-slots (next-index viewed-inspector-items) wc
211    (when (< next-index (fill-pointer viewed-inspector-items))
212      (setf (fill-pointer viewed-inspector-items) next-index))
213    (vector-push-extend ii viewed-inspector-items)
214    (incf next-index))
215  (set-enabled wc)
216  (setf (inspector-item wc) ii))
217
218(defmethod (setf inspector-item) ((ii inspector-item) (wc ninspector-window-controller))
219  (setf @@@ @@
220        @@ @
221        @ (inspector-object ii))
222  (setf (slot-value wc 'inspector-item) ii)
223  (let* ((w (#/window wc))
224         (title (inspector-object-nsstring (lisp-inspector ii))))
225    (#/setTitle: w (%make-nsstring (concatenate 'string  "Inspect: " 
226                                                (lisp-string-from-nsstring title))))
227    (#/setStringValue: (object-label wc) title)
228    (#/reloadData (table-view wc))))
229
230(defun ninspect (object)
231  (execute-in-gui #'(lambda () (make-inspector object))))
232
233
234#|
235The inspector-window-controller is specified in the nib file to be the data source for the NSTableView.
236In order to be a data source it must implement the NSTableDataSource protocol.
237
238The NSTableDataSource methods to get values for the NSTableView are:
239- (NSInteger)numberOfRowsInTableView:(NSTableView *)aTableView
240- (id)tableView:(NSTableView *)aTableView objectValueForTableColumn:(NSTableColumn *)aTableColumn row:(NSInteger)rowIndex
241
242For simplicity, the latter method returns NSStrings (it could return other types that need special formatting objects)
243
244If we want the table view to support other features such as setting, sorting, or drag and drop, other
245NSTableDataSource methods can be defined.
246|#
247
248
249(objc:defmethod (#/numberOfRowsInTableView: :<NSI>nteger) ((self ninspector-window-controller) table-view)
250  (declare (ignore table-view))
251  (1- (length (inspector-item-children (inspector-item self))))) ;skip first child which just contains the object itself
252
253(objc:defmethod #/tableView:objectValueForTableColumn:row: ((self ninspector-window-controller) table-view column (row :<NSI>nteger))
254  (declare (ignore table-view))
255  (let ((child (get-child (inspector-item self) row)))
256    (cond ((eql column (property-column self)) (inspector-item-label child))
257          ((eql column (value-column self)) (inspector-item-ob-string child))
258          ((#/isEqualToString: #@"property" (#/identifier column)) (inspector-item-label child))
259          ((#/isEqualToString: #@"value" (#/identifier column)) (inspector-item-ob-string child))
260          (t (progn
261               (log-debug "col: ~s prop-col: ~s val-col: ~s" column (property-column self) (value-column self))
262               #@"*error*")))))
263
264(defmethod get-child ((ii inspector-item) index)
265  (let ((arr (inspector-item-children ii))
266        (i (1+ index)))
267    (or (svref arr i)
268        (setf (svref arr i)
269              (let ((li (lisp-inspector ii))
270                    (inspector::*inspector-disassembly* t))
271                (multiple-value-bind (child label-string value-string) (inspector::inspector-line li i)
272                  (make-inspector-item child (or label-string "") (or value-string ""))))))))
273
274;;; Make CL:INSPECT call NINSPECT.
275(setq inspector::*default-inspector-ui-creation-function* 'ninspect)
276
Note: See TracBrowser for help on using the repository browser.