From 3f50791d43f83b9141e4022ce1fd2460edf62436 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 16 Oct 2002 22:59:27 +0000 Subject: [PATCH] r3074: *** empty log message *** --- ml-class.lisp | 40 ++++++++++++++++++++++++++++++++++++++-- package.lisp | 6 ++++-- web-utils-aserve.lisp | 23 +++++++++++++++-------- web-utils.lisp | 13 +++++++------ 4 files changed, 64 insertions(+), 18 deletions(-) diff --git a/ml-class.lisp b/ml-class.lisp index b720de0..57fd07c 100644 --- a/ml-class.lisp +++ b/ml-class.lisp @@ -11,7 +11,7 @@ ;;;; in Text, HTML, and XML formats. This includes hyperlinking ;;;; capability and sub-objects. ;;;; -;;;; $Id: ml-class.lisp,v 1.17 2002/10/16 21:58:49 kevin Exp $ +;;;; $Id: ml-class.lisp,v 1.18 2002/10/16 22:56:07 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -333,6 +333,8 @@ Format is ((field-name field-lookup-func other-link-params) ...)") (setq *default-textformat* (make-instance 'textformat)) (setq *default-htmlformat* (make-instance 'htmlformat)) (setq *default-htmlrefformat* (make-instance 'htmlrefformat)) + (setq *default-xhtmlformat* (make-instance 'xhtmlformat)) + (setq *default-xhtmlrefformat* (make-instance 'xhtmlrefformat)) (setq *default-xmlformat* (make-instance 'xmlformat)) (setq *default-xmlrefformat* (make-instance 'xmlrefformat)) (setq *default-ie-xmlrefformat* (make-instance 'ie-xmlrefformat)) @@ -343,7 +345,8 @@ Format is ((field-name field-lookup-func other-link-params) ...)") (:text *default-textformat*) (:html *default-htmlformat*) (:htmlref *default-htmlrefformat*) - (:xml *default-xmlformat*) + (:xhtml *default-xhtmlformat*) + (:xhtmlref *default-xhtmlrefformat*) (:xml *default-xmlformat*) (:xmlref *default-xmlrefformat*) (:ie-xmlref *default-ie-xmlrefformat*) @@ -409,6 +412,27 @@ Format is ((field-name field-lookup-func other-link-params) ...)") (values (ml-class-title x) nitems (class-name-of x))) (defclass htmlformat (textformat) + () + (:default-initargs :file-start-str "~%" + :file-end-str "~%" + :list-start-indent t + :list-start-fmtstr "

~a~p:

~%" + :list-start-value-func #'htmlformat-list-start-value-func + :list-end-fmtstr "

~%" + :list-end-indent t + :list-end-value-func #'identity + :obj-start-indent t + :obj-start-fmtstr "

" + :obj-start-value-func #'identity + :obj-end-indent t + :obj-end-fmtstr "

~%" + :obj-end-value-func #'identity + :obj-data-indent t + :obj-data-fmtstr #'ml-class-fmtstr-html-labels + :obj-data-fmtstr-labels #'ml-class-fmtstr-html-labels + :obj-data-value-func #'ml-class-value-func)) + +(defclass xhtmlformat (textformat) () (:default-initargs :file-start-str "~%" :file-end-str "~%" @@ -470,6 +494,14 @@ Format is ((field-name field-lookup-func other-link-params) ...)") (:documentation "Formatting for a linked reference")) (defclass html-link-ref (link-ref) + () + (:default-initargs :fmtstr #'ml-class-fmtstr-html-ref + :fmtstr-labels #'ml-class-fmtstr-html-ref-labels + :href-head "a href=" + :href-end "a" + :ampersand "&")) + +(defclass xhtml-link-ref (link-ref) () (:default-initargs :fmtstr #'ml-class-fmtstr-html-ref :fmtstr-labels #'ml-class-fmtstr-html-ref-labels @@ -497,6 +529,10 @@ Format is ((field-name field-lookup-func other-link-params) ...)") () (: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))) diff --git a/package.lisp b/package.lisp index 6c74e84..90054ec 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: package.lisp,v 1.6 2002/10/16 21:58:49 kevin Exp $ +;;;; $Id: package.lisp,v 1.7 2002/10/16 22:59:27 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -125,7 +125,9 @@ #:start-telnet-server ;; From web-utils - #:std-xml-header + #:*std-html-header* + #:*std-xhtml-header* + #:*std-xml-header* #:xml-cdata ;; From web-utils-allegro diff --git a/web-utils-aserve.lisp b/web-utils-aserve.lisp index 21d1b55..19ed28c 100644 --- a/web-utils-aserve.lisp +++ b/web-utils-aserve.lisp @@ -8,7 +8,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: web-utils-aserve.lisp,v 1.6 2002/10/16 21:58:49 kevin Exp $ +;;;; $Id: web-utils-aserve.lisp,v 1.7 2002/10/16 22:56:07 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -97,27 +97,34 @@ ;;; Page wrappers -(defmacro with-page ((title &key css (format :html)) &rest body) +(defmacro with-page ((title &key css (format :xhtml)) &rest body) (case format - (:html + (:xhtml `(prog1 (progn (net.html.generator:html - (print-http "") - (print-http "") - (print-http "") + (print-http *standard-xhtml-header*) (print-http "") (head ,title :css ,css) (print-http "") (prog1 ,@body (print-http "")))))) + (:html + `(prog1 + (progn + (net.html.generator:html + (print-http *standard-html-header*) + (head ,title :css ,css) + (print-http "") + (prog1 + ,@body + (print-http "")))))) (:xml `(prog1 (progn (net.html.generator:html - (princ-http (std-xml-header)) + (princ-http *standard-xml-header* (princ-http "")) (with-tag "pagetitle" (princ-http ,title)) ,@body) diff --git a/web-utils.lisp b/web-utils.lisp index f8c073b..22013e4 100644 --- a/web-utils.lisp +++ b/web-utils.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: web-utils.lisp,v 1.5 2002/10/16 17:37:18 kevin Exp $ +;;;; $Id: web-utils.lisp,v 1.6 2002/10/16 22:56:08 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -23,12 +23,14 @@ ;;; HTML/XML constants (defvar *std-xml-header* - (format nil - "~%~%~%")) + #.(format nil "~%~%~%")) -(defun std-xml-header () - *std-xml-header*) +(defvar *std-html-header* "") +(defvar *std-xhtml-header* + #.(format nil "~%")) + + ;;; URL Functions (defvar *base-url* "") @@ -47,4 +49,3 @@ (car var) "=" (cadr var) "&"))) vars))) ""))) - -- 2.34.1