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)))
|
(*text* . ,(lambda (_ str) (if (unspecified? str) "" str)))
|
||||||
,@alist-conv-rules*))
|
,@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
|
;; reading in data from git commands
|
||||||
|
|
||||||
(define (in-git-directory?)
|
(define (in-git-directory?)
|
||||||
|
|
@ -336,7 +238,7 @@
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(display (eval-statements template models: (alist->tvals vars))))))))
|
(display (eval-statements template models: (alist->tvals vars))))))))
|
||||||
|
|
||||||
; main program ------------------------------------------------------------------------------
|
;; main program ------------------------------------------------------------------------------
|
||||||
|
|
||||||
(define (generate-html-files html-repo-path templates-directory)
|
(define (generate-html-files html-repo-path templates-directory)
|
||||||
(let* ((source-files-list (git-repository->paths-list))
|
(let* ((source-files-list (git-repository->paths-list))
|
||||||
|
|
@ -358,11 +260,7 @@
|
||||||
. ,(and (find (lambda (x) (string-prefix? "ISSUES/" x)) source-files-list) "ISSUES"))
|
. ,(and (find (lambda (x) (string-prefix? "ISSUES/" x)) source-files-list) "ISSUES"))
|
||||||
))
|
))
|
||||||
(write-with-template
|
(write-with-template
|
||||||
;; which template writer do you prefer to use? uncomment one of the next two lines.
|
(make-template-writer-ersatz templates-directory template-alist)))
|
||||||
(if (equal? "sxml" templates-directory)
|
|
||||||
(make-template-writer-sxml template-alist)
|
|
||||||
(make-template-writer-ersatz templates-directory template-alist)
|
|
||||||
)))
|
|
||||||
|
|
||||||
(create-directory html-repo-path #t)
|
(create-directory html-repo-path #t)
|
||||||
;; special files
|
;; special files
|
||||||
|
|
@ -405,7 +303,7 @@
|
||||||
(when (file-exists? (make-pathname html-repo-path "ISSUES"))
|
(when (file-exists? (make-pathname html-repo-path "ISSUES"))
|
||||||
(write-with-template (make-pathname html-repo-path "ISSUES" "html") (issueslist->sxml source-files-list)))))
|
(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
|
(unless html-repo-path
|
||||||
(bail "please specify a destination directory for html files"))
|
(bail "please specify a destination directory for html files"))
|
||||||
|
|
@ -413,6 +311,9 @@
|
||||||
(unless (in-git-directory?)
|
(unless (in-git-directory?)
|
||||||
(bail "woops this isn't a 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))
|
(generate-html-files html-repo-path templates-directory))
|
||||||
|
|
||||||
(apply main (command-line-arguments))
|
(apply main (command-line-arguments))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue