First commit!

11 files changed, 763 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..9148070
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,10 @@
+*.go
+/Makefile
+/Makefile.in
+/aclocal.m4
+/autom4te.cache/
+/build-aux/
+/config.log
+/config.status
+/configure
+/pre-inst-env
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..cca7fc2
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,165 @@
+		   GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions.
+
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version.
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+  Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/Makefile.am b/Makefile.am
new file mode 100644
index 0000000..ac99bef
--- /dev/null
+++ b/Makefile.am
@@ -0,0 +1,49 @@
+# guile-syntax-highlight --- General-purpose syntax highlighter
+# Copyright © 2015 David Thompson <davet@gnu.org>
+#
+# Guile-syntax-highlight 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.
+#
+# Guile-syntax-highlight 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 guile-syntax-highlight.  If not, see
+# <http://www.gnu.org/licenses/>.
+
+GOBJECTS = $(SOURCES:%.scm=%.go)
+
+nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
+nobase_go_DATA = $(GOBJECTS)
+
+# Make sure source files are installed first, so that the mtime of
+# installed compiled files is greater than that of installed source
+# files.  See
+# <http://lists.gnu.org/archive/html/guile-devel/2010-07/msg00125.html>
+# for details.
+guile_install_go_files = install-nobase_goDATA
+$(guile_install_go_files): install-nobase_modDATA
+
+CLEANFILES = $(GOBJECTS)
+EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
+GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
+SUFFIXES = .scm .go
+.scm.go:
+	$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
+
+moddir=$(prefix)/share/guile/site/2.0
+godir=$(libdir)/guile/2.0/ccache
+
+SOURCES =					\
+  syntax-highlight/parsers.scm			\
+  syntax-highlight/scheme.scm			\
+  syntax-highlight.scm
+
+EXTRA_DIST +=					\
+  pre-inst-env.in				\
+  README					\
+  guix.scm
diff --git a/README b/README
new file mode 100644
index 0000000..f0a05df
--- /dev/null
+++ b/README
@@ -0,0 +1,66 @@
+-*- mode: org -*-
+
+Guile-syntax-highlight is a general-purpose syntax highlighting
+library for GNU Guile.  It can parse code written in various
+programming languages into a simple s-expression that can be easily
+converted to HTML (via SXML) or any other format for rendering.
+
+* Example
+
+  #+BEGIN_SRC scheme
+    (use-modules (syntax-highlight)
+                 (syntax-highlight scheme)
+                 (sxml simple))
+
+    (define code
+      "(define (square x) \"Return the square of X.\" (* x x))")
+
+    ;; Get raw highlights list.
+    (define highlighted-code
+      (highlight scheme-highlighter code))
+
+    ;; Convert to SXML.
+    (define highlighted-sxml
+      (highlights->sxml highlighted-code))
+
+    ;; Write HTML to stdout.
+    (display (sxml->xml highlighted-sxml))
+    (newline)
+  #+END_SRC
+
+* Requirements
+
+  - GNU Guile >= 2.0.9
+
+* Building
+
+  Guile-syntax-highlight uses the familiar GNU build system and
+  requires GNU Make to build.
+
+** From tarball
+
+   After extracting the tarball, run:
+
+   #+BEGIN_SRC sh
+     ./configure
+     make
+     make install
+   #+END_SRC
+
+** From Git
+
+   In addition to GNU Make, building from Git requires GNU Automake
+   and Autoconf.
+
+   #+BEGIN_SRC sh
+     git clone git@dthompson.us:guile-syntax-highlight.git
+     cd guile-syntax-highlight
+     ./bootstrap
+     ./configure
+     make
+     make install
+   #+END_SRC
+
+* License
+
+  LGPLv3 or later.  See =COPYING= for the full license text.
diff --git a/bootstrap b/bootstrap
new file mode 100755
index 0000000..872167c
--- /dev/null
+++ b/bootstrap
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+autoreconf -vif
diff --git a/configure.ac b/configure.ac
new file mode 100644
index 0000000..d41b6d4
--- /dev/null
+++ b/configure.ac
@@ -0,0 +1,14 @@
+dnl -*- Autoconf -*-
+
+AC_INIT(Guile-syntax-highlight, 0.1)
+AC_CONFIG_SRCDIR(syntax-highlight)
+AC_CONFIG_AUX_DIR([build-aux])
+AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign])
+AM_SILENT_RULES([yes])
+
+AC_CONFIG_FILES([Makefile])
+AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
+
+GUILE_PROGS([2.0.9])
+
+AC_OUTPUT
diff --git a/guix.scm b/guix.scm
new file mode 100644
index 0000000..090a8f7
--- /dev/null
+++ b/guix.scm
@@ -0,0 +1,59 @@
+;;; guile-syntax-highlight --- General-purpose syntax highlighter
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;;
+;;; Guile-syntax-highlight 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.
+;;;
+;;; Guile-syntax-highlight 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 guile-syntax-highlight.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; GNU Guix development package.  To build and install, run:
+;;
+;;   guix package -f guix.scm
+;;
+;; To use as the basis for a development environment, run:
+;;
+;;   guix environment -l guix.scm
+;;
+;;; Code:
+
+(use-modules (guix packages)
+             (guix licenses)
+             (guix git-download)
+             (guix build-system gnu)
+             (gnu packages)
+             (gnu packages autotools)
+             (gnu packages guile))
+
+(package
+  (name "guile-syntax-highlight")
+  (version "0.1")
+  (source #f)
+  (build-system gnu-build-system)
+  (arguments
+   '(#:phases
+     (modify-phases %standard-phases
+       (add-after 'unpack 'bootstrap
+         (lambda _ (zero? (system* "sh" "bootstrap")))))))
+  (native-inputs
+   `(("autoconf" ,autoconf)
+     ("automake" ,automake)))
+  (inputs
+   `(("guile" ,guile-2.0)))
+  (synopsis "General-purpose syntax highlighter for GNU Guile")
+  (description "Guile-syntax-highlight is a general-purpose syntax
+highlighting library for GNU Guile.  It can parse code written in
+various programming languages into a simple s-expression that can be
+converted to HTML (via SXML) or any other format for rendering.")
+  (home-page "http://dthompson.us/software/guile-syntax-highlight")
+  (license lgpl3+))
diff --git a/pre-inst-env.in b/pre-inst-env.in
new file mode 100644
index 0000000..3d2a138
--- /dev/null
+++ b/pre-inst-env.in
@@ -0,0 +1,30 @@
+#!/bin/sh
+
+# guile-syntax-highlight --- General-purpose syntax highlighter
+# Copyright © 2015 David Thompson <davet@gnu.org>
+#
+# Guile-syntax-highlight 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.
+#
+# Guile-syntax-highlight 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 guile-syntax-highlight.  If not, see
+# <http://www.gnu.org/licenses/>.
+
+abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`"
+abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`"
+
+GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH"
+GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH"
+export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH
+
+PATH="$abs_top_builddir/scripts:$PATH"
+export PATH
+
+exec "$@"
diff --git a/syntax-highlight.scm b/syntax-highlight.scm
new file mode 100644
index 0000000..8aba7db
--- /dev/null
+++ b/syntax-highlight.scm
@@ -0,0 +1,67 @@
+;;; guile-syntax-highlight -- General-purpose syntax highlighter
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;;
+;;; Guile-syntax-highlight 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.
+;;;
+;;; Guile-syntax-highlight 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 guile-syntax-highlight.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; General-purpose syntax highlighting framework.
+;;
+;;; Code:
+
+(define-module (syntax-highlight)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-41)
+  #:export (highlight
+            highlights->sxml))
+
+(define (string->stream str)
+  "Convert the string STR into a stream of characters."
+  (stream-map (lambda (i)
+                (string-ref str i))
+              (stream-range 0 (string-length str))))
+
+(define* (highlight highlighter #:optional (stream (current-input-port)))
+  "Apply HIGHLIGHTER, a syntax highlighting procedure, to STREAM.
+STREAM may be an open port, string, or SRFI-41 character stream.  If
+STREAM is not specified, characters are read from the current input
+port."
+  (let-values (((result stream)
+                (highlighter (cond
+                              ((port? stream)
+                               (port->stream stream))
+                              ((string? stream)
+                               (string->stream stream))
+                              ((stream? stream)
+                               stream)
+                              (else
+                               (error "Cannot convert to stream: " stream))))))
+    result))
+
+(define (highlights->sxml highlights)
+  "Convert HIGHLIGHTS, a list of syntax highlighting expressions, into
+a list of SXML 'span' nodes.  Each 'span' node has a 'class' attribute
+corresponding to the highlighting tag name."
+  (define (tag->class tag)
+    (string-append "syntax-" (symbol->string tag)))
+
+  (map (match-lambda
+         ((? string? str) str)
+         ((tag text)
+          `(span (@ (class ,(tag->class tag))) ,text)))
+       highlights))
diff --git a/syntax-highlight/parsers.scm b/syntax-highlight/parsers.scm
new file mode 100644
index 0000000..2569b04
--- /dev/null
+++ b/syntax-highlight/parsers.scm
@@ -0,0 +1,198 @@
+;;; guile-syntax-highlight --- General-purpose syntax highlighter
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;;
+;;; Guile-syntax-highlight 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.
+;;;
+;;; Guile-syntax-highlight 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 guile-syntax-highlight.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Parsing utilities.
+;;
+;;; Code:
+
+(define-module (syntax-highlight parsers)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-41)
+  #:export (parse-fail
+            parse-bind
+            parse-return
+            parse-lift
+            parse-never
+            parse-map
+            parse-either
+            parse-both
+            parse-any
+            parse-each
+            parse-many
+            parse-string
+            parse-char-set
+            parse-whitespace
+            parse-delimited
+            tagged-parser))
+
+;;;
+;;; Parser combinators
+;;;
+
+(define (parse-fail stream)
+  "Return a failed parse value with STREAM as the remainder."
+  (values #f stream))
+
+(define (parse-bind proc parser)
+  (lambda (stream)
+    (let-values (((result stream) (parser stream)))
+      (if result
+          ((proc result) stream)
+          (parse-fail stream)))))
+
+(define (parse-return x)
+  "Return a parser that always yields X as the parse result."
+  (lambda (stream)
+    (values x stream)))
+
+(define (parse-lift proc)
+  "Return a procedure that wraps the result of PROC in a parser."
+  (lambda args
+    (parse-return (apply proc args))))
+
+(define (parse-never stream)
+  "Always fail to parse STREAM."
+  (parse-fail stream))
+
+(define (parse-map proc parser)
+  "Return a new parser that applies PROC to result of PARSER."
+  (parse-bind (parse-lift proc) parser))
+
+(define (parse-either first second)
+  "Create a parser that tries to parse with FIRST or, if that fails,
+parses SECOND."
+  (lambda (stream)
+    (let-values (((result stream) (first stream)))
+      (if result
+          (values result stream)
+          (second stream)))))
+
+(define (parse-both first second)
+  "Create a parser that returns a pair of the results of the parsers
+FIRST and SECOND if both are successful."
+  (lambda (stream)
+    (let-values (((result1 stream) (first stream)))
+      (if result1
+          (let-values (((result2 stream) (second stream)))
+            (if result2
+                (values (cons result1 result2) stream)
+                (parse-fail stream)))
+          (parse-fail stream)))))
+
+(define (parse-any . parsers)
+  "Create a parser that returns the result of the first successful
+parser in PARSERS.  This parser fails if no parser in PARSERS
+succeeds."
+  (fold-right parse-either parse-never parsers))
+
+(define (parse-each . parsers)
+  "Create a parser that builds a list of the results of PARSERS.  This
+parser fails without consuming any input if any parser in PARSERS
+fails."
+  (fold-right parse-both (parse-return '()) parsers))
+
+(define (parse-many parser)
+  "Create a parser that uses PARSER as many times as possible until it
+fails and return the results of each successful parse in a list.  This
+parser always succeeds."
+  (lambda (stream)
+    (let loop ((stream stream)
+               (results '()))
+      (let-values (((result remaining) (parser stream)))
+        (if result
+            (loop remaining (cons result results))
+            (values (reverse results)
+                    remaining))))))
+
+(define stream->string (compose list->string stream->list))
+
+(define (parse-string str)
+  "Create a parser that succeeds when the front of the stream contains
+the character sequence in STR."
+  (lambda (stream)
+    (let ((input (stream->string (stream-take (string-length str) stream))))
+      (if (string=? str input)
+          (values str (stream-drop (string-length str) stream))
+          (parse-fail stream)))))
+
+(define (parse-char-set char-set)
+  "Create a parser that returns a string containing a contiguous
+sequence of characters that belong to CHAR-SET."
+  (lambda (stream)
+    (let loop ((stream stream)
+               (result '()))
+      (define (stringify)
+        (if (null? result)
+            (parse-fail stream)
+            (values (list->string (reverse result))
+                    stream)))
+
+      (stream-match stream
+        (() (stringify))
+        ((head . rest)
+         (if (char-set-contains? char-set head)
+             (loop rest (cons head result))
+             (stringify)))))))
+
+(define parse-whitespace
+  (parse-char-set char-set:whitespace))
+
+(define* (parse-delimited str #:key (until str) (escape #\\))
+  "Create a parser that parses a delimited character sequence
+beginning with the string STR and ending with the string UNTIL.
+Within the sequence, ESCAPE is recognized as the escape character."
+  (let ((parse-str    (parse-string str))
+        (parse-until  (parse-string until)))
+
+    (define (stringify lst stream)
+      (values (list->string (reverse lst))
+              stream))
+
+    (define (parse-until-maybe stream)
+      (let-values (((result remaining) (parse-until stream)))
+        (and result remaining)))
+
+    (lambda (stream)
+      (let-values (((result remaining) (parse-str stream)))
+        (if result
+            (let loop ((stream remaining)
+                       (result (reverse (string->list str))))
+              (cond
+               ((stream-null? stream)
+                (stringify result stream))
+               ;; Escape character.
+               ((eqv? (stream-car stream) escape)
+                (stream-match (stream-cdr stream)
+                  (() (stringify result stream-null))
+                  ((head . rest)
+                   (loop rest (cons* head escape result)))))
+               ((parse-until-maybe stream) =>
+                (lambda (remaining)
+                  (stringify (append (string->list until) result) remaining)))
+               (else
+                (loop (stream-cdr stream) (cons (stream-car stream) result)))))
+            (parse-fail stream))))))
+
+(define (tagged-parser tag parser)
+  "Create a parser that wraps the result of PARSER in a two element
+list whose first element is TAG.."
+  (parse-map (cut list tag <>) parser))
diff --git a/syntax-highlight/scheme.scm b/syntax-highlight/scheme.scm
new file mode 100644
index 0000000..7839b1a
--- /dev/null
+++ b/syntax-highlight/scheme.scm
@@ -0,0 +1,102 @@
+;;; guile-syntax-highlight --- General-purpose syntax highlighter
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;;
+;;; Guile-syntax-highlight 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.
+;;;
+;;; Guile-syntax-highlight 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 guile-syntax-highlight.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Syntax highlighting for Scheme.
+;;
+;;; Code:
+
+(define-module (syntax-highlight scheme)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-41)
+  #:use-module (syntax-highlight parsers)
+  #:export (scheme-highlighter))
+
+(define char-set:lisp-delimiters
+  (char-set-union char-set:whitespace
+                  (char-set #\( #\) #\[ #\] #\{ #\})))
+
+(define (lisp-delimiter? char)
+  (char-set-contains? char-set:lisp-delimiters char))
+
+(define (parse-specials special-words)
+  "Create a parser for SPECIAL-WORDS, a list of important terms for a
+language."
+  (define (special word)
+    (let ((parser (tagged-parser 'special (parse-string word))))
+      (lambda (stream)
+        (let-values (((result rest-of-stream) (parser stream)))
+          (if (and result (lisp-delimiter? (stream-car stream)))
+              (values result rest-of-stream)
+              (parse-fail stream))))))
+
+  (fold parse-either parse-never (map special special-words)))
+
+(define (parse-openers openers)
+  (define (open opener)
+    (tagged-parser 'open (parse-string opener)))
+
+  (fold parse-either parse-never (map open openers)))
+
+(define (parse-closers closers)
+  (define (close closer)
+    (tagged-parser 'close (parse-string closer)))
+
+  (fold parse-either parse-never (map close closers)))
+
+(define parse-symbol
+  (tagged-parser 'symbol
+                 (parse-char-set
+                  (char-set-complement char-set:lisp-delimiters))))
+
+(define parse-keyword
+  (tagged-parser 'keyword
+                 (parse-map string-concatenate
+                            (parse-each (parse-string "#:")
+                                        (parse-char-set
+                                         (char-set-complement
+                                          char-set:lisp-delimiters))))))
+
+(define parse-string-literal
+  (tagged-parser 'string (parse-delimited "\"")))
+
+(define parse-comment
+  (tagged-parser 'comment (parse-delimited ";" #:until "\n")))
+
+(define parse-quoted-symbol
+  (tagged-parser 'symbol (parse-delimited "#{" #:until "}#")))
+
+(define scheme-highlighter
+  (parse-many
+   (parse-any parse-whitespace
+              (parse-openers '("(" "[" "{"))
+              (parse-closers '(")" "]" "}"))
+              (parse-specials '("define" "lambda"))
+              parse-string-literal
+              parse-comment
+              parse-keyword
+              parse-quoted-symbol
+              parse-symbol)))
+
+;; (scheme-highlighter
+;;  (string->stream
+;;   "(define* (foo bar #:key (baz 'quux))
+;;   \"This is a docstring!\"
+;;   #u8(1 2 3)
+;;   (1+ bar))"))