Changed file source image view path to absolute path

- my last fix used to use a relative path to the image, this fix makes
  an absolute path
- i added a parameter to the display-source-html function so i could use
  the repository-name in the format functions that are used there
- changed some of the string template "repo-name"s to "repository-name"s
  to stay consistent with the rest of the main.scm
This commit is contained in:
m455 2022-12-07 21:42:04 -05:00
parent 7dbf2fb3fc
commit 4bc524d02c

View file

@ -19,7 +19,7 @@
(define DESCRIPTION (or (get-environment-variable "REPO2HTML_DESCRIPTION") "my git repositories")) (define DESCRIPTION (or (get-environment-variable "REPO2HTML_DESCRIPTION") "my git repositories"))
(define H1 (or (get-environment-variable "REPO2HTML_H1") "git.example.com")) (define H1 (or (get-environment-variable "REPO2HTML_H1") "git.example.com"))
(define (populate-html-template repo-name display-body-thunk) (define (populate-html-template repository-name display-body-thunk)
(display #<#string-block (display #<#string-block
<!DOCTYPE html> <!DOCTYPE html>
<html lang="en"> <html lang="en">
@ -56,12 +56,12 @@ hr {
</head> </head>
<body> <body>
<h1>#{H1}</h1> <h1>#{H1}</h1>
<h2>#{repo-name}</h2> <h2>#{repository-name}</h2>
<p>clone url: #{CLONE-URL}/#{repo-name}</p> <p>clone url: #{CLONE-URL}/#{repository-name}</p>
<nav> <nav>
<a href="/#{repo-name}/index.html">about</a> <a href="/#{repository-name}/index.html">about</a>
<a href="/#{repo-name}/files.html">files</a> <a href="/#{repository-name}/files.html">files</a>
<a href="/#{repo-name}/contributors.html">contributors</a> <a href="/#{repository-name}/contributors.html">contributors</a>
</nav> </nav>
<hr> <hr>
string-block string-block
@ -88,7 +88,7 @@ string-block
(call-with-input-pipe read-lines) (call-with-input-pipe read-lines)
(string-intersperse "\n"))) (string-intersperse "\n")))
(define (display-source-html source-file) ;; src/main.scm (define (display-source-html repository-name source-file) ;; src/main.scm
(format #t "<p id=\"file-path\">~a</p>" source-file) (format #t "<p id=\"file-path\">~a</p>" source-file)
(case (string->symbol (or (pathname-extension source-file) "no-extension")) (case (string->symbol (or (pathname-extension source-file) "no-extension"))
((md markdown) ((md markdown)
@ -103,9 +103,9 @@ string-block
(display "</pre>")) (display "</pre>"))
(markdown->html (git-file->string source-file)))) (markdown->html (git-file->string source-file))))
((jpg jpeg png gif webp webm apng avif svgz ico) ((jpg jpeg png gif webp webm apng avif svgz ico)
(format #t "<p><img src=\"/~a\" /></p>" source-file)) (format #t "<p><img src=\"/~a/~a\" /></p>" repository-name source-file))
((svg) ((svg)
(format #t "<p><img src=\"/~a\" /></p>" source-file) (format #t "<p><img src=\"/~a/~a\" /></p>" repository-name source-file)
(display "<pre>") (display "<pre>")
(display-escaped-html (git-file->string source-file)) (display-escaped-html (git-file->string source-file))
(display "</pre>")) (display "</pre>"))
@ -160,7 +160,7 @@ string-block
(lambda (source-file) (lambda (source-file)
(write-with-template (write-with-template
(string-append source-file ".html") (string-append source-file ".html")
(lambda () (display-source-html source-file))) (lambda () (display-source-html repository-name source-file)))
(case (string->symbol (or (pathname-extension source-file) "")) (case (string->symbol (or (pathname-extension source-file) ""))
((jpg jpeg png gif webp webm svg apng avif svgz ico) ((jpg jpeg png gif webp webm svg apng avif svgz ico)
(system (format "git show HEAD:~a > ~a" (system (format "git show HEAD:~a > ~a"