github/repo2html
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

bugfix: only prepend 'html/' to relative links

Browse source
This commit is contained in:
pho4cexa 2022-12-22 21:00:46 -08:00
parent 5e9e713847
commit 505192d7be
1 changed files with 15 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
main.scm
View file

@ -105,18 +105,21 @@
(h5 . ,enumerate-tag) (h5 . ,enumerate-tag)
;; if adjust-relative is true, all relative links should get prefixed with ;; if adjust-relative is true, all relative links should get prefixed with
;; the relative-root. ;; the relative-root.
,(if adjust-relative `(a .
`(a . ,(lambda (t i)
,(lambda (t i) (let ((linkurl (alist-ref 'href (alist-ref '@ i))))
`(,t . `(,t .
,(alist-update ,(if (and adjust-relative
'@ (not (string-prefix? "/" linkurl))
(alist-update (not (string-prefix? "https://" linkurl))
'href (not (string-prefix? "http://" linkurl))
`(,adjust-relative ,(alist-ref 'href (alist-ref '@ i))) (not (string-prefix? "mailto:" linkurl))
(alist-ref '@ i)) (not (string-prefix? "https://" linkurl)))
i))))
`(a . ,(lambda (t i) `(,t . ,i)))) (alist-update '@
(alist-update 'href `(,adjust-relative ,linkurl) (alist-ref '@ i))
i)
i)))))
;; this copied from lowdown html-serialization-rules* because it ;; this copied from lowdown html-serialization-rules* because it
;; is for some reason not exported?? ;; is for some reason not exported??
(*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>))) (*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>)))