diff --git a/main.scm b/main.scm index 03b7daf..1c1131d 100755 --- a/main.scm +++ b/main.scm @@ -116,6 +116,15 @@ (a (@ (title "Permalink to this section") (href "#" ,slug)))))) +(define (adjust-relative-link tag inner) + (let ((linkurl (alist-ref-in '(@ href) inner))) + `(,tag . + ,(if (or (not adjust-relative) + (any (cute string-prefix? <> linkurl) + '("#" "/" "https://" "http://" "mailto:" "https://"))) + inner + (alist-update-in '(@ href) (list adjust-relative linkurl) inner))))) + (define (sxml-html-rules adjust-relative) `(;; assign all headings an id so you can link to them (h1 . ,enumerate-tag) @@ -125,15 +134,7 @@ (h5 . ,enumerate-tag) ;; if adjust-relative is true, all relative links should get prefixed with ;; the relative-root. - `(a . - ,(lambda (t i) - (let ((linkurl (alist-ref-in '(@ href) i))) - `(,t . - ,(if (or (not adjust-relative) - (any (cute string-prefix? <> linkurl) - '("#" "/" "https://" "http://" "mailto:" "https://"))) - i - (alist-update-in '(@ href) (list adjust-relative linkurl) i)))))) + `(a . ,adjust-relative-link) ;; this copied from lowdown html-serialization-rules* because it ;; is for some reason not exported?? (*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>)))