X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=sidebyside;f=views.lisp;h=fcd132d647aab0108c1cf5e05b63150961ad57fb;hb=40664cbb437f6d5134d08a473baff533ff268c29;hp=db6bba64d316a2ad8f7bbe00499c06e230deccf9;hpb=4a772392fd77659637f19c6d0b69584974a40074;p=hyperobject.git
diff --git a/views.lisp b/views.lisp
index db6bba6..fcd132d 100644
--- a/views.lisp
+++ b/views.lisp
@@ -244,35 +244,37 @@
(defun ppfc-html-labels (label name type formatter cdata print-func)
(vector-push-extend '(write-string "" s) print-func)
- (vector-push-extend `(write-string ,label s) print-func)
+ (vector-push-extend `(when (stringp ,label) (write-string ,label s)) print-func)
(vector-push-extend '(write-string " " s) print-func)
(ppfc-html label name type formatter cdata print-func))
(defun ppfc-xhtml-labels (label tag name type formatter cdata print-func)
(vector-push-extend '(write-string "" s) print-func)
- (vector-push-extend `(write-string ,label s) print-func)
+ (vector-push-extend `(when (stringp ,label) (write-string ,label s)) print-func)
(vector-push-extend '(write-string " " s) print-func)
(ppfc-html tag name type formatter cdata print-func))
(defun ppfc-xml-labels (label tag name type formatter cdata print-func)
(vector-push-extend '(write-string " " s) print-func)
(ppfc-xml tag name type formatter cdata print-func))
(defun ppfc-html-link (name type formatter cdata nlink print-func)
(declare (fixnum nlink))
(vector-push-extend '(write-char #\< s) print-func)
- (vector-push-extend `(write-string (nth ,(+ nlink nlink) links) s) print-func)
+ (vector-push-extend `(when (stringp (nth ,(+ nlink nlink) links))
+ (write-string (nth ,(+ nlink nlink) links) s)) print-func)
(vector-push-extend '(write-char #\> s) print-func)
(vector-push-extend `(write-ho-value x ',name ',type ',formatter ,cdata s) print-func)
(vector-push-extend '(write-string "" s) print-func)
- (vector-push-extend `(write-string (nth ,(+ nlink nlink 1) links) s) print-func)
+ (vector-push-extend `(when (stringp (nth ,(+ nlink nlink 1) links))
+ (write-string (nth ,(+ nlink nlink 1) links) s)) print-func)
(vector-push-extend '(write-char #\> s) print-func))
(defun ppfc-html-link-labels (label name type formatter cdata nlink print-func)
(vector-push-extend '(write-string "" s) print-func)
- (vector-push-extend `(write-string ,label s) print-func)
+ (vector-push-extend `(when (stringp ,label) (write-string ,label s)) print-func)
(vector-push-extend '(write-string " " s) print-func)
(ppfc-html-link name type formatter cdata nlink print-func))
@@ -282,62 +284,61 @@
(user-name (esd-user-name slot))
(xml-user-name (escape-xml-string user-name))
(xml-tag (escape-xml-string user-name))
- (type (slot-definition-type slot))
-
- (cdata (not (null
- (and (in vid :xml :xhtml :xml-link :xhtml-link
- :xml-labels :ie-xml-labels
- :xhtml-link-labels :xml-link-labels :ie-xml-link
- :ie-xml-link-labels)
- (or formatter
- (lisp-type-is-a-string type))))))
+ (value-type (slot-value slot 'value-type))
+ (cdata (and (in vid :xml :xhtml :xml-link :xhtml-link
+ :xml-labels :ie-xml-labels
+ :xhtml-link-labels :xml-link-labels :ie-xml-link
+ :ie-xml-link-labels)
+ (or formatter
+ (value-type-is-a-string value-type))
+ t))
(hyperlink (esd-hyperlink slot)))
(case vid
(:compact-text
(vector-push-extend
- `(write-ho-value x ',name ',type ',formatter ,cdata s) print-func))
+ `(write-ho-value x ',name ',value-type ',formatter ,cdata s) print-func))
(:compact-text-labels
(vector-push-extend `(write-string ,user-name s) print-func)
(vector-push-extend '(write-char #\space s) print-func)
(vector-push-extend
- `(write-ho-value x ',name ',type ',formatter ,cdata s) print-func))
+ `(write-ho-value x ',name ',value-type ',formatter ,cdata s) print-func))
((or :html :xhtml)
- (ppfc-html user-name name type formatter cdata print-func))
+ (ppfc-html user-name name value-type formatter cdata print-func))
(:xml
- (ppfc-xml xml-tag name type formatter cdata print-func))
+ (ppfc-xml xml-tag name value-type formatter cdata print-func))
(:html-labels
- (ppfc-html-labels user-name name type formatter cdata print-func))
+ (ppfc-html-labels user-name name value-type formatter cdata print-func))
(:xhtml-labels
- (ppfc-xhtml-labels xml-user-name user-name name type formatter cdata print-func))
+ (ppfc-xhtml-labels xml-user-name user-name name value-type formatter cdata print-func))
((:display-table :display-table-labels)
- (ppfc-display-table user-name name type formatter cdata print-func))
+ (ppfc-display-table user-name name value-type formatter cdata print-func))
(:xml-labels
- (ppfc-xml-labels xml-user-name xml-tag name type formatter cdata print-func))
+ (ppfc-xml-labels xml-user-name xml-tag name value-type formatter cdata print-func))
((or :html-link :xhtml-link)
(if hyperlink
- (ppfc-html-link name type formatter cdata nlink print-func)
- (ppfc-html user-name name type formatter cdata print-func)))
+ (ppfc-html-link name value-type formatter cdata nlink print-func)
+ (ppfc-html user-name name value-type formatter cdata print-func)))
((or :xml-link :ie-xml-link)
(if hyperlink
- (ppfc-html-link name type formatter cdata nlink print-func)
- (ppfc-xml xml-tag name type formatter cdata print-func)))
+ (ppfc-html-link name value-type formatter cdata nlink print-func)
+ (ppfc-xml xml-tag name value-type formatter cdata print-func)))
(:html-link-labels
(if hyperlink
- (ppfc-html-link-labels user-name name type formatter cdata nlink
+ (ppfc-html-link-labels user-name name value-type formatter cdata nlink
print-func)
- (ppfc-html-labels user-name name type formatter cdata print-func)))
+ (ppfc-html-labels user-name name value-type formatter cdata print-func)))
(:xhtml-link-labels
(if hyperlink
- (ppfc-html-link-labels xml-user-name name type formatter cdata nlink
+ (ppfc-html-link-labels xml-user-name name value-type formatter cdata nlink
print-func)
- (ppfc-xhtml-labels xml-tag user-name name type formatter cdata
+ (ppfc-xhtml-labels xml-tag user-name name value-type formatter cdata
print-func)))
((or :xml-link-labels :ie-xml-link-labels)
(if hyperlink
- (ppfc-html-link-labels xml-user-name name type formatter cdata nlink
+ (ppfc-html-link-labels xml-user-name name value-type formatter cdata nlink
print-func)
- (ppfc-xml-labels xml-tag user-name name type formatter cdata
+ (ppfc-xml-labels xml-tag user-name name value-type formatter cdata
print-func))))))
@@ -592,7 +593,8 @@
(setf (obj-start-printer view) (format nil "<~(~a~)>" name))
(setf (obj-start-indent view) t)
(setf (obj-end-printer view) (format nil "~(~a~)>~%" name))
- (setf (subobj-end-printer view) (format nil "~(~a~)>~%" name))
+;; (setf (subobj-end-printer view) (format nil "~(~a~)>~%" name))
+ (setf (subobj-end-printer view) nil)
(setf (subobj-end-indent view) nil)
(setf (obj-data-indent view) nil)))