|
@ -39,16 +39,16 @@ |
|
|
(define (new-config path) |
|
|
(define (new-config path) |
|
|
(with-handlers |
|
|
(with-handlers |
|
|
([exn:fail:filesystem:errno? (curry create-config path)]) |
|
|
([exn:fail:filesystem:errno? (curry create-config path)]) |
|
|
|
|
|
|
|
|
(let* ([config-file (open-input-file path)] |
|
|
(let* ([config-file (open-input-file path)] |
|
|
[lines (string-split |
|
|
[lines (string-split |
|
|
(port->string config-file) |
|
|
(port->string config-file) |
|
|
"\n")] |
|
|
"\n")] |
|
|
[config (make-hash)]) |
|
|
[config (make-hash)]) |
|
|
|
|
|
|
|
|
(for ([line lines] |
|
|
(for ([line lines] |
|
|
#:unless (string=? line "")) |
|
|
#:unless (string=? line "")) |
|
|
|
|
|
|
|
|
(match (map string-trim |
|
|
(match (map string-trim |
|
|
(string-split line "=")) |
|
|
(string-split line "=")) |
|
|
[(list key val) |
|
|
[(list key val) |
|
@ -60,7 +60,7 @@ |
|
|
[else |
|
|
[else |
|
|
(error |
|
|
(error |
|
|
(format "Invalid configuration line: ~a" val))])])) |
|
|
(format "Invalid configuration line: ~a" val))])])) |
|
|
|
|
|
|
|
|
(curry hash-ref config)))) |
|
|
(curry hash-ref config)))) |
|
|
|
|
|
|
|
|
(define (in-blog?) |
|
|
(define (in-blog?) |
|
@ -86,10 +86,10 @@ |
|
|
(match |
|
|
(match |
|
|
(process command) |
|
|
(process command) |
|
|
[(list out in pid errport _) |
|
|
[(list out in pid errport _) |
|
|
|
|
|
|
|
|
(let ([result (port->string out)] |
|
|
(let ([result (port->string out)] |
|
|
[err-result (port->string out)]) |
|
|
[err-result (port->string out)]) |
|
|
|
|
|
|
|
|
(close-input-port out) |
|
|
(close-input-port out) |
|
|
(close-output-port in) |
|
|
(close-output-port in) |
|
|
(close-input-port errport) |
|
|
(close-input-port errport) |
|
@ -202,7 +202,7 @@ |
|
|
title |
|
|
title |
|
|
content |
|
|
content |
|
|
(terms-names tags categories))] |
|
|
(terms-names tags categories))] |
|
|
|
|
|
|
|
|
[else (edit-post title content post-id |
|
|
[else (edit-post title content post-id |
|
|
(terms-names tags categories))]))))))) |
|
|
(terms-names tags categories))]))))))) |
|
|
|
|
|
|
|
@ -259,7 +259,7 @@ |
|
|
(port->string |
|
|
(port->string |
|
|
(open-input-file post)))) |
|
|
(open-input-file post)))) |
|
|
(curry write-post post-id))] |
|
|
(curry write-post post-id))] |
|
|
|
|
|
|
|
|
["D" (displayln post-id) |
|
|
["D" (displayln post-id) |
|
|
(rm-post post-id)] |
|
|
(rm-post post-id)] |
|
|
|
|
|
|
|
@ -297,7 +297,7 @@ |
|
|
post-name |
|
|
post-name |
|
|
commit-ref)) |
|
|
commit-ref)) |
|
|
[#f ""] |
|
|
[#f ""] |
|
|
|
|
|
|
|
|
[str str]))]) |
|
|
[str str]))]) |
|
|
result)) |
|
|
result)) |
|
|
|
|
|
|
|
@ -315,7 +315,7 @@ |
|
|
["" #f] |
|
|
["" #f] |
|
|
[result #t]))) |
|
|
[result #t]))) |
|
|
(current-commits)) |
|
|
(current-commits)) |
|
|
|
|
|
|
|
|
[(list-rest commit-id _) commit-id] |
|
|
[(list-rest commit-id _) commit-id] |
|
|
|
|
|
|
|
|
[_ |
|
|
[_ |
|
@ -326,7 +326,7 @@ |
|
|
(format |
|
|
(format |
|
|
"git-href: no value found for key\n\t~a" post-name) |
|
|
"git-href: no value found for key\n\t~a" post-name) |
|
|
(current-continuation-marks)))] |
|
|
(current-continuation-marks)))] |
|
|
|
|
|
|
|
|
[else default])])))) |
|
|
[else default])])))) |
|
|
|
|
|
|
|
|
; Add or refresh a key associated with that value |
|
|
; Add or refresh a key associated with that value |
|
@ -408,13 +408,14 @@ |
|
|
[tags |
|
|
[tags |
|
|
(add-tag! post (to-tag-string tags)) |
|
|
(add-tag! post (to-tag-string tags)) |
|
|
tags])) |
|
|
tags])) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (add-tag-alias) |
|
|
|
|
|
; Should only run when the repo is first made |
|
|
(define (add-tag-env post tag) |
|
|
(system |
|
|
(environment-variables-set! |
|
|
"git config alias.tag !() { git notes --ref=$1 add HEAD -fm \"${*:2}\"}")) |
|
|
(current-environment-variables) |
|
|
|
|
|
(string->bytes/utf-8 |
|
|
|
|
|
(regexp-replace* #px"\\/|\\." post "_")) |
|
|
|
|
|
tag)) |
|
|
|
|
|
|
|
|
;(parameterize ([current-commits (get-commits)]) |
|
|
;(parameterize ([current-commits (get-commits)]) |
|
|
|
|
|
|
|
@ -429,21 +430,21 @@ |
|
|
[categories (get-categories post)] |
|
|
[categories (get-categories post)] |
|
|
[tags (check-tags post (new-tags))]) |
|
|
[tags (check-tags post (new-tags))]) |
|
|
(displayln tags) |
|
|
(displayln tags) |
|
|
|
|
|
|
|
|
(match (git-href post #f) |
|
|
(match (git-href post #f) |
|
|
|
|
|
|
|
|
[#f |
|
|
[#f |
|
|
(when (empty? (current-commits)) |
|
|
(when (empty? (current-commits)) |
|
|
; Add a first commit if there are none so it can store the note properly! |
|
|
; Add a first commit if there are none so it can store the note properly! |
|
|
(system "git commit -n --allow-empty -m \"bootstrap blog\"")) |
|
|
(system "git commit -n --allow-empty -m \"bootstrap blog\"")) |
|
|
|
|
|
|
|
|
(git-set! post |
|
|
(git-set! post |
|
|
(handle-post |
|
|
(handle-post |
|
|
categories |
|
|
categories |
|
|
tags |
|
|
tags |
|
|
post-status |
|
|
post-status |
|
|
post #f))] |
|
|
post #f))] |
|
|
|
|
|
|
|
|
[commit-id |
|
|
[commit-id |
|
|
(let ([post-id |
|
|
(let ([post-id |
|
|
(commit->post-id post commit-id)]) |
|
|
(commit->post-id post commit-id)]) |
|
@ -467,4 +468,4 @@ |
|
|
password |
|
|
password |
|
|
username |
|
|
username |
|
|
xstring |
|
|
xstring |
|
|
in-blog?) |
|
|
in-blog?) |
|
|