Mon Mar 08 13:05:06+0100 2021
cf6059c
Highlight code in formatted content.
gitile/code.scm
| 19 | 19 | #:use-module (ice-9 match) | |
| 20 | 20 | #:use-module (syntax-highlight) | |
| 21 | 21 | #:use-module (syntax-highlight scheme) | |
| 22 | - | #:export (display-code)) | |
| 22 | + | #:export (display-code | |
| 23 | + | display-formatted-code)) | |
| 23 | 24 | ||
| 24 | 25 | (define (display-code content path) | |
| 25 | - | `(table (@ (class "file-content")) | |
| 26 | - | ,@(split-tr (highlights->sxml (highlight-code content path))))) | |
| 26 | + | (let* ((extension (car (reverse (string-split (basename path) #\.)))) | |
| 27 | + | (language (match extension | |
| 28 | + | ("scm" "scheme") | |
| 29 | + | (_ "unknown")))) | |
| 30 | + | `(table (@ (class "file-content")) | |
| 31 | + | ,@(split-tr (highlights->sxml (highlight-code content language)))))) | |
| 27 | 32 | ||
| 28 | - | (define (highlight-code content path) | |
| 29 | - | (let ((extension (car (reverse (string-split (basename path) #\.))))) | |
| 30 | - | (match extension | |
| 31 | - | ("scm" (highlight lex-scheme content)) | |
| 32 | - | (_ (list content))))) | |
| 33 | + | (define (display-formatted-code content language) | |
| 34 | + | (highlights->sxml (highlight-code content language))) | |
| 35 | + | ||
| 36 | + | (define (highlight-code content language) | |
| 37 | + | (match language | |
| 38 | + | ("scheme" (highlight lex-scheme content)) | |
| 39 | + | (_ (list content)))) | |
| 33 | 40 | ||
| 34 | 41 | (define (split-lines content) | |
| 35 | 42 | (let loop ((content content) (result '()) (line '())) |
gitile/handler.scm
| 43 | 43 | (meta (@ (charset "UTF-8"))) | |
| 44 | 44 | (meta (@ (name "viewport") (content "width=device-width, initial-scale=1"))) | |
| 45 | 45 | (link (@ (rel "stylesheet") (href "/css/gitile.css"))) | |
| 46 | + | (link (@ (rel "stylesheet") (href "/css/highlight.css"))) | |
| 46 | 47 | (link (@ (rel "icon") (href "/images/icon.png") (sizes "32x32"))) | |
| 47 | 48 | (script (@ (src "/js/gitile.js")) "") | |
| 48 | 49 | (title ,project)) |
gitile/pages.scm
| 63 | 63 | link | |
| 64 | 64 | (string-append "/" repository-name "/tree/" (or ref "-") "/" link))) | |
| 65 | 65 | ||
| 66 | - | (define check-links | |
| 66 | + | (define improve-content | |
| 67 | 67 | (match-lambda | |
| 68 | 68 | ((? string? s) s) | |
| 69 | 69 | (('a ('@ arg ...) content ...) | |
… | |||
| 77 | 77 | (arg arg)) | |
| 78 | 78 | arg)) | |
| 79 | 79 | ,@content)) | |
| 80 | + | (('code ('@ ('class language)) content) | |
| 81 | + | `(code (@ (class ,language)) | |
| 82 | + | ,(display-formatted-code | |
| 83 | + | content | |
| 84 | + | (if (string-prefix? "language-" language) | |
| 85 | + | (substring language 9) | |
| 86 | + | "unknown")))) | |
| 80 | 87 | ((tag ('@ arg ...) content ...) | |
| 81 | - | `(,tag (@ ,@arg) ,@(map check-links content))) | |
| 88 | + | `(,tag (@ ,@arg) ,@(map improve-content content))) | |
| 82 | 89 | ((tag content ...) | |
| 83 | - | `(,tag ,@(map check-links content))))) | |
| 90 | + | `(,tag ,@(map improve-content content))))) | |
| 84 | 91 | ||
| 85 | 92 | `((div (@ (class "content")) | |
| 86 | 93 | (p ,(basename path)) | |
… | |||
| 91 | 98 | ,(let ((content (utf8->string (get-file-content repo path #:ref ref)))) | |
| 92 | 99 | (if (string-suffix? ".md" path) | |
| 93 | 100 | `(article (@ (class "formatted-file-content")) | |
| 94 | - | ,(check-links (commonmark->sxml content))) | |
| 101 | + | ,(improve-content (commonmark->sxml content))) | |
| 95 | 102 | (display-code content path))))) | |
| 96 | 103 | ||
| 97 | 104 | (define* (project-files repository-name repo #:key (ref "-") (path '())) | |