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

Last change on this file since 8494 was 8494, checked in by jaj, 13 years ago

Add new inspector

File size: 11.7 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(defclass ninspector-window-controller (ns:ns-window-controller)
43  ((table-view :foreign-type :id :accessor table-view) ;IBOutlet set by nib file
44   (property-column :foreign-type :id :accessor property-column) ;IBOutlet
45   (value-column :foreign-type :id :accessor value-column) ;IBOutlet
46   (object-label :foreign-type :id :accessor object-label) ;IBOutlet
47   (back-button :foreign-type :id :accessor back-button) ;IBOutlet
48   (forward-button :foreign-type :id :accessor forward-button) ;IBOutlet
49   (refresh-button :foreign-type :id :accessor refresh-button) ;IBOutlet
50   (item-menu :foreign-type :id :accessor item-menu) ;IBOutlet
51   (viewed-inspector-items :initform (make-array 10 :fill-pointer 0 :adjustable t)  :accessor viewed-inspector-items)
52   (next-index :initform 0 :accessor next-index 
53               :documentation "The index of the next inspector-item in viewed-inspector-items.
54               The index of the inspector-item currently being viewed is one less")
55   (inspector-item :initarg :inspector-item :reader inspector-item))
56  (:metaclass ns:+ns-object))
57
58(objc:defmethod #/init ((self ninspector-window-controller))
59  (#/initWithWindowNibName: self #@"inspector"))
60
61(defmethod lisp-inspector ((wc ninspector-window-controller))
62  (lisp-inspector (inspector-item wc)))
63
64(defmethod set-current-inspector-item ((wc ninspector-window-controller) index)
65  (with-slots (next-index viewed-inspector-items) wc
66    (when (< -1 index (fill-pointer viewed-inspector-items))
67      (setf next-index (1+ index))
68      (set-enabled wc)
69      (setf (inspector-item wc) (aref viewed-inspector-items index)))))
70
71(defmethod set-enabled ((wc ninspector-window-controller))
72  "Enables or disables buttons based on current state of viewed-inspector-items and next-index"
73  (with-slots (forward-button back-button next-index viewed-inspector-items) wc
74    (#/setEnabled: back-button (> next-index 1))
75    (#/setEnabled: forward-button (< next-index (fill-pointer viewed-inspector-items)))))
76
77;;Lifted from apropos-window.lisp, not sure if it's really needed...
78(objc:defmethod (#/automaticallyNotifiesObserversForKey: :<BOOL>) ((self +ninspector-window-controller)
79                                                                  key)
80  (declare (ignore key))
81  nil)
82
83(objc:defmethod (#/awakeFromNib :void) ((self ninspector-window-controller))
84  (with-slots (table-view back-button forward-button refresh-button item-menu) self
85    (#/setTarget: back-button self)
86    (#/setAction: back-button (@selector #/goBack))
87    (#/setTarget: forward-button self)
88    (#/setAction: forward-button (@selector #/goForward))
89    (#/setTarget: refresh-button self)
90    (#/setAction: refresh-button (@selector #/doRefresh))
91    (#/setTarget: table-view self)
92    (#/setDoubleAction: table-view (@selector #/inspectSelectionInPlace:))
93    (set-enabled self)
94    (let ((mi0 (#/itemAtIndex: item-menu 0)) ;Inspect in new window
95          (mi1 (#/itemAtIndex: item-menu 1)) ;Inspect in new tab
96          (mi2 (#/itemAtIndex: item-menu 2))) ;Edit Source
97      (#/setEnabled: mi0 t)
98      (#/setTarget: mi0 self)
99      (#/setAction: mi0 (@selector #/inspectSelectionInNewWindow:))
100      (#/setEnabled: mi1 nil)
101      (#/setTarget: mi1 self)
102      (#/setAction: mi1 (@selector #/inspectSelectionInNewTab:))
103      (#/setEnabled: mi2 nil) ;TODO why isn't this working?
104      (#/setTarget: mi2 self)
105      (#/setAction: mi2 (@selector #/editSelectionSource:)))
106    (#/setMenu: table-view item-menu)
107    ;(#/setTitle: (#/window self) #@"FooBar") ;TODO figure out how to set window title
108    ))
109
110(objc:defmethod (#/inspectSelectionInPlace: :void) ((wc ninspector-window-controller) sender)
111  (let* ((row (#/clickedRow sender)))
112    (unless (minusp row)
113      (with-slots (next-index viewed-inspector-items) wc
114        (let ((ii (get-child (inspector-item wc) row)))
115          (if (and (< next-index (fill-pointer viewed-inspector-items))
116                   (eq ii (aref viewed-inspector-items next-index)))
117            ;;If the ii is the same and the next history item, then just go forward in history
118            (set-current-inspector-item wc next-index)
119            ;;Otherwise forget the forward history
120            (push-inspector-item wc ii)))))))
121
122(objc:defmethod (#/inspectSelectionInNewWindow: :void) ((wc ninspector-window-controller) sender)
123  (declare (ignore sender))
124  (let* ((row (#/clickedRow (table-view wc))))
125    (unless (minusp row)
126      (with-slots (next-index viewed-inspector-items) wc
127        (let* ((ii (get-child (inspector-item wc) row))
128               (ob (inspector-object ii)))
129          (make-inspector ob))))))
130
131(objc:defmethod (#/inspectSelectionInSameWindow: :void) ((wc ninspector-window-controller) sender)
132  (declare (ignore sender)))
133
134(objc:defmethod (#/editSelectionSource: :void) ((wc ninspector-window-controller) sender)
135  (declare (ignore sender)))
136
137(objc:defmethod (#/goBack :void) ((wc ninspector-window-controller) sender)
138  (declare (ignore sender))
139  (set-current-inspector-item wc (- (next-index wc) 2)))
140
141(objc:defmethod (#/goForward :void) ((wc ninspector-window-controller) sender)
142  (declare (ignore sender))
143  (set-current-inspector-item wc (next-index wc)))
144
145(objc:defmethod (#/doRefresh :void) ((wc ninspector-window-controller) sender)
146  (declare (ignore sender))
147  (push-inspector-item wc (make-inspector-item (inspector-object (inspector-item wc)))))
148
149(defclass inspector-item (ns:ns-object)
150  ((lisp-inspector :accessor lisp-inspector)
151   (label :accessor inspector-item-label) ;NSString
152   (ob-string :accessor inspector-item-ob-string) ;NSString
153   (type :accessor inspector-item-type) ; oneof: nil :normal :colon :comment :static
154   (children :initform nil)) ;initialized lazily
155  (:metaclass ns:+ns-object))
156
157(defmethod inspector-item-children ((ii inspector-item))
158  (or (slot-value ii 'children)
159      (let* ((li (lisp-inspector ii)))
160        (when (null (inspector::inspector-line-count li))
161          (inspector::update-line-count li))       
162        (setf (slot-value ii 'children)
163            (make-array (inspector::inspector-line-count li) :initial-element nil)))))
164
165(defmethod inspector-object ((ii inspector-item))
166  (inspector::inspector-object (lisp-inspector ii)))
167
168(defmethod inspector-line-count ((ii inspector-item))
169  (let ((li (lisp-inspector ii)))
170    (or  (inspector::inspector-line-count li)
171         (progn
172           (inspector::update-line-count li)
173           (inspector::inspector-line-count li)))))
174
175(defun inspector-object-nsstring (ob)
176  (let ((*print-readably* nil)
177        (*signal-printing-errors* nil)
178        (*print-circle* t)
179        (*print-length* 20)
180        (*print-pretty* nil))
181    (%make-nsstring (prin1-to-string ob))))
182
183(defun make-inspector-item (value &optional label type)
184  (let* ((item (make-instance 'inspector-item))
185         (li (inspector::make-inspector value)))
186    (setf (lisp-inspector item) li
187          (inspector-item-ob-string item) (inspector-object-nsstring value)
188          (inspector-item-label item) label
189          (inspector-item-type item) type)
190    item))
191
192(defun make-inspector (ob)
193  (let* ((wc (make-instance 'ninspector-window-controller))
194         (ii (make-inspector-item ob)))
195    (push-inspector-item wc ii)
196    wc))
197
198(defmethod push-inspector-item ((wc ninspector-window-controller) (ii inspector-item))
199  (with-slots (next-index viewed-inspector-items) wc
200    (when (< next-index (fill-pointer viewed-inspector-items))
201      (setf (fill-pointer viewed-inspector-items) next-index))
202    (vector-push-extend ii viewed-inspector-items)
203    (incf next-index))
204  (set-enabled wc)
205  (setf (inspector-item wc) ii))
206
207(defmethod (setf inspector-item) ((ii inspector-item) (wc ninspector-window-controller))
208  (setf (slot-value wc 'inspector-item) ii)
209  (#/window wc) ;makes sure there is a window
210  (let* ((title (inspector-item-ob-string ii)))
211      (#/setStringValue: (object-label wc) title)
212      (#/reloadData (table-view wc))))
213
214(defun ninspect (object)
215  (execute-in-gui #'(lambda () (make-inspector object))))
216
217
218#|
219The inspector-window-controller is specified in the nib file to be the data source for the NSTableView.
220In order to be a data source it must implement the NSTableDataSource protocol.
221
222The NSTableDataSource methods to get values for the NSTableView are:
223- (NSInteger)numberOfRowsInTableView:(NSTableView *)aTableView
224- (id)tableView:(NSTableView *)aTableView objectValueForTableColumn:(NSTableColumn *)aTableColumn row:(NSInteger)rowIndex
225
226For simplicity, the latter method returns NSStrings (it could return other types that need special formatting objects)
227
228If we want the table view to support other features such as setting, sorting, or drag and drop, other
229NSTableDataSource methods can be defined.
230|#
231
232
233(objc:defmethod (#/numberOfRowsInTableView: :<NSI>nteger) ((self ninspector-window-controller) table-view)
234  (declare (ignore table-view))
235  (1- (length (inspector-item-children (inspector-item self))))) ;skip first child which just contains the object itself
236
237(objc:defmethod #/tableView:objectValueForTableColumn:row: ((self ninspector-window-controller) table-view column (row :<NSI>nteger))
238  (declare (ignore table-view))
239  (let ((child (get-child (inspector-item self) row)))
240    (cond ((eql column (property-column self)) (inspector-item-label child))
241          ((eql column (value-column self)) (inspector-item-ob-string child))
242          ((#/isEqualToString: #@"property" (#/identifier column)) (inspector-item-label child))
243          ((#/isEqualToString: #@"value" (#/identifier column)) (inspector-item-ob-string child))
244          (t (progn
245               (log-debug "col: ~s prop-col: ~s val-col: ~s" column (property-column self) (value-column self))
246               #@"*error*")))))
247
248(defmethod get-child ((ii inspector-item) index)
249  (let ((arr (inspector-item-children ii))
250        (i (1+ index)))
251    (or (svref arr i)
252        (multiple-value-bind (ob label type) (inspector::line-n (lisp-inspector ii) i)
253          (setf (svref arr i) (make-inspector-item ob (%make-nsstring (princ-to-string label)) type))))))
254
255;;; Make INSPECT call CINSPECT.
256(setq inspector::*default-inspector-ui-creation-function* 'ninspect)
Note: See TracBrowser for help on using the repository browser.