-(defun htmlformat-list-start-value-func (x nitems)
- (values (hyperobject-class-user-name x) nitems (class-name-of x)))
-
-(defclass htmlformat (textformat)
- ()
- (:default-initargs :file-start-str "<html><body>~%"
- :file-end-str "</body><html>~%"
- :list-start-indent t
- :list-start-fmtstr "<p><b>~a~p:</b></p><div class=\"~A\"><ul>~%"
- :list-start-value-func #'htmlformat-list-start-value-func
- :list-end-fmtstr "</ul></div>~%"
- :list-end-indent t
- :list-end-value-func #'identity
- :obj-start-indent t
- :obj-start-fmtstr "<li>"
- :obj-start-value-func #'identity
- :obj-end-indent t
- :obj-end-fmtstr "</li>~%"
- :obj-end-value-func #'identity
- :obj-data-indent t
- :obj-data-fmtstr #'hyperobject-class-fmtstr-html-labels
- :obj-data-fmtstr-labels #'hyperobject-class-fmtstr-html-labels
- :obj-data-value-func #'hyperobject-class-value-func))
-
-(defclass xhtmlformat (textformat)
- ()
- (:default-initargs :file-start-str "<html><body>~%"
- :file-end-str "</body><html>~%"
- :list-start-indent t
- :list-start-fmtstr "<p><b>~a~p:</b></p><div class=\"~A\"><ul>~%"
- :list-start-value-func #'htmlformat-list-start-value-func
- :list-end-fmtstr "</ul></div>~%"
- :list-end-indent t
- :list-end-value-func #'identity
- :obj-start-indent t
- :obj-start-fmtstr "<li>"
- :obj-start-value-func #'identity
- :obj-end-indent t
- :obj-end-fmtstr "</li>~%"
- :obj-end-value-func #'identity
- :obj-data-indent t
- :obj-data-fmtstr #'hyperobject-class-fmtstr-html-labels
- :obj-data-fmtstr-labels #'hyperobject-class-fmtstr-html-labels
- :obj-data-value-func #'hyperobject-class-xmlvalue-func))
-
-
-(defun xmlformat-list-end-value-func (x)
- (format nil "~alist" (class-name-of x)))
-
-(defun xmlformat-list-start-value-func (x nitems)
- (values (format nil "~alist" (class-name-of x)) (hyperobject-class-user-name x) nitems))
-
-(defclass xmlformat (textformat)
- ()
- (:default-initargs :file-start-str "" ; (std-xml-header)
- :list-start-indent t
- :list-start-fmtstr "<~a><title>~a~p:</title> ~%"
- :list-start-value-func #'xmlformat-list-start-value-func
- :list-end-indent t
- :list-end-fmtstr "</~a>~%"
- :list-end-value-func #'xmlformat-list-end-value-func
- :obj-start-fmtstr "<~a>"
- :obj-start-value-func #'class-name-of
- :obj-start-indent t
- :obj-end-fmtstr "</~a>~%"
- :obj-end-value-func #'class-name-of
- :obj-end-indent nil
- :obj-data-indent nil
- :obj-data-fmtstr #'hyperobject-class-fmtstr-xml
- :obj-data-fmtstr-labels #'hyperobject-class-fmtstr-xml-labels
- :obj-data-value-func #'hyperobject-class-xmlvalue-func))
-
-(defclass link-ref ()
- ((fmtstr :type function :initarg :fmtstr :accessor fmtstr)
- (fmtstr-labels :type function :initarg :fmtstr-labels :accessor fmtstr-labels)
- (page-name :type string :initarg :page-name :accessor page-name)
- (href-head :type string :initarg :href-head :accessor href-head)
- (href-end :type string :initarg :href-end :accessor href-end)
- (ampersand :type string :initarg :ampersand :accessor ampersand))
- (:default-initargs :fmtstr nil
- :fmtstr-labels nil
- :page-name "disp-func1"
- :href-head nil :href-end nil :ampersand nil)
- (:documentation "Formatting for a linked hyperlink"))
-
-(defclass html-link-ref (link-ref)
- ()
- (:default-initargs :fmtstr #'hyperobject-class-fmtstr-html-ref
- :fmtstr-labels #'hyperobject-class-fmtstr-html-ref-labels
- :href-head "a href="
- :href-end "a"
- :ampersand "&"))
-
-(defclass xhtml-link-ref (link-ref)
- ()
- (:default-initargs :fmtstr #'hyperobject-class-fmtstr-html-ref
- :fmtstr-labels #'hyperobject-class-fmtstr-html-ref-labels
- :href-head "a href="
- :href-end "a"
- :ampersand "&"))
-
-(defclass xml-link-ref (link-ref)
- ()
- (:default-initargs :fmtstr #'hyperobject-class-fmtstr-xml-ref
- :fmtstr-labels #'hyperobject-class-fmtstr-xml-ref-labels
- :href-head "xmllink xlink:type=\"simple\" xlink:href="
- :href-end "xmllink"
- :ampersand "&")
- (:documentation "Mozilla's and W3's idea of a link with XML"))
-
-(defclass ie-xml-link-ref (xml-link-ref)
- ()
- (:default-initargs :href-head "html:a href="
- :href-end "html:a" )
- (:documentation "Internet Explorer's idea of a link with XML"))
-
-
-(defclass htmlrefformat (htmlformat)
- ()
- (:default-initargs :link-ref (make-instance 'html-link-ref)))
-
-(defclass xhtmlrefformat (xhtmlformat)
- ()
- (:default-initargs :link-ref (make-instance 'xhtml-link-ref)))
-
-(defclass xmlrefformat (xmlformat)
- ()
- (:default-initargs :link-ref (make-instance 'xml-link-ref)))
-
-(defclass ie-xmlrefformat (xmlformat)
- ()
- (:default-initargs :link-ref (make-instance 'ie-xml-link-ref)))
+(defvar +newline-string+ (format nil "~%"))
+
+(defun write-user-name-maybe-plural (obj nitems strm)
+ (write-string
+ (if (> nitems 1)
+ (hyperobject-class-user-name-plural obj)
+ (hyperobject-class-user-name obj))
+ strm))
+
+(defun initialize-text-view (view)
+ (setf (list-start-printer view)
+ (compile nil
+ (eval '(lambda (obj nitems indent strm)
+ (declare (ignore indent))
+ (write-user-name-maybe-plural obj nitems strm)
+ (write-char #\: strm)
+ (write-char #\Newline strm)))))
+ (setf (list-start-indent view) t)
+ (setf (obj-data-indent view) t)
+ (setf (obj-data-end-printer view) +newline-string+)
+ (setf (indenter view) #'indent-spaces))
+
+(defun html-list-start-func (obj nitems indent strm)
+ (write-string "<div class=\"ho-username\" :style=\"margin-left:" strm)
+ (write-fixnum (+ indent indent) strm)
+ (write-string "em;\">" strm)
+ (write-user-name-maybe-plural obj nitems strm)
+ (write-string "</div>" strm)
+ (write-char #\newline strm)
+ (write-string "<ul>" strm)
+ (write-char #\newline strm))
+
+(defun initialize-html-view (view)
+ (initialize-text-view view)
+ (setf (indenter view) #'indent-spaces)
+ (setf (file-start-str view) (format nil "<html><body>~%"))
+ (setf (file-end-str view) (format nil "</body><html>~%"))
+ (setf (list-start-indent view) t)
+ (setf (list-start-printer view) #'html-list-start-func)
+ (setf (list-end-printer view) (format nil "</ul>~%"))
+ (setf (list-end-indent view) t)
+ (setf (obj-start-indent view) nil)
+ (setf (obj-start-printer view) "<li>")
+ (setf (obj-end-indent view) nil)
+ (setf (obj-end-printer view) (format nil "</li>~%"))
+ (setf (obj-data-end-printer view) nil)
+ (setf (obj-data-indent view) nil))
+
+(defun xhtml-list-start-func (obj nitems indent strm)
+ (write-string "<div class=\"ho-username\" :style=\"margin-left:" strm)
+ (write-fixnum (+ indent indent) strm)
+ (write-string "em;\">" strm)
+ (write-user-name-maybe-plural obj nitems strm)
+ (write-string "</div>" strm)
+ (write-string "<div :style=\"margin-left:" strm)
+ (write-fixnum (+ indent indent) strm)
+ (write-string "em;\">" strm)
+ (write-char #\newline strm))
+
+(defun html-obj-start (obj indent strm)
+ (declare (ignore obj indent))
+ (write-string "<div style=\"margin-left:2em;" strm))
+
+(defun initialize-xhtml-view (view)
+ (initialize-text-view view)
+ (setf (indenter view) #'indent-spaces)
+ (setf (file-start-str view) (format nil "<html><body>~%"))
+ (setf (file-end-str view) (format nil "</body><html>~%"))
+ (setf (list-start-indent view) nil)
+ (setf (list-start-printer view) #'xhtml-list-start-func)
+ (setf (list-end-printer view) (format nil "</div>~%"))
+ (setf (list-end-indent view) nil)
+ (setf (obj-start-indent view) nil)
+ (setf (obj-start-printer view) #'html-obj-start)
+ (setf (obj-end-printer view) (format nil "</div>~%"))
+ (setf (obj-data-indent view) nil))
+
+(defun xmlformat-list-end-func (x strm)
+ (write-string "</" strm)
+ (write-string (class-name-of x) strm)
+ (write-string "list" strm)
+ (write-string ">" strm)
+ (write-char #\newline strm))
+
+(defun xmlformat-list-start-func (x nitems indent strm)
+ (declare (ignore indent))
+ (write-char #\< strm)
+ (write-string (class-name-of x) strm)
+ (write-string "list><title>" strm)
+ (write-user-name-maybe-plural x nitems strm)
+ (write-string ":</title>" strm)
+ (write-char #\newline strm))
+
+(defun initialize-xml-view (view)
+ (initialize-text-view view)
+ (setf (file-start-str view) "") ; (std-xml-header)
+ (setf (list-start-indent view) t)
+ (setf (list-start-printer view) #'xmlformat-list-start-func)
+ (setf (list-end-indent view) t)
+ (setf (list-end-printer view) #'xmlformat-list-end-func)
+ (setf (obj-start-printer view) (format nil "<~(~a~)>" (object-class-name view)))
+ (setf (obj-start-indent view) t)
+ (setf (subobj-end-printer view) (format nil "</~(~a~)>~%" (object-class-name view)))
+ (setf (subobj-end-indent view) nil)
+ (setf (obj-data-indent view) nil))