Linkify manpage cross-references in HTML

scm/html/man.scm

@@ -153,7 +153,38 @@
     (concat (recurse f1 f2 words) (change-font old))))
 
 (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 'IR (lambda (IR . args) (with-fonts "I" "R" args)))
 (defmacro 'RB (lambda (RB . args) (with-fonts "R" "B" args)))