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

diff --git a/ml-class.lisp b/ml-class.lisp
index 2376f0abbee6876fa0864d7353cdff44f293954a..b720de00351cd7d5dcb936a8c10d47c8529a00a8 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.16 2002/10/16 17:37:18 kevin Exp $
+;;;; $Id: ml-class.lisp,v 1.17 2002/10/16 21:58:49 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -230,7 +230,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
              (setq xmlvalue-func (append xmlvalue-func (list `(xml-cdata ,@plain-value-func))))
            (setq xmlvalue-func (append xmlvalue-func plain-value-func)))
          ))
-
+      
       (if value-func
          (setq value-func `(lambda (x) (values ,@value-func)))
        (setq value-func `(lambda () (values))))
@@ -401,14 +401,21 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     :obj-data-end-fmtstr "~%"
     :obj-data-value-func #'ml-class-value-func))
 
+
+(defun class-name-of (obj)
+  (string-downcase (ml-class-name (ml-class-of obj))))
+
+(defun htmlformat-list-start-value-func (x nitems) 
+  (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><ul>~%"
-    :list-start-value-func #'text-list-start-value-func
-    :list-end-fmtstr "</ul>~%"
+    :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
@@ -420,17 +427,14 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     :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))
-
+    :obj-data-value-func #'ml-class-xmlvalue-func))
 
-(defun class-name-of (obj)
-  (string-downcase (ml-class-name (ml-class-of obj))))
 
 (defun xmlformat-list-end-value-func (x)
-  (format nil "~alist" (string-downcase (ml-class-name (ml-class-of x)))))
+  (format nil "~alist" (class-name-of x)))
 
 (defun xmlformat-list-start-value-func (x nitems) 
-  (values (format nil "~alist" (string-downcase (ml-class-name (ml-class-of x)))) (ml-class-title x) nitems))
+  (values (format nil "~alist" (class-name-of x)) (ml-class-title x) nitems))
 
 (defclass xmlformat (textformat) 
   ()
@@ -471,7 +475,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     :fmtstr-labels #'ml-class-fmtstr-html-ref-labels
     :href-head "a href=" 
     :href-end "a" 
-    :ampersand "&"))
+    :ampersand "&amp;"))
 
 (defclass xml-link-ref (link-ref)
   ()
diff --git a/package.lisp b/package.lisp
index d4a772df0075b3b3e691ed11a7d970c047164dca..6c74e849d7272102e52ee3cd92293897afc1e8e0 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.5 2002/10/16 17:37:18 kevin Exp $
+;;;; $Id: package.lisp,v 1.6 2002/10/16 21:58:49 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -141,8 +141,7 @@
          #:with-link
          #:home-link
          #:head
-         #:with-xml-page
-         #:with-html-page
+         #:with-page
          #:wrap-with-xml
          #:parse-xml-no-ws
          #:positions-xml-tag-contents
diff --git a/web-utils-aserve.lisp b/web-utils-aserve.lisp
index 74a518a308aee40c5f42f20f67575e68234a7c82..21d1b55f9c7c434c9a74f86d6f6cf434a599175e 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.5 2002/10/16 17:37:18 kevin Exp $
+;;;; $Id: web-utils-aserve.lisp,v 1.6 2002/10/16 21:58:49 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -90,37 +90,38 @@
     (setq css "http://b9.com/main.css"))
   (net.html.generator:html 
    (:head
-    (princ-http (format nil "<LINK rel=\"stylesheet\" href=\"~A\" type=\"text/css\">" css))
+    (princ-http (format nil "<link rel=\"stylesheet\" href=\"~A\" type=\"text/css\"></link>" css))
     (:title (:princ-safe title-str)))))
 
 
 
 ;;; Page wrappers
 
-(defmacro with-xml-page (title &rest body)
-  `(prog1
-       (progn
-        (net.html.generator:html
-         (princ-http (std-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)
-     (princ-http "</pagedata>")))
-
-(defmacro with-html-page ((title &key css) &rest body)
-  `(prog1
-       (progn
-         (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 "<html xmlns=\"http://www.w3.org/1999/xhtml\">")
-         (head ,title :css ,css)
-         (print-http "<body bgcolor=\"#FFFFFF\">")
-         (prog1 
-             ,@body
-           (print-http "</body>")))
-     (print-http "</html>")))
+(defmacro with-page ((title &key css (format :html)) &rest body)
+  (case format
+    (:html
+     `(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 "<html xmlns=\"http://www.w3.org/1999/xhtml\">")
+            (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 "<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)
+       (princ-http "</pagedata>")))))
 
 
 ;;; URL Encoding
Common library for KMR lisp projects