Changeset main,2 for main

Timestamp:

02/05/2008 04:15:19 AM (18 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tags

revision id:

dsowen@fugue88.ws-20080205041519-08a87o61m5kakcbs

Message:

• Switched to a tag-expansion model (versus tag-rendition), allowing for more complex tag behavior with about the same source complexity.
• Exported some symbols (not final yet).
• Removed obsolete and exploration functions.

File:

• main/tags.lisp (modified) (3 diffs)

main/tags.lisp

@@ -1 +1 @@
 (defpackage #:dso-tags
-  (:use #:cl))
+  (:use #:cl)
+  (:export #:expand-tag #:render-tag #:render #:do-body))
 
 (in-package #:dso-tags)
@@ -10 +11 @@
 
 
+(defgeneric expand-tag (tag body &key &allow-other-keys)
+  (:method (tag body &key)))
+
 (defgeneric render-tag (tag body &key &allow-other-keys)
-  "Renders the tag named TAG with the given BODY and keyword-arguments as
-attributes.")
+  (:documentation
+   "Renders the tag named TAG with the given BODY and keyword-arguments as
+attributes."))
 
-(defmethod render ((tag list))
-  (destructuring-bind (name &rest b) tag
+
+
+(defun break-tag (tree)
+  (destructuring-bind (name &rest b) tree
     (let (args)
       (do () ((not (keywordp (first b))))
         (push (pop b) args)
         (push (pop b) args))
-      (apply 'render-tag name b (nreverse args)))))
-
-(defmethod render ((text string))
-  (format t "~A" text))
+      (values name b (nreverse args)))))
 
 (defun do-body (body)
-  (dolist (item body)
-    (render item)))
+  (do ((item #1=(pop body) #1#))
+      ((null item))
+    (etypecase item
+      (string
+       (format t "~A" item))
+      (list
+       (multiple-value-bind (tag-name tag-body tag-attrs) (break-tag item)
+         (let ((expanded (apply 'expand-tag tag-name tag-body tag-attrs)))
+           (if expanded
+               (setf body (nconc expanded body))
+               (apply 'render-tag tag-name tag-body tag-attrs))))))))
 
 
@@ -45 +58 @@
 (defmethod render-tag (tag body &rest args &key &allow-other-keys)
   (render-simple-tag tag body args))
-
-(defmethod render-tag ((tag (eql 'when)) body &key cond)
-  (when (eval cond)
-    (do-body body)))
-
-(defmethod render-tag ((tag (eql 'page)) body &key title)
-  (do-body
-      `((html
-         ,@(when title `((head (title ,title))))
-         (body ,@body)))))