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

auto-prepend html/ in links in toplevel readme, remove tag from id of headers

Browse source 
this code is so ugly!! augh!! definitely need to rework it and find a
better way to reach in and manipulate sxml trees
This commit is contained in:
pho4cexa 2022-12-22 14:53:13 -08:00
parent 031f975b2c
commit afe41bcc01
1 changed files with 27 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
main.scm
View file

@ -94,15 +94,29 @@
(substring* 0 40))) (substring* 0 40)))
(define (enumerate-tag tag inner) (define (enumerate-tag tag inner)
`(,tag (@ (id ,tag "-" ,(slugify tag inner))) ,inner)) `(,tag (@ (id ,(slugify tag inner))) ,inner))
(define sxml-html-rules (define (sxml-html-rules adjust-relative)
`(;; 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)
;; if adjust-relative is true, all relative links should get prefixed with
;; the relative-root.
,(if adjust-relative
`(a .
,(lambda (t i)
`(,t .
,(alist-update
'@
(alist-update
'href
`(,adjust-relative ,(alist-ref 'href (alist-ref '@ i)))
(alist-ref '@ i))
i))))
`(a . ,(lambda (t i) `(,t . ,i))))
;; this copied from lowdown html-serialization-rules* because it ;; this copied from lowdown html-serialization-rules* because it
;; is for some reason not exported?? ;; is for some reason not exported??
(*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>))) (*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>)))
@ -219,16 +233,19 @@
(create-directory destination-directory #t) (create-directory destination-directory #t)
'()) '())
(let* (;; render the sxml to a html string that we can hand to the template (let* (;; vars = global vars + file-specific vars
(vars (alist-merge vars (or newvars '())))
(rel-root-prefix (alist-ref 'relative_root vars))
;; render the sxml to a html string that we can hand to the template
(body-html (body-html
(with-output-to-string (with-output-to-string
(lambda () (lambda ()
(SXML->HTML (pre-post-order* body-sxml sxml-html-rules))))) (SXML->HTML (pre-post-order* body-sxml (sxml-html-rules
;; vars = global vars + file-specific vars + body k/v pair (if (equal? rel-root-prefix "html/")
(vars rel-root-prefix
(alist-cons #f)))))))
'content body-html ;; vars = vars + body k/v pair
(alist-merge vars (or newvars '()))))) (vars (alist-cons 'content body-html vars)))
(with-output-to-file output-filename (with-output-to-file output-filename
(lambda () (lambda ()
@ -237,6 +254,7 @@
;; main program ------------------------------------------------------------------------------ ;; main program ------------------------------------------------------------------------------
(define (generate-html-files html-repo-path templates-directory) (define (generate-html-files html-repo-path templates-directory)
;; git automatically updates this hash when you checkout/pull/etc.
(let* ((version-ident "$Id$") (let* ((version-ident "$Id$")
(source-files-list (git-repository->paths-list)) (source-files-list (git-repository->paths-list))
(template-alist (template-alist