adjust relative urls for img src too
This commit is contained in:
parent
1c5b636236
commit
e6d77be6a5
1 changed files with 9 additions and 0 deletions
9
main.scm
9
main.scm
|
@ -146,6 +146,14 @@
|
|||
inner
|
||||
(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)
|
||||
`(;; assign all headings an id so you can link to them
|
||||
(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
|
||||
;; the relative-root
|
||||
(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
|
||||
;; some reason not exported, so i can't just import it??
|
||||
(*COMMENT* . ,(lambda (_t i) (list #\< "!--" i "--" #\>)))
|
||||
|
|
Loading…
Reference in a new issue