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

Last change on this file since 11215 was 11215, checked in by gb, 12 years ago

At least a few methods that take (ignored) arguments were missing colons
at the end of their names.

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    wc))
201
202(defmethod push-inspector-item ((wc ninspector-window-controller) (ii inspector-item))
203  (with-slots (next-index viewed-inspector-items) wc
204    (when (< next-index (fill-pointer viewed-inspector-items))
205      (setf (fill-pointer viewed-inspector-items) next-index))
206    (vector-push-extend ii viewed-inspector-items)
207    (incf next-index))
208  (set-enabled wc)
209  (setf (inspector-item wc) ii))
210
211(defmethod (setf inspector-item) ((ii inspector-item) (wc ninspector-window-controller))
212  (setf @@@ @@
213        @@ @
214        @ (inspector-object ii))
215  (setf (slot-value wc 'inspector-item) ii)
216  (let* ((w (#/window wc))
217         (title (inspector-item-ob-string ii)))
218    (#/setTitle: w (%make-nsstring (concatenate 'string  "Inspector: " 
219                                                (lisp-string-from-nsstring title))))
220    (#/setStringValue: (object-label wc) title)
221    (#/reloadData (table-view wc))))
222
223(defun ninspect (object)
224  (execute-in-gui #'(lambda () (make-inspector object))))
225
226
227#|
228The inspector-window-controller is specified in the nib file to be the data source for the NSTableView.
229In order to be a data source it must implement the NSTableDataSource protocol.
230
231The NSTableDataSource methods to get values for the NSTableView are:
232- (NSInteger)numberOfRowsInTableView:(NSTableView *)aTableView
233- (id)tableView:(NSTableView *)aTableView objectValueForTableColumn:(NSTableColumn *)aTableColumn row:(NSInteger)rowIndex
234
235For simplicity, the latter method returns NSStrings (it could return other types that need special formatting objects)
236
237If we want the table view to support other features such as setting, sorting, or drag and drop, other
238NSTableDataSource methods can be defined.
239|#
240
241
242(objc:defmethod (#/numberOfRowsInTableView: :<NSI>nteger) ((self ninspector-window-controller) table-view)
243  (declare (ignore table-view))
244  (1- (length (inspector-item-children (inspector-item self))))) ;skip first child which just contains the object itself
245
246(objc:defmethod #/tableView:objectValueForTableColumn:row: ((self ninspector-window-controller) table-view column (row :<NSI>nteger))
247  (declare (ignore table-view))
248  (let ((child (get-child (inspector-item self) row)))
249    (cond ((eql column (property-column self)) (inspector-item-label child))
250          ((eql column (value-column self)) (inspector-item-ob-string child))
251          ((#/isEqualToString: #@"property" (#/identifier column)) (inspector-item-label child))
252          ((#/isEqualToString: #@"value" (#/identifier column)) (inspector-item-ob-string child))
253          (t (progn
254               (log-debug "col: ~s prop-col: ~s val-col: ~s" column (property-column self) (value-column self))
255               #@"*error*")))))
256
257(defmethod get-child ((ii inspector-item) index)
258  (let ((arr (inspector-item-children ii))
259        (i (1+ index)))
260    (or (svref arr i)
261        (multiple-value-bind (ob label type) (inspector::line-n (lisp-inspector ii) i)
262          (setf (svref arr i) (make-inspector-item ob (%make-nsstring (princ-to-string label)) type))))))
263
264;;; Make INSPECT call CINSPECT.
265(setq inspector::*default-inspector-ui-creation-function* 'ninspect)
Note: See TracBrowser for help on using the repository browser.