1
0
Fork 0

Adds the program and its solo repository

This commit is contained in:
sloum 2022-10-04 15:37:14 -07:00
parent 4480e25ff8
commit 63fe1bf7e2
7 changed files with 749 additions and 7 deletions

View File

@ -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"))

View File

@ -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}

View File

@ -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.

View File

@ -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? "&gt;" (slice l 0 4))
(write (append "\t\t\t\t<blockquote>" l "</blockquote>\n") buf)
((regex-match? "^=&gt;\\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 "&nbsp; b")))
#f)))
(define html-escape (lambda (str)
(list->string
(map
(lambda (c)
(case c
("&" "&amp;")
(">" "&gt;")
("<" "&lt;")
("'" "&apos;")
("\"" "&quot;")
(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

View File

@ -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;
}

View File

@ -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
View File

@ -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)