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

Contents of /clhp/clhp.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations)
Thu Sep 18 20:57:30 2003 UTC (10 years, 7 months ago) by aventimiglia
Branch: MAIN
Changes since 1.3: +10 -10 lines
Finished writing the initial documentation, I'm ready for a release,
but I don't think I'll have time until next week. The release is
pretty much a very alpha one anyhow, but it will be enough that it is
useable.

Anyway, everything in INSTALL should work the way it is now. Of course
as it spreads out to different distros there may be some problems. And
some people may want to use wrapper scripts rather than
binfmt_misc. Of course once I right an Apache module, none of this
will make a difference.
1 aventimiglia 1.1 (ext:file-comment
2 aventimiglia 1.4 "$Id: clhp.lisp,v 1.4 2003/09/18 20:57:30 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.3 #.(or nil ; Set this for releases
44 aventimiglia 1.4 (let* ((trimmed (string-trim "$ Date:" "$Date: 2003/09/18 20:57:30 $"))
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