assign ids to html headers
this code feels like it could be way shorter and prettier and it's broken for a few edge cases, here's some i can think of: - it makes no attempt to ensure the ids that it assigns are unique on the page - there might yet be weird characters inappropriate for an id that it uses anyway - it doesn't make an attempt to limit the length of the id but other than that it pretty much works
This commit is contained in:
parent
f0a0e1ecb0
commit
f315cd9237
1 changed files with 27 additions and 4 deletions
31
main.scm
31
main.scm
|
@ -139,6 +139,20 @@
|
|||
(hr)
|
||||
(footer (p "Generated by " (a (@ href "https://git.m455.casa/repo2html/") "repo2html")))))))
|
||||
|
||||
(define (slugify tag inner)
|
||||
(-> inner
|
||||
(pre-post-order*
|
||||
`(
|
||||
(*text* . ,(lambda (trig str)
|
||||
(-> str
|
||||
(string-translate "/,:;\"[]{}()=+")
|
||||
(string-translate "ABCDEFGHIJKLMNOPQRSTUVWXYZ _." "abcdefghijklmnopqrstuvwxyz---")
|
||||
)))
|
||||
,@alist-conv-rules*))))
|
||||
|
||||
(define (enumerate-tag tag inner)
|
||||
`(,tag (@ (id ,(slugify tag inner))) ,inner))
|
||||
|
||||
(define (in-git-directory?)
|
||||
(not (eof-object? (call-with-input-pipe "git rev-parse --git-dir" read-line))))
|
||||
|
||||
|
@ -245,10 +259,19 @@
|
|||
(SXML->HTML
|
||||
(pre-post-order*
|
||||
(template-wrap->sxml filename sxml)
|
||||
`((*text* . ,(lambda (trigger str)
|
||||
(if (equal? str (unspecified-value))
|
||||
""
|
||||
((alist-ref '*text* alist-conv-rules*) trigger str))))
|
||||
`(;; assign all headings an id so you can link to them
|
||||
(h1 . ,enumerate-tag)
|
||||
(h2 . ,enumerate-tag)
|
||||
(h3 . ,enumerate-tag)
|
||||
(h4 . ,enumerate-tag)
|
||||
(h5 . ,enumerate-tag)
|
||||
;; i'd expect this to be built-in, dunno why its needed
|
||||
(*COMMENT* . ,(lambda (tag str) `("<!--" ,str "-->")))
|
||||
;; ignore #<unspecified> in tree
|
||||
(*text* . ,(lambda (trigger str)
|
||||
(if (equal? str (unspecified-value))
|
||||
""
|
||||
((alist-ref '*text* alist-conv-rules*) trigger str))))
|
||||
,@alist-conv-rules*))))))
|
||||
|
||||
(create-directory html-repo-path #t)
|
||||
|
|
Loading…
Reference in a new issue