Linkify manpage cross-references in HTML

This commit is contained in:
Lassi Kortela 2023-02-15 14:39:08 +02:00
parent 1792ddc8ae
commit 8d14fa2997
1 changed files with 32 additions and 1 deletions

View File

@ -153,7 +153,38 @@
(concat (recurse f1 f2 words) (change-font old)))) (concat (recurse f1 f2 words) (change-font old))))
(defmacro 'BI (lambda (BI . args) (with-fonts "B" "I" args))) (defmacro 'BI (lambda (BI . args) (with-fonts "B" "I" args)))
(defmacro 'BR (lambda (BR . args) (with-fonts "B" "R" args)))
(define (man-page-filename page section)
(string-append page "." section))
(define (hyperlink page section body)
(let ((url (man-page-filename page section)))
(format #f "<a href=\"~a\">~a</a>" url body)))
(define (parse-section-in-parentheses str)
(let* ((n (string-length str))
(r (and (>= n 3)
(char=? #\( (string-ref str 0))
(char<=? #\1 (string-ref str 1))
(char<=? (string-ref str 1) #\9)
(cond ((char=? #\) (string-ref str (- n 1)))
1)
((and (>= n 4)
(char=? #\) (string-ref str (- n 2)))
(char=? #\, (string-ref str (- n 1))))
2)
(else
#f)))))
(and r (substring str 1 (- n r)))))
(defmacro 'BR
(lambda (BR . args)
(let ((section (and (= (length args) 2)
(parse-section-in-parentheses (list-ref args 1)))))
(if section
(hyperlink (list-ref args 0) section (with-fonts "B" "R" args))
(with-fonts "B" "R" args)))))
(defmacro 'IB (lambda (IB . args) (with-fonts "I" "B" args))) (defmacro 'IB (lambda (IB . args) (with-fonts "I" "B" args)))
(defmacro 'IR (lambda (IR . args) (with-fonts "I" "R" args))) (defmacro 'IR (lambda (IR . args) (with-fonts "I" "R" args)))
(defmacro 'RB (lambda (RB . args) (with-fonts "R" "B" args))) (defmacro 'RB (lambda (RB . args) (with-fonts "R" "B" args)))