Highlight code in formatted content.

Julien LepillerMon Mar 08 13:05:06+0100 2021

cf6059c

Highlight code in formatted content.

gitile/code.scm

1919
  #:use-module (ice-9 match)
2020
  #:use-module (syntax-highlight)
2121
  #:use-module (syntax-highlight scheme)
22-
  #:export (display-code))
22+
  #:export (display-code
23+
            display-formatted-code))
2324
2425
(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))))))
2732
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))))
3340
3441
(define (split-lines content)
3542
  (let loop ((content content) (result '()) (line '()))

gitile/handler.scm

4343
       (meta (@ (charset "UTF-8")))
4444
       (meta (@ (name "viewport") (content "width=device-width, initial-scale=1")))
4545
       (link (@ (rel "stylesheet") (href "/css/gitile.css")))
46+
       (link (@ (rel "stylesheet") (href "/css/highlight.css")))
4647
       (link (@ (rel "icon") (href "/images/icon.png") (sizes "32x32")))
4748
       (script (@ (src "/js/gitile.js")) "")
4849
       (title ,project))

gitile/pages.scm

6363
        link
6464
        (string-append "/" repository-name "/tree/" (or ref "-") "/" link)))
6565
66-
  (define check-links
66+
  (define improve-content
6767
    (match-lambda
6868
      ((? string? s) s)
6969
      (('a ('@ arg ...) content ...)

7777
                    (arg arg))
7878
                  arg))
7979
           ,@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"))))
8087
      ((tag ('@ arg ...) content ...)
81-
       `(,tag (@ ,@arg) ,@(map check-links content)))
88+
       `(,tag (@ ,@arg) ,@(map improve-content content)))
8289
      ((tag content ...)
83-
       `(,tag ,@(map check-links content)))))
90+
       `(,tag ,@(map improve-content content)))))
8491
8592
  `((div (@ (class "content"))
8693
     (p ,(basename path))

9198
    ,(let ((content (utf8->string (get-file-content repo path #:ref ref))))
9299
       (if (string-suffix? ".md" path)
93100
         `(article (@ (class "formatted-file-content"))
94-
            ,(check-links (commonmark->sxml content)))
101+
            ,(improve-content (commonmark->sxml content)))
95102
         (display-code content path)))))
96103
97104
(define* (project-files repository-name repo #:key (ref "-") (path '()))