Changeset main,2


Ignore:
Timestamp:
02/05/2008 04:15:19 AM (14 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:
1 edited

Legend:

Unmodified
Added
Removed
  • main/tags.lisp

    r1 r2  
    11(defpackage #:dso-tags
    2   (:use #:cl))
     2  (:use #:cl)
     3  (:export #:expand-tag #:render-tag #:render #:do-body))
    34
    45(in-package #:dso-tags)
     
    1011
    1112
     13(defgeneric expand-tag (tag body &key &allow-other-keys)
     14  (:method (tag body &key)))
     15
    1216(defgeneric render-tag (tag body &key &allow-other-keys)
    13   "Renders the tag named TAG with the given BODY and keyword-arguments as
    14 attributes.")
     17  (:documentation
     18   "Renders the tag named TAG with the given BODY and keyword-arguments as
     19attributes."))
    1520
    16 (defmethod render ((tag list))
    17   (destructuring-bind (name &rest b) tag
     21
     22
     23(defun break-tag (tree)
     24  (destructuring-bind (name &rest b) tree
    1825    (let (args)
    1926      (do () ((not (keywordp (first b))))
    2027        (push (pop b) args)
    2128        (push (pop b) args))
    22       (apply 'render-tag name b (nreverse args)))))
    23 
    24 (defmethod render ((text string))
    25   (format t "~A" text))
     29      (values name b (nreverse args)))))
    2630
    2731(defun do-body (body)
    28   (dolist (item body)
    29     (render item)))
     32  (do ((item #1=(pop body) #1#))
     33      ((null item))
     34    (etypecase item
     35      (string
     36       (format t "~A" item))
     37      (list
     38       (multiple-value-bind (tag-name tag-body tag-attrs) (break-tag item)
     39         (let ((expanded (apply 'expand-tag tag-name tag-body tag-attrs)))
     40           (if expanded
     41               (setf body (nconc expanded body))
     42               (apply 'render-tag tag-name tag-body tag-attrs))))))))
    3043
    3144
     
    4558(defmethod render-tag (tag body &rest args &key &allow-other-keys)
    4659  (render-simple-tag tag body args))
    47 
    48 (defmethod render-tag ((tag (eql 'when)) body &key cond)
    49   (when (eval cond)
    50     (do-body body)))
    51 
    52 (defmethod render-tag ((tag (eql 'page)) body &key title)
    53   (do-body
    54       `((html
    55          ,@(when title `((head (title ,title))))
    56          (body ,@body)))))
Note: See TracChangeset for help on using the changeset viewer.