github/repo2html
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

header id-ification improvement and other cleanup

Browse source 
- fixed comment rendering
- simplified pre-post-order rule for unspecified values
- limited length of header id to 40 characters + tag name
This commit is contained in:
pho4cexa 2022-12-13 09:23:23 -08:00 committed by m455
parent 5dbecc4737
commit 609d9e1e2e
2 changed files with 35 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
README.md
View file

@ -65,6 +65,7 @@ TODO
- **feature**: display binary files as output from binary-file analysis tools like hexdump, xxd, dumpelf, elfls, readelf, etc.? - **feature**: display binary files as output from binary-file analysis tools like hexdump, xxd, dumpelf, elfls, readelf, etc.?
- **feature**: syntax highlighting? - **feature**: syntax highlighting?
- **feature**: markdown-render git log text - **feature**: markdown-render git log text
- **feature**: other mechanisms for header id application like uniqueness checking, sequential numbering
## license: agpl-3.0+ ## license: agpl-3.0+

60
main.scm
View file

@ -68,6 +68,10 @@
(map (constantly "../")) (map (constantly "../"))
(apply string-append)))) (apply string-append))))
;; like (substring) but doesn't break if start and end are too big/small
(define (substring* s start end)
(substring s (max start 0) (min end (string-length s))))
;; main code --------------------------------- ;; main code ---------------------------------
(define mycss (define mycss
@ -141,19 +145,25 @@
(hr) (hr)
(footer (p "Generated by " (a (@ href "https://git.m455.casa/repo2html/") "repo2html"))))))) (footer (p "Generated by " (a (@ href "https://git.m455.casa/repo2html/") "repo2html")))))))
(define (slugify tag inner) (define (slugify _ inner)
(-> inner (->
(pre-post-order* inner
`( (pre-post-order*
(*text* . ,(lambda (trig str) `((*text* .
(-> str ,(lambda (_ str)
(string-translate "/,:;\"[]{}()=+") (->
(string-translate "ABCDEFGHIJKLMNOPQRSTUVWXYZ _." "abcdefghijklmnopqrstuvwxyz---") str
))) (string-downcase)
,@alist-conv-rules*)))) (string-translate "/,:;\"[]{}()=+")
(string-translate " _." "---"))))
,@alist-conv-rules*))
(flatten)
((flip map) ->string)
(string-intersperse "")
(substring* 0 40)))
(define (enumerate-tag tag inner) (define (enumerate-tag tag inner)
`(,tag (@ (id ,(slugify tag inner))) ,inner)) `(,tag (@ (id ,tag "-" ,(slugify tag inner))) ,inner))
(define (in-git-directory?) (define (in-git-directory?)
(not (eof-object? (call-with-input-pipe "git rev-parse --git-dir" read-line)))) (not (eof-object? (call-with-input-pipe "git rev-parse --git-dir" read-line))))
@ -260,21 +270,19 @@
(display "<!DOCTYPE html>\n") (display "<!DOCTYPE html>\n")
(SXML->HTML (SXML->HTML
(pre-post-order* (pre-post-order*
(template-wrap->sxml filename sxml) (template-wrap->sxml filename sxml)
`(;; assign all headings an id so you can link to them `(;; assign all headings an id so you can link to them
(h1 . ,enumerate-tag) (h1 . ,enumerate-tag)
(h2 . ,enumerate-tag) (h2 . ,enumerate-tag)
(h3 . ,enumerate-tag) (h3 . ,enumerate-tag)
(h4 . ,enumerate-tag) (h4 . ,enumerate-tag)
(h5 . ,enumerate-tag) (h5 . ,enumerate-tag)
;; i'd expect this to be built-in, dunno why its needed ;; this copied from lowdown html-serialization-rules* because it
(*COMMENT* . ,(lambda (tag str) `("<!--" ,str "-->"))) ;; is for some reason not exported??
;; ignore #<unspecified> in tree (*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>)))
(*text* . ,(lambda (trigger str) ;; ignore #<unspecified> in tree
(if (equal? str (unspecified-value)) (*text* . ,(lambda (_ str) (if (unspecified? str) "" str)))
"" ,@alist-conv-rules*))))))
((alist-ref '*text* alist-conv-rules*) trigger str))))
,@alist-conv-rules*))))))
(create-directory html-repo-path #t) (create-directory html-repo-path #t)
;; special files ;; special files