website: news: Highlight Scheme syntax.

* website/www/news.scm (%default-special-prefixes, lex-scheme/guix): New
variables.
(syntax-highlight): New procedure.
(post->sxml): Use it.
* website/static/base/css/code.css: New file.
* website/static/base/css/news.css: Import it.
* website/posts/running-services-in-containers.md: Use ```scheme for the
Scheme snippet.

4 files changed, 69 insertions, 3 deletions

diff --git a/website/posts/running-services-in-containers.md b/website/posts/running-services-in-containers.md
index 67671b0..d8c6a41 100644
--- a/website/posts/running-services-in-containers.md
+++ b/website/posts/running-services-in-containers.md
@@ -117,7 +117,7 @@ and
 [Tor](https://git.savannah.gnu.org/cgit/guix.git/commit/?id=ee295346ce81c276ffb4ee34cc6f5b134b415097)
 are minimal.  The end result, for Tor, looks like this:
 
-```
+```scheme
 (let ((torrc (tor-configuration->torrc config)))
   (with-imported-modules (source-module-closure
 						  '((gnu build shepherd)
diff --git a/website/static/base/css/code.css b/website/static/base/css/code.css
new file mode 100644
index 0000000..c308845
--- /dev/null
+++ b/website/static/base/css/code.css
@@ -0,0 +1,33 @@
+/* Syntax highlighting code, by David Thompson, borrowed
+   from:
+     https://git.dthompson.us/blog.git/blob_plain/refs/heads/haunt-migration:/css/dthompson.css
+   David Thompson gives permission for this to be GPLv3+ and CC BY-SA 4.0
+
+   Modified significantly since.
+*/
+
+
+.syntax-special, .syntax-element {
+    color: #856;
+    font-weight: bold;
+}
+
+.syntax-symbol {
+    color: #423;
+}
+
+.syntax-string {
+    color: #484;
+}
+
+.syntax-keyword, .syntax-attribute {
+    color: #921;
+}
+
+.syntax-comment {
+    color: #666;
+}
+
+.syntax-open, .syntax-close {
+    color: #688;
+}
diff --git a/website/static/base/css/news.css b/website/static/base/css/news.css
index f0383e2..e2c49ba 100644
--- a/website/static/base/css/news.css
+++ b/website/static/base/css/news.css
@@ -4,6 +4,7 @@
 */
 
 @import url("article.css");
+@import url("code.css");
 
 .example {
     border-style: none;
diff --git a/website/www/news.scm b/website/www/news.scm
index e6b59ef..a1d17df 100644
--- a/website/www/news.scm
+++ b/website/www/news.scm
@@ -1,5 +1,5 @@
 ;;; GuixSD website --- GNU's advanced distro website
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GuixSD website.
 ;;;
@@ -22,6 +22,10 @@
   #:use-module (haunt site)
   #:use-module (haunt post)
   #:use-module (haunt builder blog)
+  #:use-module (syntax-highlight)
+  #:use-module (syntax-highlight scheme)
+  #:use-module (syntax-highlight lexers)
+  #:use-module (ice-9 match)
   #:use-module (srfi srfi-19)
   #:export (post-url
             %news-haunt-theme))
@@ -30,6 +34,34 @@
   "Return the URL of POST, a Haunt blog post, for SITE."
   (base-url (string-append "news/" (site-post-slug site post) ".html")))
 
+(define %default-special-prefixes
+  '("define" "syntax"))
+
+(define lex-scheme/guix
+  ;; Specialized lexer for the Scheme we use in Guix.
+  ;; TODO: Add #~, #$, etc.
+  (make-scheme-lexer (cons* "with-imported-modules"
+                            "gexp" "ungexp"
+                            "ungexp-native" "ungexp-splicing"
+                            "ungexp-native-splicing"
+                            "mlet" "mlet*"
+                            "match"
+                            %default-special-symbols)
+                     %default-special-prefixes))
+
+(define (syntax-highlight sxml)
+  "Recurse over SXML and syntax-highlight code snippets."
+  (match sxml
+    (('code ('@ ('class "language-scheme")) code-snippet)
+     `(code ,(highlights->sxml
+              (highlight lex-scheme/guix code-snippet))))
+    ((tag ('@ attributes ...) body ...)
+     `(,tag (@ ,@attributes) ,@(map syntax-highlight body)))
+    ((tag body ...)
+     `(,tag ,@(map syntax-highlight body)))
+    ((? string? str)
+     str)))
+
 (define* (post->sxml post #:key post-uri)
   "Return the SXML for POST."
   `(div (h2 (@ (class "title"))
@@ -41,7 +73,7 @@
              ,(post-ref post 'author)
              " — " ,(date->string (post-date post) "~B ~e, ~Y"))
         (div (@ (class "post-body"))
-             ,(post-sxml post))))
+             ,(syntax-highlight (post-sxml post)))))
 
 (define (news-page-sxml site title posts prefix)
   "Return the SXML for the news page of SITE, containing POSTS."