/[clhp]/clhp/clhp.lisp
ViewVC logotype

Contents of /clhp/clhp.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (hide annotations)
Fri Sep 19 14:04:05 2003 UTC (10 years, 7 months ago) by aventimiglia
Branch: MAIN
Changes since 1.5: +3 -3 lines
Simply re adjusted the numbers to reflect a CVS versioning rather than
0.1.0. If I don't do this now, I'll probably forget to do it later,
and I really don't want anyone getting CVS sources that say they have
0.1.0 instead of the date based cvs versioning scheme in clhp.lisp.
1 aventimiglia 1.1 (ext:file-comment
2 aventimiglia 1.6 "$Id: clhp.lisp,v 1.6 2003/09/19 14:04:05 aventimiglia Exp $")
3 aventimiglia 1.1 ;;
4     ;; CLHP the Common Lisp Hypertext Preprocessor
5     ;; (C) 2003 Anthony J Ventimiglia
6     ;;
7     ;; This library is free software; you can redistribute it and/or
8     ;; modify it under the terms of the GNU Lesser General Public
9     ;; License as published by the Free Software Foundation; either
10     ;; version 2.1 of the License, or (at your option) any later version.
11     ;;
12     ;; This library is distributed in the hope that it will be useful,
13     ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14     ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15     ;; Lesser General Public License for more details.
16     ;;
17     ;; You should have received a copy of the GNU Lesser General Public
18     ;; License along with this library; if not, write to the Free Software
19     ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20     ;;
21     ;; email: aventimigli@common-lisp.net
22     ;; HomePage: http://common-lisp.net/project/clhp/
23    
24     ;; This is here to make clean compilation
25     (eval-when (:compile-toplevel)
26     (when (find-package :clhp)
27     (delete-package :clhp))
28     ;; Since CGU us used and we may be building this before it's installed,
29     ;; We'll need to load it.
30     (unless (find-package :cgi)
31     (load "cgi")))
32    
33     (make-package :CLHP)
34    
35     (in-package :CLHP)
36 aventimiglia 1.4 (export '(PARSE *CLHP-VERSION* ECHO INCLUDE))
37 aventimiglia 1.1
38 aventimiglia 1.2 ;; This elaborate reader macro converts the cvs Date keywords and
39     ;; translates it into a 8 digit date code for marking the cvs version.
40     ;; by changing the NIL in the first part of the OR, a release number
41     ;; will override the CVS keyword
42     (defconstant *CLHP-VERSION*
43 aventimiglia 1.6 #.(or nil ; Set this for releases
44     (let* ((trimmed (string-trim "$ Date:" "$Date: 2003/09/19 14:04:05 $"))
45 aventimiglia 1.2 (date (subseq trimmed 0 (search " " trimmed))))
46     (concatenate 'string
47     (subseq date 0 4)
48     (subseq date 5 7)
49 aventimiglia 1.3 (subseq date 8 10)
50     "cvs"))))
51 aventimiglia 1.1 (defconstant *PI-START* "<?clhp")
52     (defconstant *PI-END* "?>")
53    
54     (defmacro find-pi-start (buffer &key start end)
55     "Find the next occurence of *PI-START* and return its index. Returns
56     NIL if not found"
57     (declare (type (array character 1) buffer)
58     (type fixnum start end))
59     `(search ,*PI-START* ,buffer :test #'string= :start2 ,start :end2 ,end))
60    
61     (defmacro find-pi-end (buffer &key start end)
62     (declare (type (array character 1) buffer)
63     (type fixnum start end))
64     "Find the next occurence of *pi-end* and return its index. Returns
65     NIL if not found."
66     `(search ,*PI-END* ,buffer :test #'string= :start2 ,start :end2 ,end))
67    
68     (defun parse (file-name)
69     "This is the only thing that needs to be called from a CL-CGI script
70     to use CLHP. See README for an example."
71     (use-package :cgi)
72     (use-package :clhp)
73     (cgi:init)
74     (cgi:header :content-type
75     :text/html
76     :extra
77     '(#.(format
78     nil
79     "X-Powered-By: CLHP/~a Common Lisp Hypertext Preprocessor"
80     *CLHP-VERSION*)))
81     (include file-name))
82    
83     (defun include (file-name)
84     "parse FILE-NAME as a CLHP file, this is essentially the same as PARSE, only it does not output headers."
85     ;; We'll read the whole thing here into a buffer, then send it to
86     ;; PARSE-BUFFER to recursively process it
87     (handler-bind
88     ((error #'handle-error))
89     (with-open-file
90     (stream file-name :direction :input :if-does-not-exist :error)
91     ;; FILE-LENGTH could return NIL, I don't see why, but nevertheless
92     ;; I will have to write an error checking macro around it to
93     ;; signal an error if file-length can't be determined.
94     (let* ((buffer-size (file-length stream))
95     (buffer (make-array buffer-size :element-type 'character)))
96     ;; Should also check for anything fishy like a read that does not
97     ;; match FILE-SIZE
98     (read-sequence buffer stream)
99     (parse-buffer buffer :end buffer-size)))))
100    
101    
102     (defun parse-buffer (buffer &key (start 0) end (code-block nil) (in-block nil))
103     "Takes blocks of text passed from PARSE, evaluates anything inside
104     the <?clhp ?> tags, and dumps the rest through unscathed."
105     (declare (type (array character 1) buffer)
106     (type fixnum end))
107     (let ((index (if in-block
108     (find-pi-end buffer :start start :end end)
109     (find-pi-start buffer :start start :end end))))
110     (cond
111     ((>= start end) ; Done with this buffer
112     nil)
113     ((and in-block index) ; Found the end of a code-block
114     (evaluate-code-block
115     (append code-block (coerce (subseq buffer start index) 'list)))
116     (parse-buffer buffer
117     :start (+ index #.(length *PI-END*))
118     :end end))
119     ((and (not in-block) index) ; Found code-block start
120     (write-sequence buffer *standard-output* :start start :end index)
121     (parse-buffer buffer
122     :start (+ index #.(length *PI-START*))
123     :end end
124     :in-block t))
125     (in-block (signal 'parse-error))
126     (t ; Not in code-block no start in sight
127     (write-sequence buffer *standard-output* :start start :end end)))))
128    
129     (defun evaluate-code-block (code-block)
130     "Read the Lisp object represented by CODE-BLOCK, and evaluate it."
131     (declare (type list code-block))
132     (eval (read-from-string
133     (concatenate 'string
134     "(progn "
135     (coerce code-block 'string)
136     ")"))))
137    
138     (defun echo (string &rest more)
139     "This allows long strings to be broken up into separate lines as
140     separate strings, all the strings passed will be concatenated and
141     printed to *STANDARD-OUTPUT*. It is analogous to the way string
142     constants are all concatenated by the C++ compiler, or the way strings
143     can be concatenated with the '.' operator in PHP. There is no method
144     for newlines, use the standars TERPRI or FRESH-LINE functions."
145     (dolist (chunk (cons string more)) (princ chunk)))
146    
147 aventimiglia 1.4 ;;; This needs work, it will probably need to be redone as a macro
148     ;(defun tag (name &optional attributes contents)
149     ; "Creates an XML tag named NAME, ATTRIBUTES is an a-list and the
150     ;forms in CONTENTS are evaluated as an implicit PROGN."
151     ; (format t "<~a~:{ ~a=\"~a\"~}>~%" name attributes)
152     ; (eval (cons 'progn contents))
153     ; (format t "</~a>~%" name))
154 aventimiglia 1.1
155     ;; Error handling is probably the biggest room to work here. I should
156     ;; eventually make a handler that binds the evaluation of clhp PI
157     ;; embedded code, that handler could then relay the entire block of
158     ;; code in its error reporting.
159     (defun handle-error (condition)
160     "Top level generic error"
161     (let ((error-type (type-of condition)))
162     (format t "Error: ~a" error-type)
163     (case error-type
164     ((or unbound-variable undefined-function)
165     (format t ": ~a~%" (cell-error-name condition)))
166     (end-of-file
167     (format t ": stream ~a~%" (stream-error-stream condition)))
168     (kernel:simple-file-error
169     (format t ": ~a~%" (file-error-pathname condition)))
170     ; I saw a compiler error once, then I put this here and it stopped.
171     ; Go Figure -- so this hasn't been tested
172     (compiler-error
173     (format t ": ~a~%" (c::compiler-error-message condition)))
174     (otherwise
175     (format t ": Please report this poor error reporting.~%")))))
176    
177    

  ViewVC Help
Powered by ViewVC 1.1.5