projects / kmrcl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 4a7372e)
r3074: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Wed, 16 Oct 2002 22:59:27 +0000 (22:59 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Wed, 16 Oct 2002 22:59:27 +0000 (22:59 +0000)
ml-class.lisp patch | blob | history
package.lisp patch | blob | history
web-utils-aserve.lisp patch | blob | history
web-utils.lisp patch | blob | history

diff --git a/ml-class.lisp b/ml-class.lisp
index b720de00351cd7d5dcb936a8c10d47c8529a00a8..57fd07cb5a52bec2ba79ad55f7d3fabb0a252b98 100644 (file)
--- 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 "<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 #'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 "<html><body>~%"
     :file-end-str "</body><html>~%"
@@ -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 6c74e849d7272102e52ee3cd92293897afc1e8e0..90054ecaf14ab122ecda47a90292ce5706e0aea0 100644 (file)
--- 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 21d1b55f9c7c434c9a74f86d6f6cf434a599175e..19ed28c5d92997bce5ada3f8d9df283a42e740d2 100644 (file)
--- 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 "<?xml version=\"1.0\" standalone=\"yes\"?>")
-            (print-http "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"")
-            (print-http " \"http://www.w3c.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
-            (print-http "")
+            (print-http *standard-xhtml-header*)
             (print-http "<html xmlns=\"http://www.w3.org/1999/xhtml\">")
             (head ,title :css ,css)
             (print-http "<body>")
             (prog1 
                 ,@body
               (print-http "</body></html>"))))))
+    (:html
+     `(prog1
+         (progn
+           (net.html.generator:html
+            (print-http *standard-html-header*)
+            (head ,title :css ,css)
+            (print-http "<body>")
+            (prog1 
+                ,@body
+              (print-http "</body></html>"))))))
     (:xml
      `(prog1
          (progn
            (net.html.generator:html
-            (princ-http (std-xml-header))
+            (princ-http *standard-xml-header*
             (princ-http "<pagedata xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:html=\"http://www.w3.org/TR/REC-html40\">"))
            (with-tag "pagetitle" (princ-http ,title))
            ,@body)
diff --git a/web-utils.lisp b/web-utils.lisp
index f8c073b43c3d1a0b7e7e682af701c540c2d48705..22013e47a6933fbe0db039c3d970f4a2b3ace4e0 100644 (file)
--- 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 
-  "<?xml version=\"1.0\" ?>~%<?xml-stylesheet type=\"text/css\" href=\"http://b9.com/umls.css\" ?>~%~%"))
+  #.(format nil "<?xml version=\"1.0\" ?>~%<?xml-stylesheet type=\"text/css\" href=\"http://b9.com/umlsxml.css\" ?>~%~%"))
 
-(defun std-xml-header ()
-  *std-xml-header*)
+(defvar *std-html-header* "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">")
 
+(defvar *std-xhtml-header*
+  #.(format nil "<?xml version=\"1.0\" standalone=\"yes\"?>~%<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3c.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"))
+
+  
 ;;; URL Functions
 
 (defvar *base-url* "")
@@ -47,4 +49,3 @@
                                            (car var) "=" (cadr var) "&")))
                                  vars)))
                 "")))
-
Common library for KMR lisp projects