From: Kevin M. Rosenberg Date: Sat, 29 Aug 2015 06:17:15 +0000 (-0600) Subject: Merge branch 'master' of ssh://git.kpe.io/home/gitpub/hyperobject X-Git-Url: http://git.kpe.io/?p=hyperobject.git;a=commitdiff_plain;h=41f450532d8ead3125c528f1ad7a1614aae1f93a;hp=a88591e62595d2d25d5e6cfd29064d107c8b6b73 Merge branch 'master' of ssh://git.kpe.io/home/gitpub/hyperobject --- diff --git a/mop.lisp b/mop.lisp index 47a2aae..0771543 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 'cdata) + (and (listp type) (some #'(lambda (x) (or (eq x 'string) + (eq x 'cdata))) + type)))) + (defun base-value-type (value-type) (if (atom value-type) value-type diff --git a/package.lisp b/package.lisp index 509b34e..392caa6 100644 --- a/package.lisp +++ b/package.lisp @@ -49,6 +49,7 @@ #:processed-queued-definitions #:all-subobjects #:subobjects + #:cdata )) (defpackage #:hyperobject-user 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)))