;;; tekuti.el --- Tekuti interaction library -*- lexical-binding: t; -*- ;; Copyright (C) 2021 Tom Willemse ;; Author: Tom Willemse ;; Keywords: comm ;; Package-Requires: (org) ;; Version: 0.1.0 ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; A simple module to help post things to your tekuti blog. You’ll want to ;; customize the ‘tekuti-host’ variable to point to your own blog. You should be ;; asked for your credentials, which should then be stored in ~/.authinfo.gpg. ;; Currently you should add these headers to your org document that you want to ;; send up: ;; #+TITLE: SOME TITLE ;; #+DATE: <2021-06-03 Thu 22:45> ;; #+TAGS: comma,separated ;; #+COMMENT_STATUS: open ;; #+COMMENTS_DATE: ;; #+STATUS: publish ;; The main entry point is ‘tekuti-send’. Call this from an org-mode buffer to ;; export the buffer to HTML and send it up to your blog. ;;; Code: (require 'org) (defvar tekuti-host "http://127.0.0.1:8080") (defun tekuti--format-date (&optional date) "Format DATE into a date that tekuti understands." (format-time-string "%a, %d %b %Y %H:%M:%S %Z" (unless (null date) (date-to-time date)) t)) (defun tekuti-build-data-from-org () "Parse the current org buffer to collect the necessary metadata." (let ((defaults `(("TITLE") ("DATE" ,(tekuti--format-date)) ("TAGS") ("STATUS") ("COMMENT_STATUS") ("COMMENTS-CLOSED-DATE") ("BODY"))) (data (append (mapcar (lambda (pair) (pcase pair (`("DATE" ,date) (list "DATE" (tekuti--format-date date))) (`("COMMENTS_DATE" ,date) (list "COMMENTS-CLOSED-DATE" (and (not (string-empty-p date)) (tekuti--format-date date)))) (_ pair))) (org-collect-keywords '("TITLE" "TAGS" "STATUS" "COMMENT_STATUS" "DATE" "COMMENTS_DATE"))) (list (list "BODY" (with-current-buffer (org-html-export-as-html nil nil nil t) (buffer-substring-no-properties (point-min) (point-max)))))))) (mapcar (lambda (item) (let ((key (car item))) `(,key ,@(or (alist-get key data nil nil #'string=) (cdr item))))) defaults))) (defun tekuti-form-encode-pair (key value) (concat (url-hexify-string key) "=" (url-hexify-string value))) (defun tekuti-form-encode-data (data) (mapconcat (lambda (pair) (tekuti-form-encode-pair (downcase (car pair)) (cadr pair))) data "&")) (defun tekuti--send-finished (status buffer args) (pcase-exhaustive status (`(:redirect ,url . ,_) (save-excursion (with-current-buffer buffer (goto-char (point-min)) (search-forward "\n\n") (backward-char) (let ((data (org-collect-keywords '("TITLE" "TAGS" "STATUS" "COMMENT_STATUS" "DATE" "COMMENTS_DATE")))) (mapc (lambda (item) (let ((key (car item)) (value (cadr item))) (when (and (not (string= key "BODY")) (null (alist-get key data nil nil #'string=)) (not (null value))) (insert "#+" key ": " value "\n")))) args)) (unless (tekuti--get-update-url) (insert "#+UPDATE_URL: " (string-replace "/posts/" "/modify-post/" (car (url-path-and-query (url-generic-parse-url url)))) "\n")))) (message "Created new post: %s" url)) (`(:error (error http ,code) . ,_) (message "Failed to create post: %d" code)))) (defun tekuti--get-update-url () (save-excursion (goto-char (point-min)) (car (map-elt (org-collect-keywords '("UPDATE_URL")) "UPDATE_URL")))) ;;;###autoload (defun tekuti-send () (interactive) (let* ((data (tekuti-build-data-from-org)) (url-request-method "POST") (url-request-extra-headers `(("Content-Type" . "application/x-www-form-urlencoded"))) (url-request-data (tekuti-form-encode-data data))) (url-retrieve (format "%s%s" tekuti-host (or (tekuti--get-update-url) "/admin/new-post")) #'tekuti--send-finished (list (current-buffer) data)))) (provide 'tekuti) ;;; tekuti.el ends here