164 lines
4.4 KiB
Plaintext
Executable File
164 lines
4.4 KiB
Plaintext
Executable File
#! /usr/bin/env slope
|
|
|
|
(define default-index "/usr/local/share/shlog/index.html")
|
|
(define root-path (path-abs "~/.local/share/shlog"))
|
|
(define root-glob "/home/*/.local/share/shlog/*.txt")
|
|
(define html-head
|
|
`<!DOCTYPE html>
|
|
<html lang="en">
|
|
<head>
|
|
<title>RTC Shlog</title>
|
|
</head>
|
|
<body>
|
|
<h1>RTC Shlog</h1>
|
|
<p>If your post is not appearing here, check that it is world readable. Shlog will no longer add posts to the index that are not world readable. This gives you the ability to easily remove posts and ensures that users can read things shown on this index.</p>
|
|
`)
|
|
|
|
(define create-root (lambda (path) (mkdir root-path 0755 #t)))
|
|
|
|
(define from-filename (lambda (str)
|
|
(set! str (path-base str))
|
|
(regex-replace
|
|
`_`
|
|
(slice str (+ (string-index-of str "-") 1) (- (length str) 4))
|
|
" ")))
|
|
|
|
(define to-filename (lambda (str)
|
|
(path-join
|
|
root-path
|
|
(string-format
|
|
"%v-%v.txt"
|
|
(timestamp)
|
|
(regex-replace `\s` str "_")))))
|
|
|
|
(define edit (lambda ()
|
|
(define files
|
|
(reverse
|
|
(list-sort
|
|
(map
|
|
(lambda (ln)
|
|
[ln (path-base ln)])
|
|
(path-glob (path-join root-path "*"))))
|
|
1))
|
|
(define counter 0)
|
|
(for-each
|
|
(lambda (l)
|
|
(display "\033[1m" counter "\033[0m\t" (car (cdr l)) "\n")
|
|
(set! counter (+ counter 1)))
|
|
files)
|
|
(display "\nWhich file # do you want to edit? ")
|
|
(define i (string->number (read-line)))
|
|
(if (and i (>= i 0) (< i (length files)))
|
|
(subprocess [(get-editor) (car (ref files i))])
|
|
(error "edit-file"))))
|
|
|
|
(define get-editor (lambda ()
|
|
(define editor (env "EDITOR"))
|
|
(if (equal? editor "") (set! editor "nano"))
|
|
editor))
|
|
|
|
(define new-file (lambda (str)
|
|
(subprocess [(get-editor) (to-filename str)])))
|
|
|
|
(define error (lambda (type)
|
|
(case type
|
|
("new-file" (write "shlog new [post-title]\n" stderr))
|
|
("build-path" (write "shlog build [output-path]\n" stderr))
|
|
("index-write" (write "Could not write index file\n" stderr))
|
|
("edit-file" (write "Could not open file for editing\n" stderr))
|
|
(else (write "unknown error" stderr)))
|
|
(exit 1)))
|
|
|
|
(define browse (lambda (path)
|
|
(if (not path)
|
|
(set! path default-index))
|
|
(subprocess ["lynx" path])))
|
|
|
|
(define build (lambda (destination)
|
|
(define out (string-make-buf))
|
|
(write html-head out)
|
|
(write (string-format "<p>Last generated: <i>%v</i></p><ul id=\"posts\">" (date)) out)
|
|
(for-each
|
|
(lambda (line)
|
|
(write
|
|
(string-format
|
|
`<li><a href="file://%v">%v</a> (%v)</li>`
|
|
(car line)
|
|
(ref line 3)
|
|
(ref line 2))
|
|
out))
|
|
(reverse
|
|
(list-sort
|
|
(map
|
|
(lambda (p)
|
|
[
|
|
p ; full path [0]
|
|
(path-base p) ; filename [1]
|
|
(regex-replace `/home/([\w-]+)/.*` p "$1") ; username [2]
|
|
(from-filename (path-base p)) ; Post title [3]
|
|
])
|
|
(filter
|
|
(lambda (p)
|
|
(>= (string->number (ref (assoc (file-stat p) "modestring") 2)) 4))
|
|
(path-glob root-glob)))
|
|
1)))
|
|
(write "</ul></body></html>" out)
|
|
(define outfile (file-create destination))
|
|
(if outfile
|
|
(begin
|
|
(write (read-all out) outfile)
|
|
(close outfile))
|
|
(begin
|
|
(error "index-write")))))
|
|
|
|
(define print-help (lambda ()
|
|
(display
|
|
`shlog - a local plaintext blogging system
|
|
|
|
Read: shlog
|
|
shlog browse
|
|
shlog browse [custom-index-path]
|
|
|
|
Write: shlog new [post-title]
|
|
|
|
Edit : shlog edit
|
|
|
|
Build: shlog build [index-path]
|
|
|
|
Help : shlog help
|
|
shlog -h
|
|
shlog --help
|
|
|
|
Data : ~/.local/share/shlog
|
|
Index: /usr/local/share/shlog/index.html
|
|
Code : http://tildegit.org/sloum/shlog
|
|
~sloum/build/shlog
|
|
`)))
|
|
|
|
(define main (lambda ()
|
|
(if (not (path-exists? root-path))
|
|
(create-root root-path))
|
|
(set! sys-args (cdr sys-args))
|
|
(if (null? sys-args)
|
|
(browse #f)
|
|
(if (or (member? sys-args "-h") (member? sys-args "--help"))
|
|
(print-help)
|
|
(case (car sys-args)
|
|
("help" (print-help))
|
|
("browse"
|
|
(if (null? (cdr sys-args))
|
|
(browse #f)
|
|
(browse (path-abs (car (cdr sys-args))))))
|
|
("new"
|
|
(if (null? (cdr sys-args))
|
|
(error "new-file")
|
|
(new-file (car (cdr sys-args)))))
|
|
("build"
|
|
(if (null? (cdr sys-args))
|
|
(build default-index)
|
|
(build (path-abs (car (cdr sys-args))))))
|
|
("edit"
|
|
(edit))
|
|
(else (print-help)))))))
|
|
(main)
|