bugfix: only prepend 'html/' to relative links
This commit is contained in:
parent
5e9e713847
commit
505192d7be
1 changed files with 15 additions and 12 deletions
21
main.scm
21
main.scm
|
@ -105,18 +105,21 @@
|
|||
(h5 . ,enumerate-tag)
|
||||
;; if adjust-relative is true, all relative links should get prefixed with
|
||||
;; the relative-root.
|
||||
,(if adjust-relative
|
||||
`(a .
|
||||
,(lambda (t i)
|
||||
(let ((linkurl (alist-ref 'href (alist-ref '@ i))))
|
||||
`(,t .
|
||||
,(alist-update
|
||||
'@
|
||||
(alist-update
|
||||
'href
|
||||
`(,adjust-relative ,(alist-ref 'href (alist-ref '@ i)))
|
||||
(alist-ref '@ i))
|
||||
i))))
|
||||
`(a . ,(lambda (t i) `(,t . ,i))))
|
||||
,(if (and adjust-relative
|
||||
(not (string-prefix? "/" linkurl))
|
||||
(not (string-prefix? "https://" linkurl))
|
||||
(not (string-prefix? "http://" linkurl))
|
||||
(not (string-prefix? "mailto:" linkurl))
|
||||
(not (string-prefix? "https://" linkurl)))
|
||||
|
||||
(alist-update '@
|
||||
(alist-update 'href `(,adjust-relative ,linkurl) (alist-ref '@ i))
|
||||
i)
|
||||
i)))))
|
||||
;; this copied from lowdown html-serialization-rules* because it
|
||||
;; is for some reason not exported??
|
||||
(*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>)))
|
||||
|
|
Loading…
Reference in a new issue