/[claw]/trunk/main/claw-html/src/parser.lisp
ViewVC logotype

Contents of /trunk/main/claw-html/src/parser.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 184 - (show annotations)
Tue Jan 13 13:03:03 2009 UTC (5 years, 3 months ago) by achiumenti
File size: 5438 byte(s)
Added html template capabilities for pages and components
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
2 ;;; $Header: src/components.lisp $
3
4 ;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved.
5
6 ;;; Redistribution and use in source and binary forms, with or without
7 ;;; modification, are permitted provided that the following conditions
8 ;;; are met:
9
10 ;;; * Redistributions of source code must retain the above copyright
11 ;;; notice, this list of conditions and the following disclaimer.
12
13 ;;; * Redistributions in binary form must reproduce the above
14 ;;; copyright notice, this list of conditions and the following
15 ;;; disclaimer in the documentation and/or other materials
16 ;;; provided with the distribution.
17
18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
30 (in-package :claw-html)
31
32 (defclass claw-html-builder (chtml::lhtml-builder)
33 ())
34
35 (defun make-claw-html-builder ()
36 (make-instance 'claw-html-builder))
37
38 (defmethod hax:start-element ((handler claw-html-builder) name attrs)
39 (let* ((parent (car (chtml::stack handler)))
40 (this (list (find-symbol (format nil "~a>" (string-upcase name)) :claw-html)
41 (flatten (chtml::pt-attributes-to-lhtml attrs)))))
42 (push this (chtml::stack handler))
43 (if parent
44 (push this (cddr parent))
45 (setf (chtml::root handler) this))))
46
47 (defmethod hax:end-element ((handler claw-html-builder) name)
48 (let ((current (pop (chtml::stack handler))))
49 (setf (cdr current)
50 (append (cadr current) (reverse (cddr current))))))
51
52 ;; component parser
53
54 (defvar *component-content-template* nil)
55
56 (defclass claw-html-component-builder (claw-html-builder)
57 ((component-content-template :initform nil
58 :accessor component-content-template-p)
59 (component-content-ignore :initform nil
60 :accessor component-content-ignore-p)
61 (parsed-content :initform nil
62 :accessor parsed-content)))
63
64 (defun make-claw-html-component-builder ()
65 (make-instance 'claw-html-component-builder))
66
67 (defmethod hax:start-element :before ((handler claw-html-builder) name attrs)
68 (dolist (attr attrs)
69 (cond
70 ((and (string-equal (hax:attribute-name attr) "CLAWTYPE")
71 (string-equal (hax:attribute-value attr) "$ignore$"))
72 (setf (component-content-ignore-p handler) t))
73 ((and (string-equal (hax:attribute-name attr) "CLAWTYPE")
74 (string-equal (hax:attribute-value attr) "$content$")
75 (null (component-content-ignore-p handler)))
76 (if (component-content-template-p handler)
77 (error "$content$ found multiple times in template")
78 (setf (component-content-template-p handler) t))))))
79
80 (defun parse-attributes (attrs)
81 (loop for (key value) on attrs by #'cddr
82 collect key
83 when value collect (parse-attribute-value value)))
84
85 (defun parse-attribute-value (value)
86 (multiple-value-bind (result matchesp)
87 (cl-ppcre:regex-replace "(?i)(^\\$lisp>)+([.])*" value "\\2")
88 (if matchesp
89 (read-from-string result)
90 result)))
91
92
93 (defmethod hax:end-element ((handler claw-html-component-builder) name)
94 (let ((current (pop (chtml::stack handler))))
95 (let ((attrs (parse-attributes (cadr current))))
96 (cond
97 ((string-equal (getf attrs :clawtype) "$ignore$")
98 (setf (cdr current) nil
99 attrs nil
100 (component-content-ignore-p handler) nil
101 (car current) (find-symbol "IGNORE>" "CLAW-HTML")))
102 ((string-equal (getf attrs :clawtype) "$body$")
103 (setf (cdr current) nil
104 attrs (list (find-symbol "*CLAW-THIS-COMPONENT*" "CLAW-HTML"))
105 (car current) (find-symbol "HTCOMPONENT-BODY" "CLAW-HTML")))
106 ((and (component-content-template-p handler)
107 (string-equal (getf attrs :clawtype) "$content$")
108 (null (parsed-content handler)))
109 (remf attrs :clawtype)
110 (setf (parsed-content handler) (append (list (first current))
111 attrs
112 (reverse (cddr current))))))
113 (unless (component-content-ignore-p handler)
114 (setf (cdr current)
115 (append attrs (reverse (cddr current))))))))
116
117
118 (defun parse-claw-template (input)
119 "Parses the input and returns a claw form template (i.e. a CLAW-HTML:TAG instance) and returns a lambda function with no parameters.
120 The inpus may be a string a file or a stream.
121 "
122 (eval `(lambda () ,(let ((handler (make-claw-html-component-builder)))
123 (chtml:parse input handler)
124 (let ((result (parsed-content handler)))
125 (or (parsed-content handler) result))))))

  ViewVC Help
Powered by ViewVC 1.1.5