[mcclim-devel] presenting expressions, nested presentations

[Christophe Rhodes]

Hi,

Wouldn't it be cool if, when we presented list data as an expression,
the contents were individually presented?

Well, consider the code at the end of this mail; it achieves this, but
at a price: we no longer respect *print-level*, *print-length* and
friends; we don't honour *pprint-dispatch-table* (which might have EQL
"methods" on these objects); and there appears not to be a way of
finding out what the user would prefer to be the :single-box attribute
of the nested presentations.

The *print-level*/*print-length* and friends could be worked on with a
little bit more code; the *pprint-dispatch-table* issue, however, is
rather more fundamental; if it can be handled at all, it would need to
be handled on an implementation-level basis (there's no
GET-PPRINT-DISPATCH exposed to the user, only SET-PPRINT-DISPATCH).  I
presume that the :single-box issue we can deal with ourselves by
inventing a special variable.

Really, what I would like to know is what the requirements for this
presentation method are.  What do I have to do to honour the
ACCEPTABLY keyword?  Is managing *print-level* and *print-length*
enough (well, presumably there's more work to be done to support
*print-array* and so on)?  Should we do this for user-defined
structures as well, where we can determine that there is no applicable
*pprint-dispatch-table* or PRINT-OBJECT method (fortunately, there can
be no user PRINT-OBJECT method on conses or vectors).  I suppose the
inevitable question is: what did the Lisp Machines do...?

Answers welcome!

Cheers,

Christophe

(define-presentation-method present 
    (object (type expression) stream (view textual-view) &key acceptably for-context-type)
  (declare (ignore for-context-type))
  (let ((*print-readably* acceptably))
    (typecase object
      (cons
       (with-output-as-presentation (stream object type :single-box t)
         (princ #\( stream)
         (do ((o object (cdr o)))
             ((null o))
           (present (car o) (presentation-type-of (car o)) 
                    :stream stream :view view)
           (cond
             ((null (cdr o)) (return))
             ((listp (cdr o)) (princ #\Space stream))
             (t (princ " . " stream)
                (present (cdr o) (presentation-type-of (cdr o)) 
                         :stream stream :view view)
                (return))))
         (princ #\) stream)))
      (simple-vector
       (with-output-as-presentation (stream object type :single-box t)
         (princ "#(" stream)
         (do ((i 0 (1+ i)))
             ((>= i (length object)))
           (present (svref object i) (presentation-type-of (svref object i)) 
                    :stream stream :view view)
           (when (>= i (1- (length object)))
             (return))
           (princ " " stream))
         (princ #\) stream)))
      (t (prin1 object stream)))))