|
@ -166,7 +166,8 @@ |
|
|
; Updates an existing post |
|
|
; Updates an existing post |
|
|
(define (edit-post post-title |
|
|
(define (edit-post post-title |
|
|
post-content |
|
|
post-content |
|
|
post-id) |
|
|
post-id |
|
|
|
|
|
terms-names) |
|
|
(method-call 'wp.editPost |
|
|
(method-call 'wp.editPost |
|
|
(list |
|
|
(list |
|
|
(xint 1) |
|
|
(xint 1) |
|
@ -179,7 +180,9 @@ |
|
|
("post_excerpt" |
|
|
("post_excerpt" |
|
|
,(xstring (substring post-content 20))) |
|
|
,(xstring (substring post-content 20))) |
|
|
("post_content" |
|
|
("post_content" |
|
|
,(xstring post-content))))))) |
|
|
,(xstring post-content)) |
|
|
|
|
|
("terms_names" |
|
|
|
|
|
,terms-names)))))) |
|
|
|
|
|
|
|
|
(define (get-post-id result) |
|
|
(define (get-post-id result) |
|
|
(se-path* '(string) |
|
|
(se-path* '(string) |
|
@ -200,7 +203,8 @@ |
|
|
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))]))))))) |
|
|
|
|
|
|
|
|
; Deletes a post |
|
|
; Deletes a post |
|
|
(define (rm-post post-id) |
|
|
(define (rm-post post-id) |
|
@ -353,21 +357,23 @@ |
|
|
(commit->value |
|
|
(commit->value |
|
|
key |
|
|
key |
|
|
ref)]) |
|
|
ref)]) |
|
|
(map |
|
|
(parse-tags tag-string))]))) |
|
|
(lambda (st) |
|
|
|
|
|
(substring st 1)) |
|
|
|
|
|
(string-split tag-string)))]))) |
|
|
|
|
|
|
|
|
|
|
|
(define (parse-tags tag) |
|
|
(define (parse-tags tag) |
|
|
(let |
|
|
|
|
|
([splitted (string-split tag ":")]) |
|
|
|
|
|
(map |
|
|
(map |
|
|
(lambda (st) |
|
|
(lambda (st) |
|
|
(substring st 1)) |
|
|
(substring st 1)) |
|
|
splitted))) |
|
|
(string-split tag ":"))) |
|
|
|
|
|
|
|
|
|
|
|
(define (to-tag-string taglist) |
|
|
|
|
|
(string-join |
|
|
|
|
|
(map |
|
|
|
|
|
(curry format "#~a") |
|
|
|
|
|
taglist) |
|
|
|
|
|
":")) |
|
|
|
|
|
|
|
|
; Check the environment variables for any new tags |
|
|
; Check the environment variables for any new tags |
|
|
(define (check-for-tags) |
|
|
(define (new-tags) |
|
|
(let* ([environ (current-environment-variables)] |
|
|
(let* ([environ (current-environment-variables)] |
|
|
[names (environment-variables-names environ)] |
|
|
[names (environment-variables-names environ)] |
|
|
[names* |
|
|
[names* |
|
@ -375,19 +381,33 @@ |
|
|
(compose1 |
|
|
(compose1 |
|
|
(curry |
|
|
(curry |
|
|
regexp-match |
|
|
regexp-match |
|
|
#rx"^[^\\.]+\\.tags$") |
|
|
#rx"^.+_tags$") |
|
|
string-foldcase |
|
|
string-foldcase |
|
|
bytes->string/utf-8) |
|
|
bytes->string/utf-8) |
|
|
names)]) |
|
|
names)] |
|
|
(map |
|
|
[names-hash (make-hash)]) |
|
|
(lambda (name) |
|
|
(for ([name names*]) |
|
|
(cons |
|
|
(let ([tag-string (bytes->string/utf-8 |
|
|
|
|
|
(environment-variables-ref environ name))]) |
|
|
|
|
|
(hash-set! names-hash |
|
|
(bytes->string/utf-8 name) |
|
|
(bytes->string/utf-8 name) |
|
|
(list |
|
|
(parse-tags tag-string)))) |
|
|
(parse-tags |
|
|
names-hash)) |
|
|
(bytes->string/utf-8 |
|
|
|
|
|
(environment-variables-ref environ name)))))) |
|
|
(define (check-tags post new-tags) |
|
|
names*))) |
|
|
(match (hash-ref new-tags |
|
|
|
|
|
(format "~a_tags" |
|
|
|
|
|
(regexp-replace* #px"\\/|\\." post "_")) |
|
|
|
|
|
#f) |
|
|
|
|
|
[#f |
|
|
|
|
|
(match (get-tags post) |
|
|
|
|
|
[#f (list "default")] |
|
|
|
|
|
[tags |
|
|
|
|
|
(add-tag! post (to-tag-string tags)) |
|
|
|
|
|
tags])] |
|
|
|
|
|
[tags |
|
|
|
|
|
(add-tag! post (to-tag-string tags)) |
|
|
|
|
|
tags])) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (add-tag-alias) |
|
|
(define (add-tag-alias) |
|
@ -407,7 +427,7 @@ |
|
|
(let* ([post-status (car post-file)] |
|
|
(let* ([post-status (car post-file)] |
|
|
[post (cadr post-file)] |
|
|
[post (cadr post-file)] |
|
|
[categories (get-categories post)] |
|
|
[categories (get-categories post)] |
|
|
[tags (get-tags post)]) |
|
|
[tags (check-tags post (new-tags))]) |
|
|
(displayln tags) |
|
|
(displayln tags) |
|
|
|
|
|
|
|
|
(match (git-href post #f) |
|
|
(match (git-href post #f) |
|
|