2020-10-25 17:55:55 +00:00
|
|
|
;;; post-to-gemlog-blue.el -- Post to gemlog.blue from emacs -*- lexical-binding: t -*-
|
|
|
|
|
|
|
|
;; Copyright (c) 2020 Case Duckworth
|
|
|
|
|
|
|
|
;; Author: Case Duckworth <acdw@acdw.net>
|
|
|
|
;; Version: 1.0
|
2020-10-25 18:07:36 +00:00
|
|
|
;; Package-Requires: ((emacs "24.3"))
|
2020-10-25 17:55:55 +00:00
|
|
|
;; Keywords: gemini, hypermedia
|
|
|
|
;; URL: TBH
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
;; This package provides a function, `post-to-gemlog-blue', which
|
|
|
|
;; allows you to post to https://gemlog.blue, an http-to-gemini
|
|
|
|
;; posting site. Later, I'll add more general things, I guess...
|
|
|
|
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
(defun post-to-gemlog-blue (post-title user pass)
|
|
|
|
"Post current buffer to gemlog.blue."
|
|
|
|
(interactive
|
|
|
|
(let* ((title-maybe (progn ;; TODO this is ... clunky
|
|
|
|
(goto-char (point-min))
|
|
|
|
(if (re-search-forward "^# \\(.*\\)" nil t)
|
|
|
|
(buffer-substring-no-properties
|
|
|
|
(match-beginning 1)
|
|
|
|
(match-end 1))
|
|
|
|
"")))
|
|
|
|
(title (read-string
|
|
|
|
(format "Title%s: "
|
|
|
|
(if (string= "" title-maybe)
|
|
|
|
""
|
|
|
|
(concat " (" title-maybe ")")))
|
|
|
|
nil nil title-maybe))
|
|
|
|
(user (read-string "User: " nil))
|
|
|
|
(pass (read-passwd "Pass: " nil)))
|
|
|
|
(list title user pass)))
|
|
|
|
|
|
|
|
(require 'mm-url)
|
|
|
|
(let ((url-request-method "POST")
|
|
|
|
(url-request-extra-headers
|
|
|
|
'(("Content-Type" . "application/x-www-form-urlencoded")))
|
|
|
|
(url-request-data
|
|
|
|
(mm-url-encode-www-form-urlencoded
|
|
|
|
`(("title" . ,post-title)
|
|
|
|
("gemloguser" . ,user)
|
|
|
|
("pw" . ,pass)
|
|
|
|
("post" . ,(buffer-string))))))
|
|
|
|
(with-current-buffer
|
|
|
|
(url-retrieve-synchronously "https://gemlog.blue/post.php")
|
|
|
|
(goto-char (point-min))
|
|
|
|
(re-search-forward "\\(gemini://.*\\.gmi\\)")
|
|
|
|
(elpher-go (match-string 1)))))
|
|
|
|
|
|
|
|
(provide 'post-to-gemlog-blue)
|
|
|
|
|
|
|
|
;;; post-to-gemlog-blue ends here
|