From 3d029d49d2ae1809ae718986f9c9b7e2adf2fd6d Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 19 Aug 2016 07:37:22 -0400 Subject: Switch from Skribe to Markdown. --- posts/2015-04-10-sxml-html-guile.skr | 235 ----------------------------------- 1 file changed, 235 deletions(-) delete mode 100644 posts/2015-04-10-sxml-html-guile.skr (limited to 'posts/2015-04-10-sxml-html-guile.skr') 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 - "")) - - (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 - " - - Hello, world! - - - -

Hello!

- -")) - - (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 []). 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 \"))")) - - (source-code - (xml-source - " -Copyright © 2015 David Thompson <davet@gnu.org>")) - - (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 -;;; -;;; 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 -;;; . - -(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 \"\" tag)))) - -(define (doctype->html doctype port) - (format port \"\" 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))))"))) -- cgit v1.2.3