From 821674844c1f4dc4776962cb4f7e79b783baa9c8 Mon Sep 17 00:00:00 2001
From: Timo Wilken
Date: Sun, 7 Jan 2024 22:50:33 +0100
Subject: Highlight code in cgit and show READMEs

---
 tw/system/lud.scm | 53 +++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 45 insertions(+), 8 deletions(-)

(limited to 'tw/system/lud.scm')

diff --git a/tw/system/lud.scm b/tw/system/lud.scm
index 31040e61..ab484648 100644
--- a/tw/system/lud.scm
+++ b/tw/system/lud.scm
@@ -14,8 +14,9 @@
   #:use-module (tw services web)
   #:use-module (tw system))
 
-(use-package-modules acl admin bash certs databases linux man php python rsync
-                     shells tls tor version-control video)
+(use-package-modules acl admin bash certs databases guile-xyz linux man php
+                     python python-xyz rsync shells tls tor version-control
+                     video)
 (use-service-modules certbot cgit databases file-sharing mcron monitoring
                      networking pm ssh syncthing version-control vpn web)
 
@@ -98,20 +99,56 @@
                (root-desc "Projects written by me, contributed to by me, or \
 that I just want to host somewhere.")
                ;; (root-readme "/srv/git/README.md")  ; TODO
-               ;; (readme "README.md")  ; TODO
-               ;; https://wiki.archlinux.org/title/Cgit#Syntax_highlighting
-               ;; TODO: install python-markdown, highlight/python-pygments
-               ;; TODO: see /gnu/store/...-cgit-1.2.3/lib/cgit/filters/
-               ;; (about-filter "/lib/cgit/filters/about-formatting.sh")
                (repository-directory "/srv/git")
                (strict-export "git-daemon-export-ok")  ; require presence of this file to show repo
                (remove-suffix? #t)  ; remove trailing .git in name and URL
                (clone-prefix '("https://git.twilken.net"
                                "ssh://git@git.twilken.net:22022/~"))
-               (enable-http-clone? #t)   ; avoid having to run git-daemon as well
+               ;; Cgit is a "dumb" git remote, so Guix cannot clone from it.
+               (enable-http-clone? #f)
                (noplainemail? #t)        ; hide email addresses in web interface
                (enable-index-owner? #f)  ; everything is owned by the "git" user
                (enable-index-links? #t)  ; add summary/commit/tree links in index
+
+               (source-filter
+                (program-file "cgit-source-filter"
+                  #~(begin
+                      (use-modules (ice-9 popen))
+                      (define pygmentize #$(file-append python-pygments "/bin/pygmentize"))
+                      (define file-name (cadr (command-line)))
+                      (define pipe (open-pipe* OPEN_READ pygmentize "-N" file-name))
+                      (define lexer (read pipe))
+                      (close-pipe pipe)
+                      (display "<style>")
+                      (force-output)  ; prevent subsequent output from overwriting the tag
+                      (system* pygmentize "-f" "html" "-O" "nobackground" "-S" "pastie" "-a" ".highlight")
+                      (display "</style>")
+                      (force-output)  ; prevent subsequent output from overwriting the tag
+                      (apply execl pygmentize "pygmentize" "-f" "html"
+                             (if (eq? lexer 'text)
+                                 (list "-g")
+                                 (list "-l" (symbol->string lexer)))))))
+
+               ;; See also /gnu/store/...-cgit-1.2.3/lib/cgit/filters/.
+               (readme ":README.md")
+               (extra-options '("readme=:README.org" "readme=:README"))  ; alternative readmes
+               (about-filter
+                (program-file "cgit-about-filter"
+                  (with-extensions (list guile-commonmark)
+                    (with-imported-modules '((guix build utils))
+                      #~(begin
+                          (use-modules ((guix build utils) #:select (dump-port))
+                                       ((commonmark) #:select (commonmark->sxml))
+                                       ((sxml simple) #:select (sxml->xml)))
+                          (define file-name (cadr (command-line)))
+                          (cond
+                           ((string-suffix? ".md" file-name)
+                            (sxml->xml (commonmark->sxml)))
+                           (else
+                            (display "<pre>")
+                            (dump-port (current-input-port) (current-output-port))
+                            (display "</pre>"))))))))
+
                (nginx
                 (list (nginx-server-configuration
                        (inherit %cgit-configuration-nginx)
-- 
cgit v1.2.3