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

Last change on this file since 12135 was 12135, checked in by rme, 10 years ago

Make inspectors key when creating them (ticket:493).

File size: 11.9 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          (if (and (< next-index (fill-pointer viewed-inspector-items))
120                   (eq ii (aref viewed-inspector-items next-index)))
121            ;;If the ii is the same as the next history item, then just go forward in history
122            (set-current-inspector-item wc next-index)
123            ;;Otherwise forget the forward history
124            (push-inspector-item wc ii)))))))
125
126(objc:defmethod (#/inspectSelectionInNewWindow: :void) ((wc ninspector-window-controller) sender)
127  (declare (ignore sender))
128  (let* ((row (#/clickedRow (table-view wc))))
129    (unless (minusp row)
130      (with-slots (next-index viewed-inspector-items) wc
131        (let* ((ii (get-child (inspector-item wc) row))
132               (ob (inspector-object ii)))
133          (make-inspector ob))))))
134
135(objc:defmethod (#/inspectSelectionInSameWindow: :void) ((wc ninspector-window-controller) sender)
136  (declare (ignore sender)))
137
138(objc:defmethod (#/editSelectionSource: :void) ((wc ninspector-window-controller) sender)
139  (declare (ignore sender)))
140
141(objc:defmethod (#/goBack: :void) ((wc ninspector-window-controller) sender)
142  (declare (ignore sender))
143  (set-current-inspector-item wc (- (next-index wc) 2)))
144
145(objc:defmethod (#/goForward: :void) ((wc ninspector-window-controller) sender)
146  (declare (ignore sender))
147  (set-current-inspector-item wc (next-index wc)))
148
149(objc:defmethod (#/doRefresh: :void) ((wc ninspector-window-controller) sender)
150  (declare (ignore sender))
151  (push-inspector-item wc (make-inspector-item (inspector-object (inspector-item wc)))))
152
153(defclass inspector-item (ns:ns-object)
154  ((lisp-inspector :accessor lisp-inspector)
155   (label :accessor inspector-item-label) ;NSString
156   (ob-string :accessor inspector-item-ob-string) ;NSString
157   (type :accessor inspector-item-type) ; oneof: nil :normal :colon :comment :static
158   (children :initform nil)) ;initialized lazily
159  (:metaclass ns:+ns-object))
160
161(defmethod inspector-item-children ((ii inspector-item))
162  (or (slot-value ii 'children)
163      (let* ((li (lisp-inspector ii)))
164        (when (null (inspector::inspector-line-count li))
165          (inspector::update-line-count li))       
166        (setf (slot-value ii 'children)
167            (make-array (inspector::inspector-line-count li) :initial-element nil)))))
168
169(defmethod inspector-object ((ii inspector-item))
170  (inspector::inspector-object (lisp-inspector ii)))
171
172(defmethod inspector-line-count ((ii inspector-item))
173  (let ((li (lisp-inspector ii)))
174    (or  (inspector::inspector-line-count li)
175         (progn
176           (inspector::update-line-count li)
177           (inspector::inspector-line-count li)))))
178
179(defun inspector-object-nsstring (ob)
180  (let ((*print-readably* nil)
181        (*signal-printing-errors* nil)
182        (*print-circle* t)
183        (*print-length* 20)
184        (*print-pretty* nil))
185    (%make-nsstring (prin1-to-string ob))))
186
187(defun make-inspector-item (value &optional label type)
188  (let* ((item (make-instance 'inspector-item))
189         (li (inspector::make-inspector value)))
190    (setf (lisp-inspector item) li
191          (inspector-item-ob-string item) (inspector-object-nsstring value)
192          (inspector-item-label item) label
193          (inspector-item-type item) type)
194    item))
195
196(defun make-inspector (ob)
197  (let* ((wc (make-instance 'ninspector-window-controller))
198         (ii (make-inspector-item ob)))
199    (push-inspector-item wc ii)
200    (#/showWindow: wc nil)
201    wc))
202
203(defmethod push-inspector-item ((wc ninspector-window-controller) (ii inspector-item))
204  (with-slots (next-index viewed-inspector-items) wc
205    (when (< next-index (fill-pointer viewed-inspector-items))
206      (setf (fill-pointer viewed-inspector-items) next-index))
207    (vector-push-extend ii viewed-inspector-items)
208    (incf next-index))
209  (set-enabled wc)
210  (setf (inspector-item wc) ii))
211
212(defmethod (setf inspector-item) ((ii inspector-item) (wc ninspector-window-controller))
213  (setf @@@ @@
214        @@ @
215        @ (inspector-object ii))
216  (setf (slot-value wc 'inspector-item) ii)
217  (let* ((w (#/window wc))
218         (title (inspector-item-ob-string ii)))
219    (#/setTitle: w (%make-nsstring (concatenate 'string  "Inspector: " 
220                                                (lisp-string-from-nsstring title))))
221    (#/setStringValue: (object-label wc) title)
222    (#/reloadData (table-view wc))))
223
224(defun ninspect (object)
225  (execute-in-gui #'(lambda () (make-inspector object))))
226
227
228#|
229The inspector-window-controller is specified in the nib file to be the data source for the NSTableView.
230In order to be a data source it must implement the NSTableDataSource protocol.
231
232The NSTableDataSource methods to get values for the NSTableView are:
233- (NSInteger)numberOfRowsInTableView:(NSTableView *)aTableView
234- (id)tableView:(NSTableView *)aTableView objectValueForTableColumn:(NSTableColumn *)aTableColumn row:(NSInteger)rowIndex
235
236For simplicity, the latter method returns NSStrings (it could return other types that need special formatting objects)
237
238If we want the table view to support other features such as setting, sorting, or drag and drop, other
239NSTableDataSource methods can be defined.
240|#
241
242
243(objc:defmethod (#/numberOfRowsInTableView: :<NSI>nteger) ((self ninspector-window-controller) table-view)
244  (declare (ignore table-view))
245  (1- (length (inspector-item-children (inspector-item self))))) ;skip first child which just contains the object itself
246
247(objc:defmethod #/tableView:objectValueForTableColumn:row: ((self ninspector-window-controller) table-view column (row :<NSI>nteger))
248  (declare (ignore table-view))
249  (let ((child (get-child (inspector-item self) row)))
250    (cond ((eql column (property-column self)) (inspector-item-label child))
251          ((eql column (value-column self)) (inspector-item-ob-string child))
252          ((#/isEqualToString: #@"property" (#/identifier column)) (inspector-item-label child))
253          ((#/isEqualToString: #@"value" (#/identifier column)) (inspector-item-ob-string child))
254          (t (progn
255               (log-debug "col: ~s prop-col: ~s val-col: ~s" column (property-column self) (value-column self))
256               #@"*error*")))))
257
258(defmethod get-child ((ii inspector-item) index)
259  (let ((arr (inspector-item-children ii))
260        (i (1+ index)))
261    (or (svref arr i)
262        (multiple-value-bind (ob label type) (inspector::line-n (lisp-inspector ii) i)
263          (setf (svref arr i) (make-inspector-item ob (%make-nsstring (princ-to-string label)) type))))))
264
265;;; Make INSPECT call CINSPECT.
266(setq inspector::*default-inspector-ui-creation-function* 'ninspect)
Note: See TracBrowser for help on using the repository browser.