root/trunk/bknr/datastore/src/xml/xml.lisp

Revision 2417, 1.9 kB (checked in by hhubner, 1 year ago)

Snapshot the port of the BKNR web framework to Hunchentoot.
In the process, the request argument that many of functions had has been
removed. Instead, the request is accessed through the dynamic environment,
which is the default mode for Hunchentoot.

This commit works with SBCL and cmucl, but I am now workin with SBCL as
Slime works way better there, in particular for debugging errors in
hunchentoot handlers.

All BKNR handlers are registered in the BKNR.WEB::*HANDLERS* special variable.
BKNR registers only one dispatcher in Hunchtentoots *DISPATCHER-TABLE* that
scans the BKNR handlers for a match. This is done to enhance debugability,
as the *HANDLERS* table contains PAGE-HANDLER objects that carry information
about their path etc.

Line 
1 (in-package :bknr.xml)
2
3 (defun node-children-nodes (xml)
4   (remove-if-not #'consp (node-children xml)))
5
6 (defun find-child (xml node-name)
7   (let ((children (node-children-nodes xml)))
8     (find node-name children :test #'string-equal :key #'node-name)))
9
10 (defun find-children (xml node-name)
11   (let ((children (node-children-nodes xml)))
12     (find-all node-name children :test #'string-equal :key #'node-name)))
13
14 (defun node-string-body (xml)
15   (let ((children (remove-if #'consp (node-children xml))))
16     (if (every #'stringp children)
17         (apply #'concatenate 'string children)
18         (error "Some children are not strings"))))
19
20 (defun node-attribute (xml attribute-name)
21   (cadr (assoc attribute-name (node-attrs xml) :test #'equal)))
22
23 (defun node-child-string-body (xml node-name)
24   (let ((child (find-child xml node-name)))
25     (if (and child (consp child))
26         (node-string-body child)
27         nil)))
28
29 (defun node-to-html (node &optional (stream *standard-output*))
30   (when (stringp node)
31     (write-string node)
32     (return-from node-to-html))
33   (write-char #\< stream)
34   (when (node-ns node)
35     (write-string (node-ns node) stream)
36     (write-char #\: stream))
37   (write-string (node-name node) stream)
38   (loop for (key value) in (node-attrs node)
39         do (write-char #\Space stream)
40         (write-string key stream)
41         (write-char #\= stream)
42         (write-char #\" stream)
43         (write-string value stream)
44         (write-char #\" stream))
45   (if (node-children node)
46       (progn
47         (write-char #\> stream)
48         (write-char #\Newline stream)
49         (dolist (child (node-children node))
50           (node-to-html child stream))
51         (write-char #\< stream)
52         (write-char #\/ stream)
53         (when (node-ns node)
54           (write-string (node-ns node) stream)
55           (write-char #\: stream))
56         (write-string (node-name node) stream)
57         (write-char #\> stream)
58         (write-char #\Newline stream))
59       (progn (write-char #\Space stream)
60              (write-char #\/ stream)
61              (write-char #\> stream)
62              (write-char #\Newline stream))))
63
Note: See TracBrowser for help on using the browser.