git.stevedylan.dev

chore: updated posts script 099bb7d4

Steve · 2026-10-06 07:41 1 file(s) · +82 −23

doom/scripts/posts.el +82 −23

;;
;;; Commentary:
;; Sends micro posts to an Andromeda/posts instance.
;; Run M-x posts-compose, write the title on the first line and the
;; content below it, then press C-c C-c to send.
;; Run M-x posts-compose, fill in the `name: value' fields at the top
;; (see `posts-fields'), write the content below, then press C-c C-c.
;;
;;; Code:


  :type 'string
  :group 'posts)

;;;; Fields

(defcustom posts-fields
  '(("title")
    ("status" :default "draft" :choices ("draft" "published")))
  "Header fields read from the top of the compose buffer as `name: value'.
Each entry is (NAME . PLIST).  PLIST keys: `:required', `:default',
`:choices'.  Add an entry to support a new field; it is sent as a JSON
key of the same name."
  :type '(alist :key-type string :value-type plist)
  :group 'posts)

(defun posts--parse-buffer ()
  "Return (FIELDS . CONTENT) parsed from the current buffer.
FIELDS is an alist of raw (NAME . VALUE) strings from the leading
`name: value' lines.  CONTENT is everything after them."
  (save-excursion
    (goto-char (point-min))
    (let (fields)
      (while (looking-at "^\\([[:alnum:]_-]+\\):[ \t]*\\(.*?\\)[ \t]*$")
        (push (cons (downcase (match-string-no-properties 1))
                    (match-string-no-properties 2))
              fields)
        (forward-line 1))
      (cons (nreverse fields)
            (string-trim
             (buffer-substring-no-properties (point) (point-max)))))))

(defun posts--resolve-fields (parsed)
  "Validate PARSED against `posts-fields'; return alist with defaults applied."
  (dolist (p parsed)
    (unless (assoc (car p) posts-fields)
      (user-error "Unknown field `%s'" (car p))))
  (delq nil
        (mapcar
         (lambda (spec)
           (let* ((name (car spec))
                  (opts (cdr spec))
                  (raw (cdr (assoc name parsed)))
                  (val (if (and raw (not (string-empty-p raw)))
                           raw
                         (plist-get opts :default)))
                  (choices (plist-get opts :choices)))
             (when (and (plist-get opts :required) (null val))
               (user-error "Field `%s' is required" name))
             (when (and val choices (not (member val choices)))
               (user-error "Bad %s `%s' (one of: %s)"
                           name val (string-join choices ", ")))
             (and val (cons name val))))
         posts-fields)))

(defun posts--payload (fields content)
  "Build the JSON plist from FIELDS alist and CONTENT."
  (append (mapcan (lambda (f) (list (intern (concat ":" (car f))) (cdr f)))
                  fields)
          (list :content content)))

;;;; Sending

(defun posts (title content)
  "Send a post with TITLE and CONTENT to `posts-endpoint' as JSON."
(defun posts (fields content)
  "Send a post to `posts-endpoint' as JSON.
FIELDS is an alist of (NAME . VALUE) strings, CONTENT the body."
  (interactive
   (list (read-string "Title: ")
         (read-string "Content: ")))
   (let ((title (read-string "Title (optional): ")))
     (list (delq nil (list (and (not (string-empty-p title))
                                (cons "title" title))
                           (cons "status" "draft")))
           (read-string "Content: "))))
  (let ((url-request-method "POST")
        (url-request-extra-headers
         `(("Content-Type" . "application/json; charset=utf-8")
           ("X-API-Key" . ,(posts--api-key))))
        (url-request-data
         (encode-coding-string
          (json-serialize `(:title ,title :content ,content :status "draft"))
          (json-serialize (posts--payload fields content))
          'utf-8)))
    (url-retrieve
     posts-endpoint

  "Keymap for `posts-compose-mode'.")

(define-derived-mode posts-compose-mode text-mode "Posts"
  "Compose a post.  First line is the title, the rest is content.
  "Compose a post.  Leading `name: value' lines are fields, the rest is content.
\\{posts-compose-mode-map}"
  (setq header-line-format
        "Title on first line.  C-c C-c to send, C-c C-k to cancel"))
        "Fields as `name: value' lines, then content.  C-c C-c to send, C-c C-k to cancel"))

;;;###autoload
(defun posts-compose ()

  (interactive)
  (pop-to-buffer (get-buffer-create "*posts-compose*"))
  (erase-buffer)
  (posts-compose-mode))
  (posts-compose-mode)
  (dolist (spec posts-fields)
    (insert (car spec) ": " (or (plist-get (cdr spec) :default) "") "\n"))
  (insert "\n")
  (goto-char (point-min))
  (end-of-line))

(defun posts-compose-submit ()
  "Parse the compose buffer and send it."
  (interactive)
  (let* ((title (save-excursion
                  (goto-char (point-min))
                  (string-trim
                   (buffer-substring-no-properties
                    (line-beginning-position) (line-end-position)))))
         (content (save-excursion
                    (goto-char (point-min))
                    (forward-line 1)
                    (string-trim
                     (buffer-substring-no-properties (point) (point-max))))))
    (when (string-empty-p title)
      (user-error "Title is empty"))
    (posts title content)
  (let* ((parsed (posts--parse-buffer))
         (fields (posts--resolve-fields (car parsed)))
         (content (cdr parsed)))
    (when (string-empty-p content)
      (user-error "Content is empty"))
    (posts fields content)
    (quit-window t)))

(defun posts-compose-cancel ()

12	12		;;
13	13		;;; Commentary:
14	14		;; Sends micro posts to an Andromeda/posts instance.
15		-	;; Run M-x posts-compose, write the title on the first line and the
16		-	;; content below it, then press C-c C-c to send.
	15	+	;; Run M-x posts-compose, fill in the `name: value' fields at the top
	16	+	;; (see `posts-fields'), write the content below, then press C-c C-c.
17	17		;;
18	18		;;; Code:
19	19

41	41		:type 'string
42	42		:group 'posts)
43	43
	44	+	;;;; Fields
	45	+
	46	+	(defcustom posts-fields
	47	+	'(("title")
	48	+	("status" :default "draft" :choices ("draft" "published")))
	49	+	"Header fields read from the top of the compose buffer as `name: value'.
	50	+	Each entry is (NAME . PLIST). PLIST keys: `:required', `:default',
	51	+	`:choices'. Add an entry to support a new field; it is sent as a JSON
	52	+	key of the same name."
	53	+	:type '(alist :key-type string :value-type plist)
	54	+	:group 'posts)
	55	+
	56	+	(defun posts--parse-buffer ()
	57	+	"Return (FIELDS . CONTENT) parsed from the current buffer.
	58	+	FIELDS is an alist of raw (NAME . VALUE) strings from the leading
	59	+	`name: value' lines. CONTENT is everything after them."
	60	+	(save-excursion
	61	+	(goto-char (point-min))
	62	+	(let (fields)
	63	+	(while (looking-at "^\\([[:alnum:]_-]+\\):[ \t]\\(.?\\)[ \t]*$")
	64	+	(push (cons (downcase (match-string-no-properties 1))
	65	+	(match-string-no-properties 2))
	66	+	fields)
	67	+	(forward-line 1))
	68	+	(cons (nreverse fields)
	69	+	(string-trim
	70	+	(buffer-substring-no-properties (point) (point-max)))))))
	71	+
	72	+	(defun posts--resolve-fields (parsed)
	73	+	"Validate PARSED against `posts-fields'; return alist with defaults applied."
	74	+	(dolist (p parsed)
	75	+	(unless (assoc (car p) posts-fields)
	76	+	(user-error "Unknown field `%s'" (car p))))
	77	+	(delq nil
	78	+	(mapcar
	79	+	(lambda (spec)
	80	+	(let* ((name (car spec))
	81	+	(opts (cdr spec))
	82	+	(raw (cdr (assoc name parsed)))
	83	+	(val (if (and raw (not (string-empty-p raw)))
	84	+	raw
	85	+	(plist-get opts :default)))
	86	+	(choices (plist-get opts :choices)))
	87	+	(when (and (plist-get opts :required) (null val))
	88	+	(user-error "Field `%s' is required" name))
	89	+	(when (and val choices (not (member val choices)))
	90	+	(user-error "Bad %s `%s' (one of: %s)"
	91	+	name val (string-join choices ", ")))
	92	+	(and val (cons name val))))
	93	+	posts-fields)))
	94	+
	95	+	(defun posts--payload (fields content)
	96	+	"Build the JSON plist from FIELDS alist and CONTENT."
	97	+	(append (mapcan (lambda (f) (list (intern (concat ":" (car f))) (cdr f)))
	98	+	fields)
	99	+	(list :content content)))
	100	+
44	101		;;;; Sending
45	102
46		-	(defun posts (title content)
47		-	"Send a post with TITLE and CONTENT to `posts-endpoint' as JSON."
	103	+	(defun posts (fields content)
	104	+	"Send a post to `posts-endpoint' as JSON.
	105	+	FIELDS is an alist of (NAME . VALUE) strings, CONTENT the body."
48	106		(interactive
49		-	(list (read-string "Title: ")
50		-	(read-string "Content: ")))
	107	+	(let ((title (read-string "Title (optional): ")))
	108	+	(list (delq nil (list (and (not (string-empty-p title))
	109	+	(cons "title" title))
	110	+	(cons "status" "draft")))
	111	+	(read-string "Content: "))))
51	112		(let ((url-request-method "POST")
52	113		(url-request-extra-headers
53	114		`(("Content-Type" . "application/json; charset=utf-8")
54	115		("X-API-Key" . ,(posts--api-key))))
55	116		(url-request-data
56	117		(encode-coding-string
57		-	(json-serialize `(:title ,title :content ,content :status "draft"))
	118	+	(json-serialize (posts--payload fields content))
58	119		'utf-8)))
59	120		(url-retrieve
60	121		posts-endpoint

81	142		"Keymap for `posts-compose-mode'.")
82	143
83	144		(define-derived-mode posts-compose-mode text-mode "Posts"
84		-	"Compose a post. First line is the title, the rest is content.
	145	+	"Compose a post. Leading `name: value' lines are fields, the rest is content.
85	146		\\{posts-compose-mode-map}"
86	147		(setq header-line-format
87		-	"Title on first line. C-c C-c to send, C-c C-k to cancel"))
	148	+	"Fields as `name: value' lines, then content. C-c C-c to send, C-c C-k to cancel"))
88	149
89	150		;;;###autoload
90	151		(defun posts-compose ()

92	153		(interactive)
93	154		(pop-to-buffer (get-buffer-create "posts-compose"))
94	155		(erase-buffer)
95		-	(posts-compose-mode))
	156	+	(posts-compose-mode)
	157	+	(dolist (spec posts-fields)
	158	+	(insert (car spec) ": " (or (plist-get (cdr spec) :default) "") "\n"))
	159	+	(insert "\n")
	160	+	(goto-char (point-min))
	161	+	(end-of-line))
96	162
97	163		(defun posts-compose-submit ()
98	164		"Parse the compose buffer and send it."
99	165		(interactive)
100		-	(let* ((title (save-excursion
101		-	(goto-char (point-min))
102		-	(string-trim
103		-	(buffer-substring-no-properties
104		-	(line-beginning-position) (line-end-position)))))
105		-	(content (save-excursion
106		-	(goto-char (point-min))
107		-	(forward-line 1)
108		-	(string-trim
109		-	(buffer-substring-no-properties (point) (point-max))))))
110		-	(when (string-empty-p title)
111		-	(user-error "Title is empty"))
112		-	(posts title content)
	166	+	(let* ((parsed (posts--parse-buffer))
	167	+	(fields (posts--resolve-fields (car parsed)))
	168	+	(content (cdr parsed)))
	169	+	(when (string-empty-p content)
	170	+	(user-error "Content is empty"))
	171	+	(posts fields content)
113	172		(quit-window t)))
114	173
115	174		(defun posts-compose-cancel ()