diff --git a/README.md b/README.md index 7b61a01..e2d7d43 100644 --- a/README.md +++ b/README.md @@ -65,6 +65,7 @@ TODO - **feature**: display binary files as output from binary-file analysis tools like hexdump, xxd, dumpelf, elfls, readelf, etc.? - **feature**: syntax highlighting? - **feature**: markdown-render git log text +- **feature**: other mechanisms for header id application like uniqueness checking, sequential numbering ## license: agpl-3.0+ diff --git a/main.scm b/main.scm index 5d4480e..50bdf2f 100755 --- a/main.scm +++ b/main.scm @@ -68,6 +68,10 @@ (map (constantly "../")) (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 --------------------------------- (define mycss @@ -141,19 +145,25 @@ (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 (slugify _ inner) + (-> + inner + (pre-post-order* + `((*text* . + ,(lambda (_ str) + (-> + str + (string-downcase) + (string-translate "/,:;\"[]{}()=+") + (string-translate " _." "---")))) + ,@alist-conv-rules*)) + (flatten) + ((flip map) ->string) + (string-intersperse "") + (substring* 0 40))) (define (enumerate-tag tag inner) - `(,tag (@ (id ,(slugify tag inner))) ,inner)) + `(,tag (@ (id ,tag "-" ,(slugify tag inner))) ,inner)) (define (in-git-directory?) (not (eof-object? (call-with-input-pipe "git rev-parse --git-dir" read-line)))) @@ -260,21 +270,19 @@ (display "\n") (SXML->HTML (pre-post-order* - (template-wrap->sxml filename sxml) - `(;; 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) `(""))) - ;; ignore # in tree - (*text* . ,(lambda (trigger str) - (if (equal? str (unspecified-value)) - "" - ((alist-ref '*text* alist-conv-rules*) trigger str)))) - ,@alist-conv-rules*)))))) + (template-wrap->sxml filename sxml) + `(;; 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) + ;; this copied from lowdown html-serialization-rules* because it + ;; is for some reason not exported?? + (*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>))) + ;; ignore # in tree + (*text* . ,(lambda (_ str) (if (unspecified? str) "" str))) + ,@alist-conv-rules*)))))) (create-directory html-repo-path #t) ;; special files