From 505192d7becde895bc435eb4cb3d7699d40839b4 Mon Sep 17 00:00:00 2001 From: pho4cexa Date: Thu, 22 Dec 2022 21:00:46 -0800 Subject: [PATCH] bugfix: only prepend 'html/' to relative links --- main.scm | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/main.scm b/main.scm index d831c92..70961e0 100755 --- a/main.scm +++ b/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) - `(,t . - ,(alist-update - '@ - (alist-update - 'href - `(,adjust-relative ,(alist-ref 'href (alist-ref '@ i))) - (alist-ref '@ i)) - i)))) - `(a . ,(lambda (t i) `(,t . ,i)))) + `(a . + ,(lambda (t i) + (let ((linkurl (alist-ref 'href (alist-ref '@ i)))) + `(,t . + ,(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 "--" #\>)))