X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/fb04c0a8c71cd64e3a36cfed59a0224d44de2474..1d51a2eea8537084e9e681c297422047ae858989:/src/standard-display.lisp diff --git a/src/standard-display.lisp b/src/standard-display.lisp index 35d57e1..b8282c5 100644 --- a/src/standard-display.lisp +++ b/src/standard-display.lisp @@ -1,8 +1,26 @@ (in-package :lisp-on-lines) +(deflayer lisp-on-lines ()) + ;;;; The Standard Layers -(deflayer viewer) -(deflayer editor) +(deflayer viewer (lisp-on-lines)) +(deflayer editor (lisp-on-lines)) + +;;;; Attributes +(defdisplay + :in-layer editor + ((attribute standard-attribute) object) + (call-next-method)) + +(defdisplay + ((attribute standard-attribute) object component) + (<:as-html (attribute-value object attribute))) + +(define-layered-method display-using-description + ((attribute standard-attribute) object component) + (with-component (component) + ) + (<:as-html (attribute-value object attribute))) (define-layered-method label (anything) nil) @@ -20,12 +38,24 @@ This allows us to dispatch to a subclasses editor. (deflayer as-table) (deflayer as-string) +(defdisplay + :in-layer as-string (d o (self t)) + (with-output-to-string (yaclml::*yaclml-stream*) + (do-attributes (a d) + (display-attribute a o) + (<:as-html " ")) + #+nil (with-inactive-layers (editor viewer one-line as-table show-attribute-labels) +))) + + (defdisplay :in-layer as-string (d o) - (with-inactive-layers (editor viewer one-line as-table show-attribute-labels) + (with-output-to-string (yaclml::*yaclml-stream*) (do-attributes (a d) (display-attribute a o) - (<:as-is " ")))) + (<:as-html " ")) + #+nil (with-inactive-layers (editor viewer one-line as-table show-attribute-labels) +))) (defmethod list-slots (thing) (list 'identity)) @@ -49,7 +79,6 @@ This allows us to dispatch to a subclasses editor. "The default display for CLOS objects" (print (class-name (class-of object))) (dolist* (slot-name (list-slots object)) - (let ((boundp (slot-boundp object slot-name))) (format t "~A~A : ~A" (strcat slot-name) (if boundp @@ -105,7 +134,7 @@ This allows us to dispatch to a subclasses editor. ;;;; List Displays -(deflayer list-display-layer) +#| (deflayer list-display-layer) (define-layered-class description :in-layer list-display-layer () @@ -136,20 +165,9 @@ This allows us to dispatch to a subclasses editor. (dolist* (obj list) (<:tr (do-attributes (a desc) - (<:td (display-attribute a obj))))))))))) + (<:td (display-attribute a obj))))))))))) |# -;;;; Attributes -(defdisplay - :in-layer editor - ((attribute standard-attribute) object) - (call-next-method)) -(define-layered-method display-using-description - ((attribute standard-attribute) object component) - (with-component (component) - (