From 5941c0d27be7b680299a5f84df29b1771d77691c Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 26 Jul 2015 22:35:29 -0400 Subject: Rename (haunt build html) to (haunt html). * haunt/build/html.scm: Delete it. * haunt/html.scm: New file. * Makefile.am (SOURCES): Remove old file. Add new file. * haunt/builder/atom.scm: Use new module. * haunt/builder/blog.scm: Likewise. * haunt/ui/serve.scm: Likewise. --- Makefile.am | 2 +- haunt/build/html.scm | 134 ------------------------------------------------- haunt/builder/atom.scm | 2 +- haunt/builder/blog.scm | 2 +- haunt/html.scm | 134 +++++++++++++++++++++++++++++++++++++++++++++++++ haunt/ui/serve.scm | 3 ++ 6 files changed, 140 insertions(+), 137 deletions(-) delete mode 100644 haunt/build/html.scm create mode 100644 haunt/html.scm diff --git a/Makefile.am b/Makefile.am index 8a06dd3..e44e91a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -47,7 +47,7 @@ SOURCES = \ haunt/page.scm \ haunt/asset.scm \ haunt/site.scm \ - haunt/build/html.scm \ + haunt/html.scm \ haunt/builder/atom.scm \ haunt/builder/blog.scm \ haunt/ui.scm \ diff --git a/haunt/build/html.scm b/haunt/build/html.scm deleted file mode 100644 index e8bb49b..0000000 --- a/haunt/build/html.scm +++ /dev/null @@ -1,134 +0,0 @@ -;;; Haunt --- Static site generator for GNU Guile -;;; Copyright © 2015 David Thompson -;;; -;;; This file is part of Haunt. -;;; -;;; Haunt is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; Haunt 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 -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with Haunt. If not, see . - -;;; Commentary: -;; -;; SXML to HTML conversion. -;; -;;; Code: - -(define-module (haunt build 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 - sxml->html-string)) - -(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)) - ;; Unescaped, raw HTML output. - (('raw html) - (display html 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)))) - -(define (sxml->html-string sxml) - "Render SXML as an HTML string." - (call-with-output-string - (lambda (port) - (sxml->html sxml port)))) diff --git a/haunt/builder/atom.scm b/haunt/builder/atom.scm index 1cfe1e3..12b0df5 100644 --- a/haunt/builder/atom.scm +++ b/haunt/builder/atom.scm @@ -30,7 +30,7 @@ #:use-module (haunt post) #:use-module (haunt page) #:use-module (haunt utils) - #:use-module (haunt build html) + #:use-module (haunt html) #:export (atom-feed atom-feeds-by-tag)) diff --git a/haunt/builder/blog.scm b/haunt/builder/blog.scm index 0a65b50..f738a09 100644 --- a/haunt/builder/blog.scm +++ b/haunt/builder/blog.scm @@ -29,7 +29,7 @@ #:use-module (haunt post) #:use-module (haunt page) #:use-module (haunt utils) - #:use-module (haunt build html) + #:use-module (haunt html) #:export (theme theme? theme-name diff --git a/haunt/html.scm b/haunt/html.scm new file mode 100644 index 0000000..0984194 --- /dev/null +++ b/haunt/html.scm @@ -0,0 +1,134 @@ +;;; Haunt --- Static site generator for GNU Guile +;;; Copyright © 2015 David Thompson +;;; +;;; This file is part of Haunt. +;;; +;;; Haunt is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; Haunt 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 +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Haunt. If not, see . + +;;; Commentary: +;; +;; SXML to HTML conversion. +;; +;;; Code: + +(define-module (haunt 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 + sxml->html-string)) + +(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)) + ;; Unescaped, raw HTML output. + (('raw html) + (display html 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)))) + +(define (sxml->html-string sxml) + "Render SXML as an HTML string." + (call-with-output-string + (lambda (port) + (sxml->html sxml port)))) diff --git a/haunt/ui/serve.scm b/haunt/ui/serve.scm index 09bcfcc..78bc811 100644 --- a/haunt/ui/serve.scm +++ b/haunt/ui/serve.scm @@ -33,6 +33,9 @@ #:use-module (haunt serve web-server) #:export (haunt-serve)) +(use-modules (system repl server)) +(spawn-server (make-tcp-server-socket)) + (define (show-help) (format #t "Usage: haunt serve [OPTION] Start an HTTP server for the current site.~%") -- cgit v1.2.3