source: trunk/source/examples/cocoa-inspector.lisp @ 8495

Last change on this file since 8495 was 8495, checked in by jaj, 12 years ago

Move old inspector to examples

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 22.2 KB
Line 
1;;;-*-Mode: LISP; Package: GUI -*-
2
3(in-package "GUI")
4
5#|
6(cinspect <thing>)
7
8A cocoa-based lisp inspector, LGPL'ed by Hamilton Link
9
10This code is freely distributable, etc. but I would appreciate people
11submitting changes back to me and making suggestions about how it
12could be altered or improved to me rather than starting a totally
13separate inspector.
14
15Major plans:
16 Shift all the browser columns over to allow the first column to just have the object
17 Make double-clicking an object bring any existing inspector for that object to the front unless shift key is held
18
19Minor tweaks:
20  test on all sorts of things for sanity of leaf-ness of nodes and fields
21  test on all sorts of things for santity in what's safely editable in table view
22  fix the leaf-ness fields with a macptr value
23  change the font to something smaller (or even better, be settable)
24  clean up this file, maybe make a dedicated cinspector package for such things
25  document lessons learned about NSBrowser and NSTableView for next time
26
27Bugs:
28  - when selecting a non-item in a lower column that was just being
29  displayed (in the NSBrowser), the tableview isn't cleared and it
30  probably should be.
31
32  Possibly a reasonable next thing after that would be to make control-
33or alt-double-clicking open new windows with other browsing metaphors
34appropriate to the object (like a class heirarchy browser, maybe a
35table view for matrices, etc.), we'll see.
36  Eventually I'd like to expand the whole inspector functionality to
37deal with ObjC things (methods and objects) and C foreign data in
38general, but that's further off unless someone wants to take a crack
39at it. Once we know we've got a macptr into ObjC we can deal, but some
40very carefully written functions need to exist to safely interrogate
41a random pointer to make that determination.
42
43Note the variable name convention in this file: "cinspector" refers to
44a cocoa-inspector object containing a set of objects being displayed,
45while "inspector" refers to an inspector object from the :inspector
46package, which are used for command-line inspecting.
47
48|#
49
50
51#|
52I'd rather set up this file to be
53- in-package cl-user
54- require of some things
55- a package definition for this code that brings in inspector::this-and-that and ccl::objc-stuff
56- a couple of load-file forms that populate the new package and have the bulk of the following code
57|#
58
59;;; This is useful when @ won't work, dynamically creating a NSString
60;;; pointer from a string.
61
62(defun nsstringptr (string)
63  (ccl::objc-constant-string-nsstringptr
64   (ccl::ns-constant-string string)))
65
66#+old
67(defmacro handler-case-for-cocoa (id form)
68  (declare (ignorable id))
69  `(handler-case
70    ,form
71    (condition (c)
72      (declare (ignorable c))
73      #+ignore
74      (format t "~s: Trapping condition: ~a" ,id c)
75      nil)))
76
77; for now this will map windows to objects -- the windows are pretty big,
78; though, so it would be nice to extend them so the list of inspected objects
79; is switchable in a single window (shouldn't be too hard once basic functionality
80; is slapped down)
81(defparameter *cocoa-inspector-nswindows-table* (make-hash-table :test 'eql))
82
83;;; this is what a window should map to - an object that manages all
84;;; the data a window might be displaying
85(defclass cocoa-inspector ()
86  ((object-vector :initform (make-array 0 :adjustable t :fill-pointer 0) :accessor object-vector)
87   (inspector-vector :initform (make-array 0 :adjustable t :fill-pointer 0) :accessor inspector-vector)
88   (focal-point :initform 0 :accessor focal-point)))
89
90;;; note that ELT pays attention to the fill pointer, while AREF doesn't!
91(defmethod object ((cinspector cocoa-inspector))
92  (elt (object-vector cinspector) (focal-point cinspector)))
93(defmethod nth-object ((cinspector cocoa-inspector) n)
94  (elt (object-vector cinspector) n))
95(defmethod inspector ((cinspector cocoa-inspector))
96  ;; This can return nil.
97  (let* ((i (focal-point cinspector))
98         (v (inspector-vector cinspector))
99         (n (length v)))
100    (if (< i n)
101      (aref v i))))
102(defmethod nth-inspector ((cinspector cocoa-inspector) n)
103  (elt (inspector-vector cinspector) n))
104(defmethod push-object (object (cinspector cocoa-inspector))
105  (let ((inspector (inspector::make-inspector object)))
106    (vector-push-extend object (object-vector cinspector))
107    (vector-push-extend inspector (inspector-vector cinspector))
108    (inspector::update-line-count inspector))
109  #+ignore
110  (format t "    after push-object, fill pointers = ~a ~a~%"
111          (fill-pointer (object-vector cinspector)) (fill-pointer (inspector-vector cinspector)))
112  object)
113(defmethod (setf max-column) (value (cinspector cocoa-inspector))
114  (when (and (numberp value) (<= 0 value (1- (fill-pointer (object-vector cinspector)))))
115    (setf ; new fill-pointers are just outside of the valid bounds
116          (fill-pointer (object-vector cinspector)) (1+ value)
117          (fill-pointer (inspector-vector cinspector)) (1+ value)
118          ; new focal point is either what it was before, or the new max column if that's smaller
119          (focal-point cinspector) (min value (focal-point cinspector)))
120    #+ignore
121    (format t "  after (setf max-column), fill pointers = ~a ~a~%"
122            (fill-pointer (object-vector cinspector)) (fill-pointer (inspector-vector cinspector)))
123    value))
124
125;; In the browser view, we'll find the element for some column
126;; and consider whether any of its components merit further inspection
127;; and, if so, which ones
128(defmethod leaf-node-p ((thing t)) nil)
129(defmethod leaf-node-p ((thing (eql t))) t)
130(defmethod leaf-node-p ((thing null)) t)
131(defmethod leaf-node-p ((thing number)) t)
132(defmethod leaf-node-p ((thing string)) t)
133(defmethod leaf-node-p ((thing inspector::unbound-marker)) t)
134(defmethod leaf-field-p ((thing t) n)
135  (declare (ignore n))
136  nil) ; for a non-leaf node, all fields are futher probable by default
137(defmethod leaf-field-p ((thing symbol) n)
138  (when (and (keywordp thing) (= n 4)) t))
139
140; whatever is currently the selected object in the inspector, get its
141; properties and values for the tableView and print them to a string
142(defun focus-nth-line (cinspector n)
143  (let* ((inspector (inspector cinspector))
144         (*print-circle* t)
145         (output-stream (make-string-output-stream)))
146    (inspector::prin1-line-n inspector output-stream n)
147    (get-output-stream-string output-stream)))
148(defun nth-object-nth-line (cinspector obj-n line-n)
149  (let* ((inspector (nth-inspector cinspector obj-n))
150         (*print-circle* t)
151         (output-stream (make-string-output-stream)))
152    (inspector::prin1-line-n inspector output-stream line-n)
153    (get-output-stream-string output-stream)))
154(defun focus-nth-property (cinspector n)
155  (let ((inspector (inspector cinspector)))
156    (multiple-value-bind (value label type) (inspector::line-n inspector n)
157      (declare (ignore value type))
158      (if label
159          (format nil "~a" label)
160        ""))))
161(defun focus-nth-value (cinspector n)
162  (let* ((inspector (inspector cinspector))
163         (*print-circle* t)
164         (output-stream (make-string-output-stream))
165         (*package* (find-package :cl-user)))
166    (multiple-value-bind (value label type) (inspector::line-n inspector n)
167      (declare (ignore label type))
168      (format output-stream "~s" value))
169    (get-output-stream-string output-stream)))
170(defun nth-object-nth-value (cinspector obj-n line-n)
171  (let ((inspector (nth-inspector cinspector obj-n)))
172    (multiple-value-bind (value label type) (inspector::line-n inspector line-n)
173      (declare (ignore label type))
174      value)))
175(defun (setf focus-nth-value) (value cinspector n)
176  (let ((inspector (inspector cinspector)))
177    (setf (inspector::line-n inspector n) value)))
178(defun focus-nth-value-editable (cinspector n)
179  (let ((inspector (inspector cinspector)))
180    (multiple-value-bind (value label type) (inspector::line-n inspector n)
181      (declare (ignore value))
182      (and (or (null type)
183               (eq :normal type)
184               (eq :colon type))
185           (editable-field-p (object cinspector) n label)))))
186(defun nth-object-nth-value-editable (cinspector obj-n line-n)
187  (let ((inspector (nth-inspector cinspector obj-n)))
188    (multiple-value-bind (value label type) (inspector::line-n inspector line-n)
189      (declare (ignore value))
190      (and (or (null type)
191               (eq :normal type)
192               (eq :colon type))
193           (editable-field-p (nth-object cinspector obj-n) line-n label)))))
194;; for now most of these will assume that field numbers are good enough,
195;; certain things have inspector fields that move around (like symbols)
196;; and can be dealt with on a case by case basis, but that's the reason
197;; for passing in the label along with the field number
198(defmethod editable-field-p ((thing t) n label)
199  (declare (ignore n label))
200  t)
201;; for lists field 4 is length, could cause a change but inspector doesn't just handle it
202;; and at the moment I haven't started thinking of a framework for allowing such extensions
203(defmethod editable-field-p ((thing list) n label)
204  (declare (ignore label))
205  (/= n 4))
206
207#|
208I think most of the following should be pretty straightforward for
209most utilities meant to run under openmcl: A NIB file, some delegates
210and data sources, and some specialized callback functions for talking
211with the ObjC world, and some standard code for keeping track of the
212appropriate windows.  -hel
213|#
214
215; When loading a NIB file with an NSWindowController, DON'T omit the .nib extension
216; if you're calling initWithWindowNibPath:owner: (even though the documentation says you should!)
217#+ignore
218(defparameter *default-inspector-nib-pathname* #p"CCL:OpenMCL.app;Contents;Resources;English.lproj;OpenmclInspector.nib")
219; When loading it with a custom WindowController and initWithWindowNibName:, just the main file name
220(defparameter *default-inspector-nib-pathname* #p"OpenmclInspector")
221
222;; Q: Is this subclass of NSBrowser enabling the doubleAction? I added it expecting to have to
223;; specialize mouseDown (or whatever) to track double-clicking, but it just started working.
224(defclass inspector-ns-browser (ns:ns-browser) ; just to specialize mousing, not add slots
225    ()
226  (:metaclass ns:+ns-object))
227
228(defclass inspector-window-controller (ns:ns-window-controller)
229    ((inspector-browser :foreign-type :id :reader inspector-browser))
230  (:metaclass ns:+ns-object))
231
232(defclass inspector-browser-delegate (ns:ns-object)
233    ((inspector-table-view :foreign-type :id :reader inspector-table-view)
234     (inspector-window :foreign-type :id :reader inspector-window))
235  (:metaclass ns:+ns-object))
236
237; why is the order of these two slots important?
238; I get a segfault selecting the browser when they're in window/browser order after doing modifications in the table.
239(defclass inspector-table-view-data-source (ns:ns-object)
240    ((inspector-browser :foreign-type :id :reader inspector-browser)
241     (inspector-window :foreign-type :id :reader inspector-window))
242  (:metaclass ns:+ns-object))
243
244(defclass inspector-table-view-delegate (ns:ns-object)
245    ((inspector-window :foreign-type :id :reader inspector-window))
246  (:metaclass ns:+ns-object)) 
247
248
249;;; is there some reason this is called before the cell is actually
250;;; selected? In any case, when a non-leaf cell is selected, this
251;;; function is called first for the new column, so it has to push the
252;;; new element into the cinspector -- what the browserAction will be
253;;; left doing it remains to be seen. The only other time this is
254;;; called AFAICT is when loadColumnZero or reloadColumn is called
255(objc:defmethod (#/browser:numberOfRowsInColumn: :<NSI>nteger)
256    ((self inspector-browser-delegate)
257     browser
258     (column :<NSI>nteger))
259  (or (let* ((cinspector (gethash (inspector-window self) *cocoa-inspector-nswindows-table*))
260             (selected-column (#/selectedColumn browser)) ; probably always (1- column), when a column is selected
261             (cinspector-column (1- selected-column)) ; 2nd column of nsbrowser <-> 1st column of cinspector
262             (row (#/selectedRowInColumn: browser selected-column)))
263        #+ignore
264        (format t "getting length of column ~d based on row ~d in column ~d~%" column row selected-column)
265        (cond ((not cinspector) 0)
266              ((= column 0) 1)          ; just displaying the printed representaiton of the top inspected object
267              ((= selected-column 0)    ; selected the printed rep of the inspected object (column should = 1)
268               (setf (max-column cinspector) 0) ; crop object-vector in cinspector
269               (let ((inspector (nth-inspector cinspector 0))) ; inspector for top object
270                 (inspector::inspector-line-count inspector)))
271              ((>= selected-column 1)   ; (-1 is the N/A column)
272               (setf (max-column cinspector) cinspector-column) ; crop object-vector in cinspector
273               (push-object (nth-object-nth-value cinspector cinspector-column row) cinspector)
274               (let ((inspector (nth-inspector cinspector (1+ cinspector-column)))) ; inspector for object just pushed
275                 (inspector::inspector-line-count inspector)))))
276      0))
277
278#|
279;; temporarily saved in case the above fails horribly
280    (if cinspector
281        (handler-case
282         (progn (when (<= 0 selected-column) ; -1 is sort of the N/A column
283                  (setf (max-column cinspector) selected-column)
284                  (push-object (nth-object-nth-value cinspector selected-column row) cinspector))
285                (let ((inspector (nth-inspector cinspector column)))
286                  (inspector::inspector-line-count inspector)))
287         (condition () 0))
288      0)))
289|#
290
291;; In the following method defn this is unnecessary, the Browser can tell this for itself
292;; [cell "setLoaded:" :<BOOL> #$YES]
293(objc:defmethod (#/browser:willDisplayCell:atRow:column: :void)
294    ((self inspector-browser-delegate)
295     browser
296     cell
297     (row :<NSI>nteger)
298     (column :<NSI>nteger))
299  (declare (ignorable browser column))
300  (let ((cinspector (gethash (inspector-window self) *cocoa-inspector-nswindows-table*))
301        (cinspector-column (1- column))) ; 2nd column of nsbrowser <-> 1st column of cinspector
302    #+ignore
303    (format t "asking for value for column ~a, row ~a~%" column row)
304    (cond ((not cinspector) nil)
305          ((= column 0)
306           (#/setStringValue: cell  (nsstringptr (format nil "~s" (nth-object cinspector 0))))
307           (#/setLeaf: cell nil))
308          (t
309           ;; when switching between widgets to the browser, we can
310           ;; have reloaded a column and need to drill down a row
311           ;; from where we are at the moment
312           (#/setStringValue: cell  (nsstringptr (nth-object-nth-line cinspector cinspector-column row)))
313           ;; leaf-p should really consider the type of the object in
314           ;; question (eventually taking into account whether we're
315           ;; browsing the class heirarchy or into objc or whatever)
316           (#/setLeaf: cell (or (leaf-node-p (nth-object cinspector cinspector-column)) ; i.e. no fields drill down
317                                (leaf-field-p (nth-object cinspector cinspector-column) row)
318                                ;; for now...
319                                (= row 0)
320                                (not (nth-object-nth-value-editable cinspector cinspector-column row))))))))
321
322;;; when all is said and done and once the cinspector is properly
323;;; populated, the selected object in the browser's nth column is
324;;; actually the object in the cinspector's nth column (i.e. because
325;;; the selected object is displayed in the next browser column over,
326;;; and the cinspector and nsbrowser have a 1-off discrepancy, they
327;;; cancel out) -- just a note to make the difference between these
328;;; next two functions and the previous two functions
329
330;;; change the focus of the the table view to be the selected object
331(objc:defmethod (#/browserAction: :void)
332    ((self inspector-browser-delegate)
333     sender); don't know why I'd want to, but could use a separate IBTarget class
334  #+ignore (format t "browserAction~%")
335  (let* ((cinspector (gethash (inspector-window self) *cocoa-inspector-nswindows-table*))
336         (column (#/selectedColumn sender)))
337    (when (<= 0 column)
338      (setf (focal-point cinspector) column)
339      (#/reloadData (inspector-table-view self))
340      #+ignore
341      (format t "      responding to selection in column ~d~%" column))))
342
343;; open a new inspector on the selected object
344(objc:defmethod (#/browserDoubleAction: :void)
345    ((self inspector-browser-delegate)
346     sender)
347  #+ignore (format t "browserDoubleAction~%")
348  (let* ((cinspector (gethash (inspector-window self) *cocoa-inspector-nswindows-table*))
349         (column (#/selectedColumn sender)))
350    (when (< -1 column (length (object-vector cinspector)))
351      ;; this seems to work, but I'm not really paying attention to
352      ;; thread stuff...
353      (cinspect (nth-object cinspector column)))))
354
355(objc:defmethod (#/numberOfRowsInTableView: :<NSI>nteger)
356    ((self inspector-table-view-data-source)
357     table-view)
358  (declare (ignore table-view))
359 
360  (or (let ((cinspector (gethash (inspector-window self) *cocoa-inspector-nswindows-table*)))
361        (if cinspector
362          (let ((inspector (inspector cinspector)))
363            (if inspector
364              (inspector::inspector-line-count inspector)
365              0))))
366      0))
367
368(objc:defmethod #/tableView:objectValueForTableColumn:row:
369    ((self inspector-table-view-data-source)
370     table-view
371     table-column
372     (row :<NSI>nteger))
373  (declare (ignore table-view))
374  (let ((cinspector (gethash (inspector-window self) *cocoa-inspector-nswindows-table*)))
375    (cond ((not cinspector)
376           #@"")
377          ((#/isEqual: (#/identifier table-column) #@"property")
378           (nsstringptr (focus-nth-property cinspector row)))
379          ((#/isEqual: (#/identifier table-column) #@"value")
380           (nsstringptr (focus-nth-value cinspector row))))))
381
382;; I'm hoping that the delegate will prevent this from being called willy-nilly
383(objc:defmethod (#/tableView:setObjectValue:forTableColumn:row: :void)
384    ((self inspector-table-view-data-source)
385     table-view object table-column (row :<NSI>nteger))
386  (declare (ignore table-column))
387   (let ((cinspector (gethash (inspector-window self) *cocoa-inspector-nswindows-table*)))
388     ;; without any formatters, object appears to be an NSCFString
389     ;; also note we should probably save the original value (including unboundness etc)
390     ;; first so that we can return to it in the event of any error
391     ;; plus we should avoid doing anything if the original string and the new string are equal
392     (when cinspector
393       (setf (focus-nth-value cinspector row)
394             (let ((*package* (find-package :cl-user)))
395               ;; with-autorelease-pool could possibly be needed to
396               ;; autorelease the cString we're handling (I think)
397               (eval (read-from-string (lisp-string-from-nsstring object)))))
398       (#/reloadData table-view) ; really could just reload that one cell, but don't know how...
399       ;; changing the focused object may effect the browser's path,
400       ;; reload its column and keep the cinspector consistent Here we
401       ;; have to make sure that the column we're reloading and the
402       ;; column after both have values to display, for when
403       ;; reloadColumn: invokes browser:willDisplayCell:atRow:column:
404       (#/reloadColumn: (inspector-browser self) (focal-point cinspector))
405       ;; [inspector-browser "scrollColumnToVisible:" :int (focal-point cinspector)] ; maybe need this, too
406       )))
407
408;;; In the table view, the properties are not editable, but the
409;;; values (if editable) allow lisp forms to be entered that are
410;;; read and evaluated to determine the new property value.
411(objc:defmethod (#/tableView:shouldEditTableColumn:row: :<BOOL>)
412    ((self inspector-table-view-delegate)
413     table-view table-column (row :<NSI>nteger))
414  (declare (ignore table-view))
415  (let ((cinspector (gethash (inspector-window self) *cocoa-inspector-nswindows-table*)))
416    (and cinspector
417         (#/isEqual: (#/identifier table-column) #@"value")
418         (/= row 0)                     ; in practice the reference to
419                                        ; the object isn't editable, and
420                                        ; the GUI semantics aren't clear anyway,
421                                        ; possibly there will come a
422                                        ; time when I put row 0 in the
423                                        ; table title, but I need to
424                                        ; maintain the 0-indexed
425                                        ; focus-nth-whatever API here
426                                        ; and elsewhere if I do that
427         (focus-nth-value-editable cinspector row))))
428
429;; the inspectorwindowcontroller is set up as the delegate of the window...
430;; we now eliminate the dangling pointer to the window from the hash table
431(objc:defmethod (#/windowWillClose: :void)
432    ((self inspector-window-controller) notification)
433  (let ((nswindow (#/object notification)))
434    (remhash nswindow *cocoa-inspector-nswindows-table*)))
435
436;;; hopefully a generally useful function
437(defun load-windowcontroller-from-nib (wc-classname nib-pathname)
438  "Takes a NIB name and returns a new window controller"
439  (with-autorelease-pool
440      (make-instance 
441       wc-classname
442       :with-window-nib-name (nsstringptr (namestring nib-pathname)))))
443
444;;; make a new inspector window from the nib file, and hash the window's
445;;; browser and tableview to the object
446(defun cinspect (object)
447  (with-autorelease-pool
448      (let* ((windowcontroller (load-windowcontroller-from-nib 'inspector-window-controller *default-inspector-nib-pathname*))
449             (window (#/window windowcontroller))
450             (cinspector (make-instance 'cocoa-inspector)))
451        ;; set up the window's initial "focused" object -- this may change as
452        ;; different parts of the inspector are clicked on, and actually we
453        ;; probably want to track more information than that associated with the
454        ;; window, so probably this will eventually be hashed to something like
455        ;; an inspector for the object or an even bigger wrapper
456        (setf (gethash window *cocoa-inspector-nswindows-table*) cinspector)
457        (push-object object cinspector)
458        ;; is this working? it isn't breaking, but double-clicking is
459        ;; being handled as two single actions
460        (let* ((browser (inspector-browser windowcontroller)))
461          (#/setColumnResizingType: browser #$NSBrowserUserColumnResizing)
462          (#/setPrefersAllColumnUserResizing: browser nil)
463          (#/setDoubleAction: browser (@selector #/browserDoubleAction:))
464          (#/setIgnoresMultiClick: browser t))
465        (#/showWindow: windowcontroller window)
466        window)))
467
468;;; Make INSPECT call CINSPECT.
469(setq inspector::*default-inspector-ui-creation-function* 'cinspect)
Note: See TracBrowser for help on using the repository browser.