summaryrefslogtreecommitdiff
path: root/posts/2015-04-10-sxml-html-guile.skr
diff options
context:
space:
mode:
Diffstat (limited to 'posts/2015-04-10-sxml-html-guile.skr')
-rw-r--r--posts/2015-04-10-sxml-html-guile.skr235
1 files changed, 0 insertions, 235 deletions
diff --git a/posts/2015-04-10-sxml-html-guile.skr b/posts/2015-04-10-sxml-html-guile.skr
deleted file mode 100644
index beea865..0000000
--- a/posts/2015-04-10-sxml-html-guile.skr
+++ /dev/null
@@ -1,235 +0,0 @@
-(post
- :title "Rendering HTML with SXML and GNU Guile"
- :date (make-date* 2015 04 10)
- :tags '("gnu" "guile" "wsu")
- :summary "With a little effort, SXML can be used for HTML templates"
-
- (p [GNU Guile provides modules for working with XML documents called
- SXML. SXML provides an elegant way of writing XML documents as
- s-expressions that can be easily manipulated in Scheme. Here’s an
- example:])
-
- (source-code
- (scheme-source
- "(sxml->xml '(foo (bar (@ (attr \"something\")))))"))
-
- (source-code
- (xml-source
- "<foo><bar attr=\"something\" /></foo>"))
-
- (p [I don’t know about you, but I work with HTML documents much more
- often than XML. Since HTML is very similar to XML, we should be able
- to represent it with SXML, too!])
-
- (source-code
- (scheme-source
- "(sxml->xml
- '(html
- (head
- (title \"Hello, world!\")
- (script (@ (src \"foo.js\"))))
- (body
- (h1 \"Hello!\"))))"))
-
- (source-code
- (xml-source
- "<html>
- <head>
- <title>Hello, world!</title>
- <script src=\"foo.js\" /> <!-- what? -->
- </head>
- <body>
- <h1>Hello!</h1>
- </body>
-</html>"))
-
- (p [That ,(code [<script>]) tag doesn’t look right! Script tags
- don’t close themselves like that. Well, we could hack around it:])
-
- (source-code
- (scheme-source
- "(sxml->xml
- '(html
- (head
- (title \"Hello, world!\")
- (script (@ (src \"foo.js\")) \"\"))
- (body
- (h1 \"Hello!\"))))"))
-
- (source-code
- (xml-source
- "<html>
- <head>
- <title>Hello, world!</title>
- <script src=\"foo.js\"></script>
- </head>
- <body>
- <h1>Hello!</h1>
- </body>
-</html>"))
-
- (p [There’s no bug. The improper rendering happens because HTML, while
- similar to XML, has some different syntax rules. Instead of using
- ,(code [sxml->xml]) a new procedure that is tailored to the HTML syntax
- is needed. Introducing ,(code [sxml->html]):])
-
- (source-code
- (scheme-source
- "(define* (sxml->html tree #:optional (port (current-output-port)))
- \"Write the serialized HTML form of TREE to PORT.\"
- (match tree
- (() *unspecified*)
- (('doctype type)
- (doctype->html type port))
- (((? symbol? tag) ('@ attrs ...) body ...)
- (element->html tag attrs body port))
- (((? symbol? tag) body ...)
- (element->html tag '() body port))
- ((nodes ...)
- (for-each (cut sxml->html <> port) nodes))
- ((? string? text)
- (string->escaped-html text port))
- ;; Render arbitrary Scheme objects, too.
- (obj (object->escaped-html obj port))))"))
-
- (p [In addition to being aware of void elements and escape
-characters, it can also render ,(code ['(doctype "html")]) as
-,(code [<!DOCTYPE html>]). If we replace ,(code [sxml->xml])
-with ,(code [sxml->html]) in the failing example above we can see
-that it does the right thing.])
-
- (source-code
- (scheme-source
- "(sxml->html
- '((script (@ (src \"foo.js\")))
- \"Copyright © 2015 David Thompson <davet@gnu.org>\"))"))
-
- (source-code
- (xml-source
- "<script src=\"foo.js\"></script>
-Copyright © 2015 David Thompson &lt;davet@gnu.org&gt;"))
-
- (p [Here’s the full version of my ,(code "(sxml html)") module. It’s
-quite brief, which is a nice bonus. This code requires Guile 2.0.11
-or greater.])
-
- (p [Happy hacking!])
-
- (source-code
- (scheme-source
- ";;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;;
-;;; This library is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU Lesser General Public License
-;;; as published by the Free Software Foundation; either version 3 of
-;;; the License, or (at your option) any later version.
-;;;
-;;; This library is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; Lesser General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with this library. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-(define-module (sxml html)
- #:use-module (sxml simple)
- #:use-module (srfi srfi-26)
- #:use-module (ice-9 match)
- #:use-module (ice-9 format)
- #:use-module (ice-9 hash-table)
- #:export (sxml->html))
-
-(define %void-elements
- '(area
- base
- br
- col
- command
- embed
- hr
- img
- input
- keygen
- link
- meta
- param
- source
- track
- wbr))
-
-(define (void-element? tag)
- \"Return #t if TAG is a void element.\"
- (pair? (memq tag %void-elements)))
-
-(define %escape-chars
- (alist->hash-table
- '((#\\\" . \"quot\")
- (#\\& . \"amp\")
- (#\\' . \"apos\")
- (#\\< . \"lt\")
- (#\\> . \"gt\"))))
-
-(define (string->escaped-html s port)
- \"Write the HTML escaped form of S to PORT.\"
- (define (escape c)
- (let ((escaped (hash-ref %escape-chars c)))
- (if escaped
- (format port \"&~a;\" escaped)
- (display c port))))
- (string-for-each escape s))
-
-(define (object->escaped-html obj port)
- \"Write the HTML escaped form of OBJ to PORT.\"
- (string->escaped-html
- (call-with-output-string (cut display obj <>))
- port))
-
-(define (attribute-value->html value port)
- \"Write the HTML escaped form of VALUE to PORT.\"
- (if (string? value)
- (string->escaped-html value port)
- (object->escaped-html value port)))
-
-(define (attribute->html attr value port)
- \"Write ATTR and VALUE to PORT.\"
- (format port \"~a=\\\"\" attr)
- (attribute-value->html value port)
- (display #\\\" port))
-
-(define (element->html tag attrs body port)
- \"Write the HTML TAG to PORT, where TAG has the attributes in the
-list ATTRS and the child nodes in BODY.\"
- (format port \"<~a\" tag)
- (for-each (match-lambda
- ((attr value)
- (display #\\space port)
- (attribute->html attr value port)))
- attrs)
- (if (and (null? body) (void-element? tag))
- (display \" />\" port)
- (begin
- (display #\\> port)
- (for-each (cut sxml->html <> port) body)
- (format port \"</~a>\" tag))))
-
-(define (doctype->html doctype port)
- (format port \"<!DOCTYPE ~a>\" doctype))
-
-(define* (sxml->html tree #:optional (port (current-output-port)))
- \"Write the serialized HTML form of TREE to PORT.\"
- (match tree
- (() *unspecified*)
- (('doctype type)
- (doctype->html type port))
- (((? symbol? tag) ('@ attrs ...) body ...)
- (element->html tag attrs body port))
- (((? symbol? tag) body ...)
- (element->html tag '() body port))
- ((nodes ...)
- (for-each (cut sxml->html <> port) nodes))
- ((? string? text)
- (string->escaped-html text port))
- ;; Render arbitrary Scheme objects, too.
- (obj (object->escaped-html obj port))))")))
generated by cgit v1.2.3 (git 2.25.4) at 2024-09-30 06:00:38 +0000