From 40664cbb437f6d5134d08a473baff533ff268c29 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 9 Apr 2013 01:36:41 -0600 Subject: [PATCH] Fix xml printing --- mop.lisp | 7 +++++++ views.lisp | 56 +++++++++++++++++++++++++++--------------------------- 2 files changed, 35 insertions(+), 28 deletions(-) diff --git a/mop.lisp b/mop.lisp index 47a2aae..96eb325 100644 --- a/mop.lisp +++ b/mop.lisp @@ -402,6 +402,13 @@ SQL name" (or (eq type 'string) (and (listp type) (some #'(lambda (x) (eq x 'string)) type)))) +(defun value-type-is-a-string (type) + (or (eq type 'string) + (eq type 'u::cdata) + (and (listp type) (some #'(lambda (x) (or (eq x 'string) + (eq x 'u::cdata))) + type)))) + (defun base-value-type (value-type) (if (atom value-type) value-type diff --git a/views.lisp b/views.lisp index dde22fc..fcd132d 100644 --- a/views.lisp +++ b/views.lisp @@ -284,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)))))) @@ -594,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 "~%" name)) - (setf (subobj-end-printer view) (format nil "~%" name)) +;; (setf (subobj-end-printer view) (format nil "~%" name)) + (setf (subobj-end-printer view) nil) (setf (subobj-end-indent view) nil) (setf (obj-data-indent view) nil))) -- 2.34.1