Commit 74fe39de authored by Ludovic Courtès's avatar Ludovic Courtès

Use guile-syntax-highlight for Scheme snippets.

* guix-hpc.scm (%default-special-prefixes)
(lex-scheme/guix): New variables.
(syntax-highlight): New procedure.
(read-markdown-page): Call 'syntax-highlight'.
* haunt.scm (post->sxml): Likewise.
* static/css/code.css: New file.
* static/css/main.css: Import it.
* guix.scm (guile-syntax-highlight): New variable.
Use it.
parent 8fee7202
......@@ -2,6 +2,7 @@
;;; those of the GNU GPL version 3 or (at your option) any later version.
;;;
;;; Copyright © 2017 Inria
;;; Copyright © 2017 Ludovic Courtès
(define-module (guix-hpc)
#:use-module (haunt post)
......@@ -10,6 +11,10 @@
#:use-module (haunt html)
#:use-module (haunt reader)
#:use-module (haunt reader commonmark)
#:use-module (syntax-highlight)
#:use-module (syntax-highlight scheme)
#:use-module (syntax-highlight lexers)
#:use-module (ice-9 match)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:export (base-url
......@@ -17,6 +22,7 @@
css-url
post-url
syntax-highlight
base-layout
static-pages))
......@@ -43,6 +49,38 @@
"/" (site-post-slug site post))))
;;;
;;; Syntax highlighting (stolen from Guix's web site.)
;;;
(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* (base-layout body #:key (title "Guix-HPC"))
`((doctype "html")
(html (@ (lang "en"))
......@@ -111,7 +149,8 @@ representation."
(let-values (((meta body)
(read-markdown (string-append %cwd "/" file))))
(base-layout `(div (@ (class "post"))
(div (@ (class "post-body")) ,body))
(div (@ (class "post-body"))
,(syntax-highlight body)))
#:title (string-append "Guix-HPC — "
(assoc-ref meta 'title)))))
......
......@@ -15,6 +15,9 @@
(define guile-commonmark
(specification->package "guile-commonmark"))
(define guile-syntax-highlight
(specification->package "guile-syntax-highlight"))
(define source
(local-file "." "guix-hpc-web"
#:recursive? #t
......@@ -29,8 +32,12 @@
;; For Haunt.
(setenv "GUILE_LOAD_PATH"
#+(file-append guile-commonmark
"/share/guile/site/2.2"))
(string-append
#+(file-append guile-commonmark
"/share/guile/site/2.2")
":"
#+(file-append guile-syntax-highlight
"/share/guile/site/2.2")))
;; So we can read/write UTF-8 files.
(setenv "GUIX_LOCPATH"
......
......@@ -38,7 +38,7 @@
" — " ,(date->string (post-date post) "~B ~e, ~Y"))
(hr)
(div (@ (class "post-body"))
,(post-sxml post))))
,(syntax-highlight (post-sxml post)))))
(define (page->sxml site title posts prefix)
"Return the SXML for the news page of SITE, containing POSTS."
......
/* 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;
}
@import url("code.css");
@font-face {
font-family: 'Roboto';
src: url('/static/fonts/Roboto-Light.ttf') format('truetype');
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment