Refactored show functionality

This commit is contained in:
2026-08-13 12:07:29 +02:00
parent af9b57a8b9
commit d1fe41b5cc
+34 -49
View File
@@ -56,7 +56,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Exported functions ;; Exported functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Render a Git diff in a temporary HTML file. ; goal : Render a Git diff in a temporary HTML file.
; pre : diff is a unified Git diff string. ; pre : diff is a unified Git diff string.
@@ -67,9 +67,9 @@
(let ((html `(html (let ((html `(html
(head (head
(meta ((charset "utf-8"))) (meta ((charset "utf-8")))
(link ((rel "stylesheet") (href ,(highlight-css) ))) (link ((rel "stylesheet") (href ,(highlight-css))))
(link ((rel "stylesheet") (href ,(diff2html-min-css) ))) (link ((rel "stylesheet") (href ,(diff2html-min-css))))
(script ((src ,diff2html-ui-min-js)) "") (script ((src ,(diff2html-ui-min-js))) "")
(script ,(diff-script diff)) (script ,(diff-script diff))
) )
(body (body
@@ -91,50 +91,35 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (show->html show) (define (show->html show)
(let* ((lines (string-split show "\n" #:trim? #f)) (let* ((lines (string-split show "\n" #:trim? #f))
(diff-pos (let loop ((rest lines) (n 0)) (diff-pos (let loop ((rest lines)
(cond ((null? rest) #f) (n 0))
((string-prefix? (car rest) "diff --git ") n) (cond
(else (loop (cdr rest) (+ n 1)))))) ((null? rest) #f)
((string-prefix? (car rest) "diff --git ") n)
(else (loop (cdr rest) (+ n 1))))))
(header (string-join (if diff-pos (take lines diff-pos) lines) "\n")) (header (string-join (if diff-pos (take lines diff-pos) lines) "\n"))
(diff (string-join (if diff-pos (drop lines diff-pos) '()) "\n")) (diff (string-join (if diff-pos (drop lines diff-pos) '()) "\n"))
(highlight-css "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.8.0/styles/github.min.css") (html `(html
(diff2html-min-css "https://cdn.jsdelivr.net/npm/diff2html/bundles/css/diff2html.min.css") (head
(diff2html-ui-min-js "https://cdn.jsdelivr.net/npm/diff2html/bundles/js/diff2html-ui.min.js") (meta ((charset "utf-8")))
(html (link ((rel "stylesheet") (href ,(highlight-css))))
`(html (link ((rel "stylesheet") (href ,(diff2html-min-css))))
(head (style "body { font-family: sans-serif; margin: 1.5em; } pre.commit { white-space: pre-wrap; }")
(meta ((charset "utf-8"))) ,@(if diff-pos
(link ((rel "stylesheet") (href ,highlight-css))) `((script ((src ,(diff2html-ui-min-js))) "")
(link ((rel "stylesheet") (href ,diff2html-min-css))) (script ,(diff-script diff)))
(style "body { font-family: sans-serif; margin: 1.5em; } pre.commit { white-space: pre-wrap; }") '())
,@(if diff-pos )
`((script ((src ,diff2html-ui-min-js)) "") (body
(script (pre ((class "commit")) ,header)
,(format ,@(if diff-pos
(make-js `((div ((id "diff")))
"window.do_diff = function() {" (script ((type "text/javascript"))
"const diff = ~a;" "window.do_diff();"))
"const ui = new Diff2HtmlUI(" '())
" document.getElementById('diff')," ))))
" diff," (let ((tmp-file (build-path (find-system-path 'temp-dir) "racket-git-show.html")))
" {" (call-with-output-file tmp-file #:exists 'truncate
" drawFileList: true," (λ (out)
" matching: 'lines'," (display (xexpr->string html) out)))
" outputFormat: 'side-by-side'," (send-url/file tmp-file))))
" });"
"ui.draw();"
"ui.highlightCode();"
"};")
(jsexpr->string diff))))
'()))
(body
(pre ((class "commit")) ,header)
,@(if diff-pos
`((div ((id "diff")))
(script ((type "text/javascript")) "window.do_diff();"))
'()))))
(tmp-file (build-path (find-system-path 'temp-dir) "racket-git-show.html")))
(call-with-output-file tmp-file #:exists 'truncate
(λ (out) (display (xexpr->string html) out)))
(send-url/file tmp-file)))