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.

1 files changed, 34 insertions, 2 deletions

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."