sxml templates baleeted!
This commit is contained in:
pho4cexa
parent
71a56a8645
commit
bd18246b08
1 changed files with 6 additions and 105 deletions
111
main.scm
111
main.scm
|
|
@ -114,104 +114,6 @@
|
|||
(*text* . ,(lambda (_ str) (if (unspecified? str) "" str)))
|
||||
,@alist-conv-rules*))
|
||||
|
||||
;; vvv sxml template writer ------------------------------------------------
|
||||
;;
|
||||
;; if we decide to only use the ersatz templates, this whole chunk can be deleted!
|
||||
;;
|
||||
;; or we can keep it as a fall-back, or let the user choose which they prefer? idk
|
||||
|
||||
(define (make-template-writer-sxml #!optional vars)
|
||||
(let* ((source-files-list (alist-ref 'source_files_list vars)))
|
||||
|
||||
(lambda (output-filename body-sxml #!optional newvars)
|
||||
(if-let (destination-directory (pathname-directory output-filename))
|
||||
(create-directory destination-directory #t)
|
||||
'())
|
||||
(let ((vars (alist-merge vars (or newvars '()))))
|
||||
(with-output-to-file output-filename
|
||||
(lambda ()
|
||||
(define-values (_ _ _ _ relative-root) (pathparts (or (alist-ref 'source_file vars) "")))
|
||||
(display "<!DOCTYPE html>\n")
|
||||
(SXML->HTML
|
||||
(pre-post-order*
|
||||
(my-sxml-template body-sxml vars)
|
||||
sxml-html-rules))))))))
|
||||
|
||||
(define (my-sxml-template body-sxml vars)
|
||||
(let (
|
||||
(clone-url-prefix (alist-ref 'clone_url_prefix vars))
|
||||
(forge-title (alist-ref 'forge_title vars))
|
||||
(h1 (alist-ref 'h1 vars))
|
||||
(issues-file (alist-ref 'issues_file vars))
|
||||
(license-file (alist-ref 'license_file vars))
|
||||
(readme-file (alist-ref 'readme_file vars))
|
||||
(relative-root (alist-ref 'relative_root vars))
|
||||
(repository-description (alist-ref 'repository_description vars))
|
||||
(repository-name (alist-ref 'repository_name vars))
|
||||
(source-file (alist-ref 'source_file vars))
|
||||
)
|
||||
`(html (@ lang en)
|
||||
(head
|
||||
(title ,(string-append forge-title " - " repository-name))
|
||||
(meta (@ charset utf-8))
|
||||
(meta (@ (name viewport) (content "width=device-width, initial-scale-1.0, user-scalable=yes")))
|
||||
(link (@ (rel icon) (href "data:,")))
|
||||
(meta (@ (name description) (content ,repository-description)))
|
||||
(style ,my-css))
|
||||
(body
|
||||
(h1 ,h1)
|
||||
(h2 ,repository-name)
|
||||
(p "clone url:" ,clone-url-prefix "/" ,repository-name)
|
||||
(nav
|
||||
,(if readme-file
|
||||
`((a (@ href ,relative-root "index.html") "about")
|
||||
(a (@ href ,relative-root "files.html") "files"))
|
||||
`((a (@ href ,relative-root "index.html") "files")))
|
||||
,(when license-file
|
||||
`(a (@ href ,relative-root ,license-file ".html") "license"))
|
||||
,(when issues-file
|
||||
`(a (@ href ,relative-root ,issues-file ".html") "issues"))
|
||||
(a (@ href ,relative-root "commits.html") "commits")
|
||||
(a (@ href ,relative-root "contributors.html") "contributors")))
|
||||
(hr)
|
||||
,body-sxml
|
||||
(hr)
|
||||
(footer (p "Generated by " (a (@ href "https://git.m455.casa/repo2html/") "repo2html") " using sxml templates")))))
|
||||
|
||||
(define my-css
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(write-css
|
||||
'(css
|
||||
(body
|
||||
(margin 0 auto)
|
||||
(max-width 700px))
|
||||
((pre code)
|
||||
(background-color "#ffd9df"))
|
||||
(pre
|
||||
(overflow scroll)
|
||||
(padding 15px 20px)
|
||||
(white-space pre))
|
||||
(a
|
||||
(color blue))
|
||||
((// nav a)
|
||||
(margin-right 10px))
|
||||
(hr
|
||||
(border 0)
|
||||
(border-bottom 1px solid black)
|
||||
(margin-top 16px))
|
||||
(td
|
||||
(padding 0em .5em)
|
||||
(vertical-align top))
|
||||
(footer
|
||||
(font-size small)
|
||||
(text-align right))
|
||||
((= id file-path)
|
||||
;; change this to your liking
|
||||
))))))
|
||||
|
||||
;; ^^^ sxml template writer ------------------------------------------------
|
||||
|
||||
;; reading in data from git commands
|
||||
|
||||
(define (in-git-directory?)
|
||||
|
|
@ -336,7 +238,7 @@
|
|||
(lambda ()
|
||||
(display (eval-statements template models: (alist->tvals vars))))))))
|
||||
|
||||
; main program ------------------------------------------------------------------------------
|
||||
;; main program ------------------------------------------------------------------------------
|
||||
|
||||
(define (generate-html-files html-repo-path templates-directory)
|
||||
(let* ((source-files-list (git-repository->paths-list))
|
||||
|
|
@ -358,11 +260,7 @@
|
|||
. ,(and (find (lambda (x) (string-prefix? "ISSUES/" x)) source-files-list) "ISSUES"))
|
||||
))
|
||||
(write-with-template
|
||||
;; which template writer do you prefer to use? uncomment one of the next two lines.
|
||||
(if (equal? "sxml" templates-directory)
|
||||
(make-template-writer-sxml template-alist)
|
||||
(make-template-writer-ersatz templates-directory template-alist)
|
||||
)))
|
||||
(make-template-writer-ersatz templates-directory template-alist)))
|
||||
|
||||
(create-directory html-repo-path #t)
|
||||
;; special files
|
||||
|
|
@ -405,7 +303,7 @@
|
|||
(when (file-exists? (make-pathname html-repo-path "ISSUES"))
|
||||
(write-with-template (make-pathname html-repo-path "ISSUES" "html") (issueslist->sxml source-files-list)))))
|
||||
|
||||
(define (main #!optional html-repo-path (templates-directory "sxml"))
|
||||
(define (main #!optional html-repo-path templates-directory)
|
||||
|
||||
(unless html-repo-path
|
||||
(bail "please specify a destination directory for html files"))
|
||||
|
|
@ -413,6 +311,9 @@
|
|||
(unless (in-git-directory?)
|
||||
(bail "woops this isn't a git directory"))
|
||||
|
||||
(unless templates-directory
|
||||
(bail "please specify the directory containing the templates.\nnote: built-in sxml templates have been removed."))
|
||||
|
||||
(generate-html-files html-repo-path templates-directory))
|
||||
|
||||
(apply main (command-line-arguments))
|
||||
|
|
|
|||
Loading…
Reference in a new issue