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

adjust relative urls for img src too

Browse source
This commit is contained in:
pho4cexa 2023-01-15 11:30:14 -08:00
parent 1c5b636236
commit e6d77be6a5
1 changed files with 9 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
main.scm
View file

@ -146,6 +146,14 @@
inner inner
(alist-update-in '(@ href) (cons adjust-relative (append linkurl '(".html"))) inner equal?)))) (alist-update-in '(@ href) (cons adjust-relative (append linkurl '(".html"))) inner equal?))))
(define (adjust-relative-src adjust-relative inner)
(let* ((srcurl (alist-ref-in '(@ src) inner equal?))
(srcurl-startswith (cute string-prefix? <> (car srcurl))))
(if
(any srcurl-startswith '("/" "http://" "https://"))
inner
(alist-update-in '(@ src) (list adjust-relative srcurl) inner equal?))))
(define (sxml-html-rules adjust-relative) (define (sxml-html-rules adjust-relative)
`(;; assign all headings an id so you can link to them `(;; assign all headings an id so you can link to them
(h1 . ,(lambda (t i) (cons t (enumerate-tag i)))) (h1 . ,(lambda (t i) (cons t (enumerate-tag i))))
@ -156,6 +164,7 @@
;; 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
(a . ,(lambda (t i) (cons t (adjust-relative-link adjust-relative i)))) (a . ,(lambda (t i) (cons t (adjust-relative-link adjust-relative i))))
(img . ,(lambda (t i) (cons t (adjust-relative-src adjust-relative i))))
;; this copied from lowdown's html-serialization-rules* because it is for ;; this copied from lowdown's html-serialization-rules* because it is for
;; some reason not exported, so i can't just import it?? ;; some reason not exported, so i can't just import it??
(*COMMENT* . ,(lambda (_t i) (list #\< "!--" i "--" #\>))) (*COMMENT* . ,(lambda (_t i) (list #\< "!--" i "--" #\>)))