diff --git a/main.scm b/main.scm index 633cad3..f7d5788 100755 --- a/main.scm +++ b/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 "\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))