X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=2%2Fhtmlgen.lisp;h=711fcc64597ca2ad9f8dfb4b29e7325bd240bba1;hb=dfca04d9b53264cb05872767a95eecaf4162bc65;hp=f77b6b6a344d94aef7256c16978cba53d7652d3b;hpb=df8deae04330b5b7dbd323f3b82272ed21946134;p=lml.git

diff --git a/2/htmlgen.lisp b/2/htmlgen.lisp
index f77b6b6..711fcc6 100644
--- a/2/htmlgen.lisp
+++ b/2/htmlgen.lisp
@@ -1,6 +1,6 @@
 ;; -*- mode: common-lisp; package: lml2 -*-
 ;;
-;; $Id: htmlgen.lisp,v 1.10 2003/06/25 21:24:09 kevin Exp $
+;; $Id: htmlgen.lisp,v 1.13 2003/07/15 04:28:56 kevin Exp $
 ;;
 ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA 
 ;; copyright (c) 2003 Kevin Rosenberg
@@ -8,7 +8,7 @@
 ;; Main changes from Allegro version:
 ;;    - Support XHTML end tags
 ;;    - lowercase symbol names for attributes
-;;    - Add custom tags such as :jscript, :insert-file, :nbsp
+;;    - Add custom tags such as :jscript, :insert-file, :load-file, :nbsp
 ;;    - removal of if* macro -- partially complete
 ;;
 ;; This code is free software; you can redistribute it and/or
@@ -68,7 +68,7 @@
 	     ;; argsp is true if this isn't a singleton tag  (i.e. it has
 	     ;;     a body) .. (:tag ...) or ((:tag ...) ...)
 	     ;; body is the body if any of the form
-	     ;; 
+	     ;;
 	     (let (spec)
 	       (if* (setq spec (html-process-special ent))
 		  then ; do something different
@@ -84,8 +84,9 @@
 			       (push `(,(html-process-macro ent) :unset) res)
 			       nil
 			  else ; some args
-			       (push `(,(html-process-macro ent) ,args
-								 ,(process-html-forms body env))
+			       (push `(,(html-process-macro ent)
+				       ,args
+				       ,(process-html-forms body env))
 				     res)
 			       nil)))))
 				 
@@ -180,6 +181,32 @@
 			       (prin1-safe-http-string ,(cadddr xx)))
 			     res)
 		       (pop xx) (pop xx)
+		       elseif (eq :fformat (car xx))
+		       then
+		       ;; process :fformat
+		       (unless (and (listp (cadr xx))
+				    (>= (length (cadr xx)) 2))
+			 (error ":fformat must be given a list"))
+		       (push
+			`(write-string 
+			  ,(format nil " ~(~a~)=\"" (car (cadr xx)))
+			  *html-stream*)
+			res)
+		       (push
+			`(fformat *html-stream* ,(cadr (cadr xx))
+			  ,@(cddr (cadr xx)))
+			res)
+		       (push '(write-char #\" *html-stream*) res)
+		       elseif (eq :optional (car xx))
+		       then 
+		       (push
+			`(when ,(cadr (cadr xx))
+			  (write-string
+			   ,(format nil " ~(~a~)=\"" (car (cadr xx)))
+			   *html-stream*)
+			  (fformat *html-stream* "~A\""
+			   ,(cadr (cadr xx))))
+			res)
 		       else 
 		       
 		       (push `(write-string 
@@ -713,7 +740,7 @@
 	;; must use <!--   --> syntax
 	(declare (ignore ent args argsp))
 	`(progn
-	  (write-string "<script language=\"JavasSript\" type=\"text/javascript\">" *html-stream*)
+	  (write-string "<script language=\"JavaScript\" type=\"text/javascript\">" *html-stream*)
 	  (write-char #\newline *html-stream*)
 	  (write-string "//![CDATA[" *html-stream*)
 	  (write-char #\newline *html-stream*)
@@ -743,6 +770,25 @@
 	  (write-string "&nbsp;" stream)
 	(error ":nbsp in an illegal place: ~s" form)))))
 
+
+(def-special-html :load-file
+    (named-function html-nbsp-function
+      (lambda (ent args argsp body)
+	(declare (ignore ent args argsp))
+	(unless body
+	  (error "must have a body with :load-file"))
+	`(progn ,@(mapcar #'(lambda (bod)
+			      `(lml-load ,bod))
+			  body))))
+  
+  (named-function html-nbsp-print-function
+    (lambda (ent cmd args form subst unknown stream)
+      (declare (ignore ent unknown subst stream args))
+      (assert (eql 2 (length form)))
+      (if (eq cmd :full)
+	  (lml-load (cadr form))
+	(error ":load-file must be given an argument")))))
+
 (def-special-html :insert-file
     (named-function html-nbsp-function
       (lambda (ent args argsp body)
@@ -750,7 +796,7 @@
 	(unless body
 	  (error "must have a body with :insert-file"))
 	`(progn ,@(mapcar #'(lambda (bod)
-			      `(lml-load-path ,bod))
+			      `(insert-file ,bod))
 			  body))))
   
   (named-function html-nbsp-print-function
@@ -758,9 +804,8 @@
       (declare (ignore ent unknown subst stream args))
       (assert (eql 2 (length form)))
       (if (eq cmd :full)
-	  (lml-load-path (cadr form))
-	  (error ":insert-file must be given an argument")))))
-
+	  (insert-file (cadr form))
+	(error ":insert-file must be given an argument")))))
 
 (def-special-html :write-string
     (named-function html-write-string-function
@@ -793,3 +838,27 @@
       (if (eq cmd :full)
 	  (write-char (cadr form) stream)
 	  (error ":write-char must be given an argument")))))
+
+;; fast formatter
+(def-special-html :fformat
+    (named-function html-write-char-function
+      (lambda (ent args argsp body)
+	(declare (ignore ent args argsp))
+	`(progn ,@(mapcar #'(lambda (bod)
+			      `(progn
+				(format *html-stream* " ~(~A~)=\"" (car ,bod))
+				(apply #'format *html-stream* (cdr ,bod))
+				(write-char #\" *html-stream*)))
+			  body))))
+  
+  (named-function html-write-char-print-function
+    (lambda (ent cmd args form subst unknown stream)
+      (declare (ignore args ent unknown subst))
+      (assert (eql 2 (length form)))
+      (if (eq cmd :full)
+	  (progn
+	    (format stream " ~(~A~)=\"" (car form))
+	    (apply #'format stream (cdr form))
+	    (write-char #\" stream))
+	  (error ":fformat must be given an argument")))))
+