diff options
Diffstat (limited to 'website/www/news.scm')
| -rw-r--r-- | website/www/news.scm | 36 |
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." |