From 9c2f8b27c22414ff15dd91644915e692d83fc6b7 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 13 May 2003 23:10:44 +0000 Subject: [PATCH] r4918: *** empty log message *** --- views.lisp | 152 ++++++++++++++++++++++++----------------------------- 1 file changed, 68 insertions(+), 84 deletions(-) diff --git a/views.lisp b/views.lisp index 1f01b7f..2286d9b 100644 --- a/views.lisp +++ b/views.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: views.lisp,v 1.31 2003/05/13 15:56:50 kevin Exp $ +;;;; $Id: views.lisp,v 1.32 2003/05/13 23:10:44 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; @@ -41,43 +41,34 @@ :accessor file-start-str) (file-end-str :type (or string null) :initform nil :initarg :file-end-str :accessor file-end-str) - (list-start-fmtstr :type (or string null) :initform nil :initarg :list-start-fmtstr - :accessor list-start-fmtstr) - (list-start-value-func :type (or function symbol null) :initform nil - :initarg :list-start-value-func - :accessor list-start-value-func) + (list-start-str-or-func :type (or string function null) :initform nil + :initarg :list-start-str-or-func + :accessor list-start-str-or-func) (list-start-indent :initform nil :initarg :list-start-indent :accessor list-start-indent) - (list-end-fmtstr :type (or string null) :initform nil :initarg :list-end-fmtstr - :accessor list-end-fmtstr) - (list-end-value-func :type (or function symbol null) :initform nil - :initarg :list-end-value-func - :accessor list-end-value-func) + (list-end-str-or-func :type (or string function null) :initform nil + :initarg :list-end-str-or-func + :accessor list-end-str-or-func) (list-end-indent :initform nil :initarg :list-end-indent :accessor list-end-indent) - (obj-start-fmtstr :type (or string symbol null) :initform nil :initarg :obj-start-fmtstr - :accessor obj-start-fmtstr) - (obj-start-value-func :initform nil :initarg :obj-start-value-func - :accessor obj-start-value-func) + (obj-start-str-or-func :type (or string function null) :initform nil :initarg :obj-start-str-or-func + :accessor obj-start-str-or-func) (obj-start-indent :initform nil :initarg :obj-start-indent :accessor obj-start-indent) - (obj-end-fmtstr :type (or string null) :initform nil :initarg :obj-end-fmtstr - :accessor obj-end-fmtstr) - (obj-end-value-func :type (or function symbol null) :initform nil - :initarg :obj-end-value-func - :accessor obj-end-value-func) + (obj-end-str-or-func :type (or string function null) :initform nil :initarg :obj-end-str-or-func + :accessor obj-end-str-or-func) (obj-end-indent :initform nil :initarg :obj-end-indent :accessor obj-end-indent) (obj-data-indent :initform nil :initarg :obj-data-indent :accessor obj-data-indent) (obj-data-fmtstr :type (or string null) :initform nil :initarg :obj-data-fmtstr :accessor obj-data-fmtstr) - (obj-data-end-fmtstr :type (or string null) :initform nil - :initarg :obj-data-end-fmtstr - :accessor obj-data-end-fmtstr) (obj-data-value-func :type (or function symbol null) :initform nil :initarg :obj-data-value-func :accessor obj-data-value-func) + (obj-data-end-str :type (or string null) :initform nil + :initarg :obj-data-end-str + :accessor obj-data-end-str) (link-slots :type list :initform nil :documentation "List of slot names that have hyperlinks" :accessor link-slots) @@ -314,38 +305,36 @@ (defun class-name-of (obj) (string-downcase (class-name (class-of obj)))) -(defun text-list-start-value-func (obj nitems) - (values (hyperobject-class-user-name obj) nitems)) - -(defun htmlformat-list-start-value-func (x nitems) - (values (hyperobject-class-user-name x) nitems (class-name-of x))) +(defvar +newline-string+ (format nil "~%")) (defun initialize-text-view (view) - (setf (list-start-fmtstr view) "~a~P:~%") - (setf (list-start-value-func view) #'text-list-start-value-func) + (setf (list-start-str-or-func view) + (compile nil + #'(lambda (obj nitems strm) + (format strm "~a~P:~%" + (hyperobject-class-user-name obj) nitems)))) (setf (list-start-indent view) t) (setf (obj-data-indent view) t) - (setf (obj-data-end-fmtstr view) (format nil "~%")) - ) + (setf (obj-data-end-str view) +newline-string+)) + +(defun html-list-start-func (obj nitems strm) + (format strm "

~a~p:

~%")) (setf (list-end-indent view) t) - (setf (list-end-value-func view) nil) (setf (obj-start-indent view) t) - (setf (obj-start-fmtstr view) "
  • ") - (setf (obj-start-value-func view) nil) + (setf (obj-start-str-or-func view) "
  • ") (setf (obj-end-indent view) t) - (setf (obj-end-fmtstr view) (format nil "
    • ~%")) - (setf (obj-end-value-func view) nil) + (setf (obj-end-str-or-func view) (format nil "~%")) (setf (obj-data-indent view) t)) (defun initialize-xhtml-view (view) @@ -353,40 +342,39 @@ (setf (file-start-str view) (format nil "~%")) (setf (file-end-str view) (format nil "~%")) (setf (list-start-indent view) t) - (setf (list-start-fmtstr view) - "

    ~a~p:

    ~%")) + (setf (list-start-str-or-func view) #'html-list-start-func) + (setf (list-end-str-or-func view) (format nil "~%")) (setf (list-end-indent view) t) - (setf (list-end-value-func view) nil) (setf (obj-start-indent view) t) - (setf (obj-start-fmtstr view) "
  • ") - (setf (obj-start-value-func view) nil) + (setf (obj-start-str-or-func view) "
  • ") (setf (obj-end-indent view) t) - (setf (obj-end-fmtstr view) (format nil "
    • ~%")) - (setf (obj-end-value-func view) nil) + (setf (obj-end-str-or-func view) (format nil "~%")) (setf (obj-data-indent view) t)) -(defun xmlformat-list-end-value-func (x) - (format nil "~alist" (class-name-of x))) +(defun xmlformat-list-end-func (x strm) + (write-string "" strm) + (write-char #\newline strm)) -(defun xmlformat-list-start-value-func (x nitems) - (values (format nil "~alist" (class-name-of x)) (hyperobject-class-user-name x) nitems)) +(defun xmlformat-list-start-func (x nitems strm) + (write-char #\< strm) + (write-string (class-name-of x) strm) + (write-string "list>" strm) + (format strm "~A~P: ~%" + (hyperobject-class-user-name x) nitems)) (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-fmtstr view) "<~a>~a~p: ~%") - (setf (list-start-value-func view) - #'xmlformat-list-start-value-func) + (setf (list-start-str-or-func view) #'xmlformat-list-start-func) (setf (list-end-indent view) t) - (setf (list-end-fmtstr view) "~%") - (setf (list-end-value-func view) #'xmlformat-list-end-value-func) - (setf (obj-start-fmtstr view) (format nil "<~(~a~)>" (object-class-name view))) + (setf (list-end-str-or-func view) #'xmlformat-list-end-func) + (setf (obj-start-str-or-func view) (format nil "<~(~a~)>" (object-class-name view))) (setf (obj-start-indent view) t) - (setf (obj-end-fmtstr view) (format nil "~%" (object-class-name view))) + (setf (obj-end-str-or-func view) (format nil "~%" (object-class-name view))) (setf (obj-end-indent view) nil) (setf (obj-data-indent view) nil)) @@ -406,41 +394,37 @@ (defun fmt-list-start (obj view strm indent num-items) (when (list-start-indent view) (indent-spaces indent strm)) - (let-when (fmtstr (list-start-fmtstr view)) - (let-if (value-func (list-start-value-func view)) - (multiple-value-call #'format strm fmtstr - (funcall value-func obj num-items)) - (write-string fmtstr strm)))) + (awhen (list-start-str-or-func view) + (if (stringp it) + (write-string it strm) + (funcall it obj num-items strm)))) (defun fmt-list-end (obj view strm indent num-items) (declare (ignore num-items)) (when (list-end-indent view) (indent-spaces indent strm)) - (let-when (fmtstr (list-end-fmtstr view)) - (let-if (value-func (list-end-value-func view)) - (multiple-value-call #'format strm fmtstr - (funcall value-func obj)) - (write-string fmtstr strm)))) + (awhen (list-end-str-or-func view) + (if (stringp it) + (write-string it strm) + (funcall it obj strm)))) ;;; Object Start and Ends (defun fmt-obj-start (obj view strm indent) (when (obj-start-indent view) (indent-spaces indent strm)) - (let-when (fmtstr (obj-start-fmtstr view)) - (let-if (value-func (obj-start-value-func view)) - (multiple-value-call #'format strm fmtstr - (funcall value-func obj)) - (write-string fmtstr strm)))) + (awhen (obj-start-str-or-func view) + (if (stringp it) + (write-string it strm) + (funcall it obj strm)))) (defun fmt-obj-end (obj view strm indent) (when (obj-end-indent view) (indent-spaces indent strm)) - (let-when (fmtstr (obj-end-fmtstr view)) - (let-if (value-func (obj-end-value-func view)) - (multiple-value-call #'format strm fmtstr - (funcall value-func obj)) - (write-string fmtstr strm)))) + (awhen (obj-end-str-or-func view) + (if (stringp it) + (write-string it strm) + (funcall it obj strm)))) ;;; Object Data @@ -469,7 +453,7 @@ (if (link-slots view) (fmt-obj-data-with-link obj view strm refvars) (fmt-obj-data-plain obj view strm)) - (awhen (obj-data-end-fmtstr view) + (awhen (obj-data-end-str view) (write-string it strm))) (defun fmt-obj-data-plain (obj view strm) -- 2.34.1