Adds the program and its solo repository
This commit is contained in:
parent
4480e25ff8
commit
63fe1bf7e2
|
@ -1 +1 @@
|
|||
(("heads" (("master" "6904a72d2520d5ba870e09114e9bab7d"))) ("branch" "master") ("tags" ()) ("description" "A tool for creating web-sites for solo repositories") ("author" "sloum@sloum-drone") ("version" (0 2 0)) ("remote" #f))
|
||||
(("heads" (("master" "3b0641611696f5d08753f7e72823f67b"))) ("branch" "master") ("tags" ()) ("description" "A tool for creating web-sites for solo repositories") ("author" "sloum@sloum-drone") ("version" (0 2 0)) ("remote" "/var/www/slope.colorfield.space/solo/repos"))
|
|
@ -0,0 +1,15 @@
|
|||
BINARY := soloweb
|
||||
PREFIX := /usr/local
|
||||
BINDIR := ${EXEC_PREFIX}/bin
|
||||
DATAROOTDIR := ${PREFIX}/share
|
||||
LIBDIR := ${PREFIX}/lib
|
||||
MANDIR := ${DATAROOTDIR}/man
|
||||
MAN1DIR := ${MANDIR}/man1
|
||||
|
||||
|
||||
|
||||
install-bin: ${BINARY}
|
||||
install -d ${DESTDIR}${BINDIR}
|
||||
install -m 0755 ./${BINARY} ${DESTDIR}${BINDIR}
|
||||
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
# soloweb
|
||||
|
||||
soloweb is a tool for creating a website based on a solo repository
|
||||
|
||||
=> https://git.rawtext.club/sloum/solo What is solo?
|
||||
|
||||
## How to use it
|
||||
|
||||
All you need to do is pass soloweb the path to the solo repository (you cannot be in the repository at the time).
|
||||
|
||||
```
|
||||
soloweb /path/to/my/solo/repo
|
||||
```
|
||||
|
||||
You may, optionally, pass a path to an image to be used as the icon for the repository (it will be displayed as a square image of around 75px by 75px), so keep that in mind. It will be zoomed and centered as needed to fill the space.
|
||||
|
||||
```
|
||||
soloweb /path/to/my/solo/repo /path/to/cool/image.png
|
||||
```
|
||||
|
||||
It will generate a folder in the current working directory named for the repository. Inside of that folder will be an index.html file and everything else needed for the website, including a gzipped tar file of the repository, ready for download.
|
||||
|
||||
|
|
@ -0,0 +1,543 @@
|
|||
#! /usr/bin/env slope
|
||||
|
||||
(define c #f) ; Config
|
||||
(define logo-file #f)
|
||||
(define repo-name "")
|
||||
(define repo-dir "")
|
||||
(define css ":root{--dim:rgb(0,0,0,0.2);--dimmer:rgb(0,0,0,0.05);--bg:rgb(255, 245, 245);--txt:rgb(84, 97, 124);--black:black}@media (prefers-color-scheme: dark){:root{--dim:rgb(255,255,255,0.2);--dimmer:rgb(255,255,255,0.05);--bg:#222;--txt:rgb(255,245,245);--black:white;} a {color: cyan; a:visited{color:skyblue;}}}body{font-family:monospace;line-height:1.5rem;width:60rem;max-width:95vw;margin:auto;background-color:var(--bg);color:var(--txt)}footer,header,main{padding:2.5rem 0}header{padding-bottom:0}ol,table,ul{margin-bottom:2rem;width:100%}header h1{text-align:right}header img{border-radius:5px;width:6rem;height:6rem;object-fit:cover;object-position:contain;float:right;margin-left:2rem}header p{text-align:right}nav a{padding:0.3rem 0.5rem;display:inline-block;border:2px solid var(--black);border-bottom:0;border-radius:5px 5px 0 0;background:var(--txt);color:var(--bg);text-decoration:none}nav a:last-child{font-size:1.2em;border:none;font-weight:bold;color:var(--txt);background-color:var(--bg);}main{border-top:2px solid;border-bottom:2px solid;}nav{margin-left:0.25rem}article{border:1px solid var(--txt);margin:3rem auto;border-radius:6px}.readme{background-color:var(--txt);color:var(--bg);padding:0.5rem;border-radius:5px 5px 0 0;margin:0}.readmebody{padding:1rem;overflow:scroll;}.readmebody pre{white-space:pre-wrap;}ul{list-style:none;padding-left:0}ul > li{padding:0.2rem 0.5rem;display:inline-block;border:1px dashed var(--dim);border-radius:5px}.filetree{border-radius:5px;border:1px solid var(--txt)}.filetree li{border:none;border-bottom:1px dashed var(--dim);display:block;line-height:2rem}.filetree li span{float:right}.filetree li:nth-child(odd){background-color:var(--dimmer);max-width:100%;overflow:auto}table,table td,table th{border-collapse:collapse;border-bottom:2px solid var(--txt);padding:0.33em 0.66em;text-align:left;vertical-align:middle}table th{font-size:1.1em}#branch{text-align:right;}#branch span{padding:5px;border:1px dotted #000;border-radius: 0 5px 5px 0; background-color: var(--bg);}#branch span:first-child{user-select:none;background-color:var(--txt);color:var(--bg);border-radius:5px 0 0 5px;}")
|
||||
|
||||
(define page-head (lambda (title-extra)
|
||||
(define b (string-make-buf))
|
||||
(write "<!DOCTYPE html>\n" b)
|
||||
(write "<html lang=\"en\">\n" b)
|
||||
(write "\t<head>\n" b)
|
||||
(write (append "\t\t<title>" repo-name " - " title-extra "</title>\n") b)
|
||||
(write "\t\t<meta charset=\"UTF-8\">\n" b)
|
||||
(write "\t\t<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">\n" b)
|
||||
(write (append "\t\t<style>\n" css "\n\t\t</style>\n") b)
|
||||
(write "\t</head>\n" b)
|
||||
(write "\t<body>\n" b)
|
||||
(read-all b)))
|
||||
|
||||
(define page-header (lambda (description level-from-root)
|
||||
(define b (string-make-buf))
|
||||
(define to-root
|
||||
(if (zero? level-from-root)
|
||||
"" (list->string (list-seed level-from-root "..") "/")))
|
||||
(write "\t\t<header>\n" b)
|
||||
(if logo-file
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t<img src=\"%v\" alt=\"\">\n"
|
||||
(path-join to-root logo-file))
|
||||
b))
|
||||
(write (append "\t\t\t<h1>" repo-name "</h1>\n") b)
|
||||
(if (~bool description)
|
||||
(write (append "\t\t\t<p>" description "</p>\n") b))
|
||||
(write "\t\t\t<nav>\n" b)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t<a href=\"%v\">%v</a>\n"
|
||||
(path-join to-root "index.html") ;; Contains a file list, as well as the README displayed
|
||||
"Files") b)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t<a href=\"%v\">%v</a>\n"
|
||||
(path-join to-root "history.html")
|
||||
"History") b)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t<a href=\"%v\">%v</a>\n"
|
||||
(path-join to-root "references.html")
|
||||
"References") b)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t<a href=\"%v\">Download</a>\n"
|
||||
(path-join to-root (append repo-name ".tar.gz")))
|
||||
b)
|
||||
(write "\t\t\t</nav>" b)
|
||||
(write "\t\t</header>\n" b)
|
||||
(write "\t\t<main>\n" b)
|
||||
(read-all b)))
|
||||
|
||||
(define make-files-html (lambda ()
|
||||
(define b (string-make-buf))
|
||||
(write (page-head "Files") b)
|
||||
(write (page-header (assoc c "description") 0) b)
|
||||
(write "\t\t\t<h2>Files</h2>\n" b)
|
||||
(write
|
||||
(append
|
||||
"\t\t\t<p id=branch><span>master</span><span>"
|
||||
(assoc (assoc c "heads") "master")
|
||||
"</span></p>\n") b)
|
||||
(write "\t\t\t<ul class=filetree>\n" b)
|
||||
(define repo-root
|
||||
(path-join
|
||||
repo-dir
|
||||
".solo" "tree" "master"
|
||||
(assoc (assoc c "heads") "master")
|
||||
"data"))
|
||||
(define files (path-glob (path-join repo-root "**")))
|
||||
|
||||
(for-each
|
||||
(lambda (in)
|
||||
(define from (car in))
|
||||
(define to (car (cdr in)))
|
||||
(define buf (string-make-buf))
|
||||
(write (page-head to) buf)
|
||||
(write (page-header (assoc c "description") (count-dirs to)) buf)
|
||||
(write
|
||||
(append
|
||||
"\t\t\t<article>\n"
|
||||
"\t\t\t\t<h2 class=readme>"
|
||||
(string-replace to "files/" "")
|
||||
"</h2>\n\t\t\t\t<div class=readmebody>\n")
|
||||
buf)
|
||||
(write "\t\t\t\t<pre><code>" buf)
|
||||
(define filedata (open-read-close from))
|
||||
(set! filedata (html-escape filedata))
|
||||
(write filedata buf)
|
||||
(write "</code></pre>\n\t\t\t\t</div>\n\t\t\t</article>" buf)
|
||||
(write (page-footer) buf)
|
||||
(mkdir (path-dir to) 0755 #t)
|
||||
(define f (file-create (append to ".html")))
|
||||
(if f
|
||||
(close (write (read-all buf) f))))
|
||||
(map
|
||||
(lambda (p)
|
||||
[p (string-replace p repo-root "files")])
|
||||
(filter
|
||||
(lambda (p)
|
||||
(not (path-is-dir? p)))
|
||||
files)))
|
||||
|
||||
(for-each
|
||||
(lambda (p)
|
||||
(define size (file-size (car (cdr p))))
|
||||
(write
|
||||
(append
|
||||
"\t\t\t\t<li><a href=\""
|
||||
(car p) ".html\">"
|
||||
(string-replace (car p) "files/" "" 1) "</a>"
|
||||
"<span>" (if size size "") "</span>" "</li>\n")
|
||||
b))
|
||||
(list-sort (map
|
||||
(lambda (p)
|
||||
[
|
||||
(string-replace p repo-root "files" 1)
|
||||
p])
|
||||
(filter
|
||||
(lambda (p)
|
||||
(not (path-is-dir? p)))
|
||||
files))))
|
||||
(write "\t\t\t</ul>\n" b)
|
||||
(define readme (has-readme?))
|
||||
(if readme
|
||||
(begin
|
||||
(write "\t\t\t<article>\n" b)
|
||||
(write
|
||||
(append
|
||||
"\t\t\t\t<h2 class=readme>"
|
||||
(path-base readme)
|
||||
"</h2>\n\t\t\t\t<div class=readmebody>\n")
|
||||
b)
|
||||
(write "\t\t\t\t<pre><code>" b)
|
||||
(write (open-read-close (path-join readme)) b)
|
||||
(write "</code></pre>\n\t\t\t\t</div>\n\t\t\t</article>" b)))
|
||||
|
||||
(write (page-footer) b)
|
||||
(define f (file-create "index.html"))
|
||||
(if f
|
||||
(begin
|
||||
(write (read-all b) f)
|
||||
(close f))
|
||||
(error-exit "Could not write 'index.html'"))))
|
||||
|
||||
|
||||
(define transpile-gemtext (lambda (gt buf)
|
||||
(define in-pre? #f)
|
||||
(define in-list? #f)
|
||||
(for-each
|
||||
(lambda (l)
|
||||
(if
|
||||
(and
|
||||
in-list?
|
||||
(positive? (length l) (not (equal? "*" (ref l 0)))))
|
||||
(begin
|
||||
(write "\t\t\t\t</ul>\n" buf)
|
||||
(set! in-list? #f)))
|
||||
|
||||
(cond
|
||||
((and in-pre? (not (equal? (slice l 0 3) "```")))
|
||||
(write l buf))
|
||||
((and in-pre? (equal? (slice l 0 3) "```"))
|
||||
(write "</pre>\n" buf))
|
||||
((equal? (string-trim-space l) "") (write "\t\t\t\t<br>\n" buf))
|
||||
((regex-match? "^###.+" l)
|
||||
(write
|
||||
(append
|
||||
"\t\t\t\t<h3>"
|
||||
(string-trim-space (slice l 3))
|
||||
"</h3>\n") buf))
|
||||
((regex-match? "^##.+" l)
|
||||
(write (append "\t\t\t\t<h2>" (string-trim-space (slice l 2)) "</h2>\n") buf))
|
||||
((regex-match? "^#.+" l)
|
||||
(write (append "\t\t\t\t<h1>" (string-trim-space (slice l 1)) "</h1>\n") buf))
|
||||
((equal? "*" (ref l 0))
|
||||
(if in-list?
|
||||
(write (append "\t\t\t\t\t<li>" l "</li>\n") buf)
|
||||
(begin
|
||||
(set! in-list? #t)
|
||||
(write
|
||||
(append "\t\t\t\t<ul>\n\t\t\t\t\t<li>" l "</li>\n") buf))))
|
||||
((equal? ">" (slice l 0 4))
|
||||
(write (append "\t\t\t\t<blockquote>" l "</blockquote>\n") buf)
|
||||
((regex-match? "^=>\\s*\\S+" l)
|
||||
(begin
|
||||
(define parts
|
||||
(string->list (string-trim-space (ref l 5)) " " 1))
|
||||
(if (>= (length parts) 2)
|
||||
(write
|
||||
(append
|
||||
"\t\t\t\t<a href=\""
|
||||
(car parts)
|
||||
"\" target=\"_blank\">"
|
||||
(car (cdr parts))
|
||||
"</a>\n")
|
||||
buf)
|
||||
(write
|
||||
(append
|
||||
"\t\t\t\t<a href=\""
|
||||
(car parts)
|
||||
"\" target=\"_blank\">"
|
||||
(car parts)
|
||||
"</a>\n")
|
||||
buf))))
|
||||
((equal? (slice l 0 3) "```")
|
||||
(begin
|
||||
(set! in-pre? #t)
|
||||
(write "\t\t\t\t<pre>" buf)))
|
||||
(else (write (append "\t\t\t\t" l "<br>\n") buf)))))
|
||||
(string->list gt "\n"))))
|
||||
|
||||
(define make-references-html (lambda ()
|
||||
(define b (string-make-buf))
|
||||
(write (page-head "References") b)
|
||||
(write (page-header (assoc c "description") 0) b)
|
||||
(write "\t\t\t<h2>References</h2>\n" b)
|
||||
(write "\t\t\t<h3>Branches</h3>\n" b)
|
||||
(write "\t\t\t<ul>\n" b)
|
||||
(for-each
|
||||
(lambda (branch)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t<li>%v</li>\n"
|
||||
branch)
|
||||
b))
|
||||
(list-sort (map car (assoc c "heads"))))
|
||||
(write "\t\t\t</ul>\n" b)
|
||||
(write "\t\t\t<h3>Tags</h3>\n" b)
|
||||
(if (null? (assoc c "tags"))
|
||||
(write "\t\t\t<p><i>None</i></p>\n" b)
|
||||
(begin
|
||||
(write "\t\t\t<table>\n\t\t\t\t<thead>\n" b)
|
||||
(write "\t\t\t\t\t<tr>\n" b)
|
||||
(write "\t\t\t\t\t\t<th>Tag Name</th>\n" b)
|
||||
(write "\t\t\t\t\t\t<th>Branch</th>\n" b)
|
||||
(write "\t\t\t\t\t\t<th>Snap</th>\n" b)
|
||||
(write "\t\t\t\t\t\t<th>Message</th>\n" b)
|
||||
(write "\t\t\t\t\t</tr>\n" b)
|
||||
(write "\t\t\t\t</thead>\n\t\t\t\t<tbody>\n" b)))
|
||||
(for-each
|
||||
(lambda (t)
|
||||
(write "\t\t\t\t\t<tr>\n" b)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t\t\t<td>%v</td>\n"
|
||||
t)
|
||||
b)
|
||||
(define data
|
||||
(eval (open-read-close (path-join repo-dir ".solo" "tags" t)) #t))
|
||||
(if data
|
||||
(begin
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t\t\t<td>%v</td>\n"
|
||||
(car data))
|
||||
b)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t\t\t<td>%v</td>\n"
|
||||
(car (cdr data)))
|
||||
b)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t\t\t<td>%v</td>\n"
|
||||
(car (reverse data)))
|
||||
b))
|
||||
(write "\t\t\t\t\t\t<td colspan=\"3\"><i>No Data</i></td>\n" b))
|
||||
(write "\t\t\t\t\t</tr>\n" b))
|
||||
(assoc c "tags"))
|
||||
(write "\t\t\t\t</tbody>\n\t\t\t</table>\n" b)
|
||||
;; Write history content
|
||||
(write (page-footer) b)
|
||||
(define f (file-create "references.html"))
|
||||
(if f
|
||||
(begin
|
||||
(write (read-all b) f)
|
||||
(close f))
|
||||
(error-exit "Could not write 'references.html'"))))
|
||||
|
||||
(define page-file-body (lambda ()
|
||||
#f))
|
||||
|
||||
(define page-footer (lambda ()
|
||||
(define b (string-make-buf))
|
||||
(write "\t\t</main>\n" b)
|
||||
(write "\t\t<footer>\n" b)
|
||||
(write "\t\t\t<p>This page was generated by soloweb, a static web compiler for solo repositories. Only files from the <i>master</i> branch are available through the web, but other branches (as listed in references) are available if the repository is downloaded</p>\n" b)
|
||||
(write "\t\t</footer>\n" b)
|
||||
(write "\t</body>\n" b)
|
||||
(write "</html>\n" b)
|
||||
(read-all b)))
|
||||
|
||||
(define has-readme? (lambda ()
|
||||
(define files (path-glob (path-join repo-dir ".solo" "tree" "master" (assoc (assoc c "heads") "master") "data" "*")))
|
||||
(define readme
|
||||
(filter
|
||||
(lambda (p)
|
||||
(regex-match? "(?i)/readme(\\.(txt|md|gmi))?$" p))
|
||||
files))
|
||||
(if (null? readme)
|
||||
#f
|
||||
(car readme))))
|
||||
|
||||
(define ask/confirm (lambda (msg)
|
||||
(define loop (lambda ()
|
||||
(write (append "\033[1m" msg "\033[0m: "))
|
||||
(define answer (read-line))
|
||||
(write (append "Is \033[4m" (if (equal? anser "") "(NULL)" answer) "\033[0m correct? (y/n)"))
|
||||
(if (not (equal? "y" (string-lower (get-char))))
|
||||
(begin
|
||||
(newline)
|
||||
(loop))
|
||||
answer)))
|
||||
(loop)))
|
||||
|
||||
(define is-solo? (lambda (...)
|
||||
(define root (if (null? ...) (pwd) (path-abs (car ...))))
|
||||
(if
|
||||
(and
|
||||
(path-exists? (path-join root ".solo" "solo.conf"))
|
||||
(path-exists? (path-join root ".solo" "tree" "master")))
|
||||
#t
|
||||
(error-exit "The given path does not lead to a solo root"))))
|
||||
|
||||
(define get-tags (lambda (...)
|
||||
(define c (get-conf-from-root (if (null? ...) (pwd) (car ...))))
|
||||
(if (not c)
|
||||
(error-exit "'get-tags' encountered an invalid repo. solo.conf was not found/readable"))
|
||||
(assoc c "tags")))
|
||||
|
||||
(define get-conf-from-root (lambda (root)
|
||||
(define data (open-read-close (path-join root ".solo" "solo.conf")))
|
||||
(if data
|
||||
(eval data #t)
|
||||
data)))
|
||||
|
||||
(define open-read-close (lambda (p)
|
||||
(define f (file-open-read (path-abs p)))
|
||||
(if f
|
||||
(begin0
|
||||
(read-all f)
|
||||
(close f))
|
||||
#f)))
|
||||
|
||||
(define error-exit (lambda (msg)
|
||||
(write (append msg "\n") stderr)
|
||||
(exit 1)))
|
||||
|
||||
(define move-files (lambda (head)
|
||||
(define from-root (path-join repo-dir ".solo" "tree" "master" head "data"))
|
||||
(define file-list
|
||||
(filter
|
||||
(lambda (p) (not (path-is-dir? p)))
|
||||
(path-glob (path-join from-root "**"))))
|
||||
(for-each
|
||||
(lambda (p)
|
||||
(cp
|
||||
p
|
||||
(string-replace p from-root (path-join (pwd) "files"))))
|
||||
file-list)))
|
||||
|
||||
;; `cp` copies a file from one path to another
|
||||
(define cp (lambda (from to)
|
||||
(if (path-is-dir? from)
|
||||
(mkdir (path-abs to) 0775 #t)
|
||||
(begin
|
||||
(define in (file-open-read from))
|
||||
(define out (file-create to))
|
||||
(if (and in out (not (assoc (file-stat from) "is-dir?")))
|
||||
(begin
|
||||
(write (read-all in) out)
|
||||
(close in)
|
||||
(close out)
|
||||
(chmod to (assoc (file-stat from) "mode"))))))))
|
||||
|
||||
;; `conf` writes and reads to the solo.conf file inside of the .solo directory
|
||||
;; If nothing is passed it will read the existing file. If data is passed, it will be
|
||||
;; written to the file and clobber the old data
|
||||
(define conf (lambda (repo-dir ...)
|
||||
(define sf-path (path-join repo-dir ".solo" "solo.conf"))
|
||||
(if (null? ...)
|
||||
(begin
|
||||
(define data (open-read-close sf-path))
|
||||
(if data
|
||||
(eval data #t)
|
||||
(error-exit "Could not read solo configuration file. Are you in the repo root? Is the file corrupt?")))
|
||||
(begin
|
||||
(define sf (file-create sf-path))
|
||||
(if sf
|
||||
(close (write (car ...) sf))
|
||||
(error-exit "Error writing solo configuration"))))))
|
||||
|
||||
(define make-history-html (lambda ()
|
||||
(define b (string-make-buf))
|
||||
(write (page-head "History") b)
|
||||
(write (page-header (assoc c "description") 0) b)
|
||||
(write "\t\t\t<h2>History</h2>\n" b)
|
||||
(write "\t\t\t<table>\n\t\t\t\t<thead>\n" b)
|
||||
(write "\t\t\t\t\t<tr>\n" b)
|
||||
(write "\t\t\t\t\t\t<th>Date</th>\n" b)
|
||||
(write "\t\t\t\t\t\t<th>Message</th>\n" b)
|
||||
(write "\t\t\t\t\t\t<th>Snap</th>\n" b)
|
||||
(write "\t\t\t\t\t\t<th>Author</th>\n" b)
|
||||
(write "\t\t\t\t\t</tr>\n" b)
|
||||
(write "\t\t\t\t</thead>\n\t\t\t\t<tbody>\n" b)
|
||||
|
||||
(define loop (lambda (buffer id head?)
|
||||
(define p (path-join repo-dir ".solo" "tree" "master" id "meta"))
|
||||
(define data (if (path-exists? p) (open-read-close p) p))
|
||||
(if data
|
||||
(set! data (eval data #t))
|
||||
(error-exit "Loop issue while generating history"))
|
||||
|
||||
(define panic-mode? (exception-mode-panic?))
|
||||
|
||||
(if (pair? data)
|
||||
(begin
|
||||
(write "\t\t\t\t\t<tr>\n" buffer)
|
||||
(if panic-mode? (exception-mode-pass))
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t\t\t<td>%v</td>\n"
|
||||
(date-format
|
||||
(date-default-format)
|
||||
(assoc data "time")
|
||||
"%Y-%M-%D %H:%I%a"))
|
||||
buffer)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t\t\t<td>%v</td>\n"
|
||||
(assoc data "message"))
|
||||
buffer)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t\t\t<td>%v %v</td>\n"
|
||||
id
|
||||
(if head? "<sup>[HEAD]</sup>" ""))
|
||||
buffer)
|
||||
(write
|
||||
(string-format
|
||||
"\t\t\t\t\t\t<td>%v</td>\n"
|
||||
(assoc data "user"))
|
||||
buffer)
|
||||
(write "\t\t\t\t\t</tr>\n" buffer)))
|
||||
|
||||
(if (~bool (assoc data "parent-commit"))
|
||||
(begin0
|
||||
(loop buffer (assoc data "parent-commit") #f)
|
||||
(if panic-mode? (exception-mode-panic)))
|
||||
(if panic-mode? (exception-mode-panic)))))
|
||||
|
||||
(loop b (assoc (assoc c "heads") "master") #t)
|
||||
(write "\t\t\t\t</tbody>\n\t\t\t</table>\n" b)
|
||||
|
||||
;; Write history content
|
||||
(write (page-footer) b)
|
||||
(define f (file-create "history.html"))
|
||||
(if f
|
||||
(begin
|
||||
(write (read-all b) f)
|
||||
(close f))
|
||||
(error-exit "Could not write 'history.html'"))))
|
||||
|
||||
(define file-size (lambda (path)
|
||||
(define stat (file-stat path))
|
||||
(define size (if stat (assoc stat "size") #f))
|
||||
(if size
|
||||
(cond
|
||||
((>= size 1000000000) (append (round (/ (/ (/ 1000 size) 1000) 1000) 2) " gb")) ; GB
|
||||
((>= size 1000000) (append (round (/ (/ 1000 size) 1000) 2) " mb")) ; MB
|
||||
((>= size 1000) (append (round (/ size 1000) 2) " kb")) ;KB
|
||||
(else (append size " b")))
|
||||
#f)))
|
||||
|
||||
(define html-escape (lambda (str)
|
||||
(list->string
|
||||
(map
|
||||
(lambda (c)
|
||||
(case c
|
||||
("&" "&")
|
||||
(">" ">")
|
||||
("<" "<")
|
||||
("'" "'")
|
||||
("\"" """)
|
||||
(else c)))
|
||||
(string->list str)))))
|
||||
|
||||
(define count-dirs (lambda (p)
|
||||
(length (filter (lambda (c) (equal? c "/")) (string->list p)))))
|
||||
|
||||
(define init (lambda (solo-path image)
|
||||
(is-solo? solo-path)
|
||||
(if (equal? (path-dir solo-path) (pwd))
|
||||
(error-exit "soloweb error: the site cannot be generated in the same directory as the repository, as the folders will share a name"))
|
||||
(set! repo-dir solo-path)
|
||||
(set! c (conf solo-path))
|
||||
(set! repo-name (path-base solo-path))
|
||||
(if (and image (path-exists? image))
|
||||
(begin
|
||||
(set! logo-file (append "logo" (path-extension image)))
|
||||
(cp image logo-file))
|
||||
(display-lines "No logo file was found, skipping"))
|
||||
|
||||
(define new-base (path-join (pwd) repo-name))
|
||||
(mkdir new-base 0755)
|
||||
|
||||
(display-lines "soloweb: archiving and compressing")
|
||||
(chdir (path-dir repo-dir))
|
||||
(subprocess ["tar" "-czf" (append repo-name ".tar.gz") repo-name] devnull devnull) ; Get a tarball of the repo
|
||||
(mv (append repo-name ".tar.gz") (path-join new-base (append repo-name ".tar.gz")))
|
||||
|
||||
(chdir new-base)
|
||||
(mkdir "files" 0755)
|
||||
|
||||
(display-lines "soloweb: generating html")
|
||||
(make-history-html)
|
||||
(make-files-html)
|
||||
(make-references-html)
|
||||
(write "soloweb: done!\n")))
|
||||
|
||||
(define main (lambda ()
|
||||
(set! sys-args (cdr sys-args))
|
||||
(case (length sys-args)
|
||||
(0 (error-exit "No solo repo path was given"))
|
||||
(1 (init (path-abs (car sys-args)) #f))
|
||||
(else
|
||||
(init
|
||||
(path-abs (car sys-args))
|
||||
(path-abs (car (cdr sys-args))))))))
|
||||
(main)
|
||||
|
||||
; vim: ts=2 sw=2 expandtab ft=slope
|
|
@ -0,0 +1,154 @@
|
|||
:root {
|
||||
--bg: rgb(255, 245, 245);
|
||||
--txt: rgb(84, 97, 124);
|
||||
--accent: orange;
|
||||
--black: black;
|
||||
}
|
||||
|
||||
|
||||
body {
|
||||
font-family: monospace;
|
||||
line-height: 1.5rem;
|
||||
width: 60rem;
|
||||
max-width: 95vw;
|
||||
margin: auto;
|
||||
background-color: var(--bg);
|
||||
color: var(--txt);
|
||||
}
|
||||
|
||||
header, main, footer {
|
||||
padding: 2.5rem 0;
|
||||
}
|
||||
|
||||
header {
|
||||
padding-bottom: 0;
|
||||
}
|
||||
|
||||
table, ul, ol {
|
||||
margin-bottom: 2rem;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
h1 {
|
||||
text-align: right;
|
||||
}
|
||||
|
||||
header img {
|
||||
width: 6rem;
|
||||
height: 6rem;
|
||||
object-fit: cover;
|
||||
object-position: contain;
|
||||
float: right;
|
||||
margin-left: 2rem;
|
||||
}
|
||||
|
||||
header p {
|
||||
text-align: right;
|
||||
}
|
||||
|
||||
nav a {
|
||||
padding: 0.3rem 0.5rem;
|
||||
display: inline-block;
|
||||
border: 2px solid var(--black);
|
||||
border-bottom: 0;
|
||||
border-radius: 5px 5px 0 0;
|
||||
background: var(--txt);
|
||||
color: var(--bg);
|
||||
text-decoration: none;
|
||||
}
|
||||
|
||||
nav {
|
||||
margin-left: 0.25rem;
|
||||
}
|
||||
|
||||
article {
|
||||
border: 1px solid var(--txt);
|
||||
margin: 3rem auto;
|
||||
border-radius: 6px;
|
||||
}
|
||||
|
||||
#branch {
|
||||
display: inline-block;
|
||||
float: right;
|
||||
border: 1px dotted rgb(0,0,0);
|
||||
border-radius: 5px;
|
||||
}
|
||||
|
||||
#branch span {
|
||||
padding: 5px;
|
||||
}
|
||||
|
||||
#branch span:first-child {
|
||||
background-color: var(--txt);
|
||||
color: var(--bg);
|
||||
user-select: none;
|
||||
}
|
||||
|
||||
.readme {
|
||||
background-color: var(--txt);
|
||||
color: var(--bg);
|
||||
padding: 0.5rem;
|
||||
border-radius: 5px 5px 0 0;
|
||||
margin: 0;
|
||||
}
|
||||
|
||||
.readmebody {
|
||||
padding: 1rem;
|
||||
}
|
||||
|
||||
ul {
|
||||
list-style: none;
|
||||
padding-left: 0;
|
||||
}
|
||||
|
||||
ul > li {
|
||||
padding: 0.2rem 0.5rem;
|
||||
display: inline-block;
|
||||
border: 1px dashed rgba(0,0,0,0.2);
|
||||
border-radius: 5px;
|
||||
}
|
||||
|
||||
.filetree {
|
||||
border-radius: 5px;
|
||||
border: 1px solid var(--txt);
|
||||
}
|
||||
|
||||
.filetree li {
|
||||
border: none;
|
||||
border-bottom: 1px dashed rgba(0,0,0,0.2);
|
||||
display: block;
|
||||
line-height: 2rem;
|
||||
}
|
||||
|
||||
.filetree li span {
|
||||
float: right;
|
||||
}
|
||||
|
||||
.filetree li:nth-child(odd) {
|
||||
background-color: rgba(0,0,0,0.05);
|
||||
}
|
||||
|
||||
footer {
|
||||
border-top: 1px solid #54577C;
|
||||
}
|
||||
|
||||
header {
|
||||
border-bottom: 2px solid #54577C;
|
||||
}
|
||||
|
||||
table {
|
||||
border-collapse: collapse;
|
||||
max-width: 100%;
|
||||
overflow: auto;
|
||||
}
|
||||
|
||||
table, table th, table td {
|
||||
border-bottom: 2px solid rgb(84, 87, 124);
|
||||
padding: 0.33em 0.66em;
|
||||
text-align: left;
|
||||
vertical-align: middle;
|
||||
}
|
||||
|
||||
table th {
|
||||
font-size: 1.1em;
|
||||
}
|
|
@ -0,0 +1 @@
|
|||
(("message" "Adjusts dirs to make tar archive relative to cwd") ("user" "sloum@sloum-drone") ("time" "Tue Oct 4 09:37:26 -0700 PDT 2022") ("id" "3b0641611696f5d08753f7e72823f67b") ("parent-branch" "master") ("parent-commit" "6904a72d2520d5ba870e09114e9bab7d"))
|
18
soloweb
18
soloweb
|
@ -505,18 +505,24 @@
|
|||
(error-exit "soloweb error: the site cannot be generated in the same directory as the repository, as the folders will share a name"))
|
||||
(set! repo-dir solo-path)
|
||||
(set! c (conf solo-path))
|
||||
(define new-base (path-join (pwd) (path-base solo-path)))
|
||||
(mkdir new-base 0755)
|
||||
(chdir new-base)
|
||||
(display-lines "soloweb: archiving and compressing")
|
||||
(subprocess ["tar" "-czf" (append (path-base solo-path) ".tar.gz") repo-dir] devnull devnull) ; Get a tarball of the repo
|
||||
(mkdir "files" 0755)
|
||||
(set! repo-name (path-base solo-path))
|
||||
(if (and image (path-exists? image))
|
||||
(begin
|
||||
(set! logo-file (append "logo" (path-extension image)))
|
||||
(cp image logo-file))
|
||||
(display-lines "No logo file was found, skipping"))
|
||||
|
||||
(define new-base (path-join (pwd) repo-name))
|
||||
(mkdir new-base 0755)
|
||||
|
||||
(display-lines "soloweb: archiving and compressing")
|
||||
(chdir (path-dir repo-dir))
|
||||
(subprocess ["tar" "-czf" (append repo-name ".tar.gz") repo-name] devnull devnull) ; Get a tarball of the repo
|
||||
(mv (append repo-name ".tar.gz") (path-join new-base (append repo-name ".tar.gz")))
|
||||
|
||||
(chdir new-base)
|
||||
(mkdir "files" 0755)
|
||||
|
||||
(display-lines "soloweb: generating html")
|
||||
(make-history-html)
|
||||
(make-files-html)
|
||||
|
|
Loading…
Reference in New Issue