diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-http.el | 42 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 98 |
2 files changed, 115 insertions, 25 deletions
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 58f6c7e..7250ef8 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -30,6 +30,7 @@ ;;; Code: (require 'json) +(require 'request) ; for attachments upload (defvar mastodon-instance-url) (autoload 'mastodon-auth--access-token "mastodon-auth") @@ -154,6 +155,7 @@ Pass response buffer to CALLBACK function with args CBARGS." Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (let ((url-request-method "POST") + (request-timeout 5) (url-request-data (when args (mapconcat (lambda (arg) @@ -168,5 +170,45 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (with-temp-buffer (url-retrieve url callback cbargs mastodon-http--timeout)))) +;; TODO: test for curl first? +(defun mastodon-http--post-media-attachment (url filename caption) + "Make a POST request to upload file FILENAME with CAPTION to the server's media URL. + +The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' is set to the id(s) of the item uploaded, `mastodon-toot--media-attachments' is set to t, and `mastodon-toot--update-status-fields' is run." + (let* ((file (file-name-nondirectory filename)) + (request-backend 'curl) + (response + (request + url + :type "POST" + :params `(("description" . ,caption)) + :files `(("file" . (,file :file ,filename + :mime-type "multipart/form-data"))) + :parser 'json-read + :headers `(("Authorization" . ,(concat "Bearer " + (mastodon-auth--access-token)))) + :sync nil + :success (cl-function + (lambda (&key data &allow-other-keys) + (when data + (progn + (push (cdr (assoc 'id data)) + mastodon-toot--media-attachment-ids) ; add ID to list + (push file mastodon-toot--media-attachment-filenames) + (message "%s file %s with id %S and caption '%s' uploaded!" + (capitalize (cdr (assoc 'type data))) + file + (cdr (assoc 'id data)) + (cdr (assoc 'description data))) + (mastodon-toot--update-status-fields))))) + :error (cl-function + (lambda (&key error-thrown &allow-other-keys) + (message "Got error: %s" error-thrown))) + ))) + (pcase (request-response-status-code response) + (200 + (request-response-data response) + )))) + (provide 'mastodon-http) ;;; mastodon-http.el ends here diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 52af778..a11bfa0 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -73,6 +73,18 @@ Must be one of \"public\", \"unlisted\", \"private\", or \"direct\"." Valid values are \"direct\", \"private\", \"unlisted\", and \"public\".") (make-variable-buffer-local 'mastodon-toot--visibility) +(defvar mastodon-toot--media-attachments nil + "A flag indicating if the toot being composed has media attachments.") +(make-variable-buffer-local 'mastodon-toot--media-attachments) + +(defvar mastodon-toot--media-attachment-ids nil + "A list of any media attachment ids of the toot being composed.") +(make-variable-buffer-local 'mastodon-toot--media-attachment-ids) + +(defvar mastodon-toot--media-attachment-filenames nil + "A list of any media attachment filenames of the toot being composed.") +(make-variable-buffer-local 'mastodon-toot--media-attachment-filenames) + (defvar mastodon-toot--reply-to-id nil "Buffer-local variable to hold the id of the toot being replied to.") (make-variable-buffer-local 'mastodon-toot--reply-to-id) @@ -82,8 +94,9 @@ Valid values are \"direct\", \"private\", \"unlisted\", and \"public\".") (define-key map (kbd "C-c C-c") #'mastodon-toot--send) (define-key map (kbd "C-c C-k") #'mastodon-toot--cancel) (define-key map (kbd "C-c C-w") #'mastodon-toot--toggle-warning) - ;;(define-key map (kbd "C-c C-n") #'mastodon-toot--toggle-nsfw) + (define-key map (kbd "C-c C-n") #'mastodon-toot--toggle-nsfw) (define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility) + (define-key map (kbd "C-c C-a") #'mastodon-toot--add-media-attachment) map) "Keymap for `mastodon-toot'.") @@ -194,28 +207,52 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (setq mastodon-toot--visibility visibility) (message "Visibility set to %s" visibility)) +(defun mastodon-toot--add-media-attachment () + "Prompt the user for a file and POST it to the media endpoint on the server. + +Set `mastodon-toot--media-attachment-ids' to the item's id so it can be attached to the toot." + (interactive) + (let* ((filename (read-file-name "Choose file to attach to this toot: ")) + (caption (read-string "Enter a caption: ")) + (url (concat mastodon-instance-url "/api/v1/media"))) + (message "Uploading %s..." (file-name-nondirectory filename)) + (mastodon-http--post-media-attachment url filename caption) + (setq mastodon-toot--media-attachments t))) + (defun mastodon-toot--send () - "Kill new-toot buffer/window and POST contents to the Mastodon instance." + "Kill new-toot buffer/window and POST contents to the Mastodon instance. + +If media items have been uploaded with `mastodon-toot--add-media-attachment', attach them to the toot." (interactive) (let* ((toot (mastodon-toot--remove-docs)) - (empty-toot-p (string= "" (mastodon-tl--clean-tabs-and-nl toot))) + (empty-toot-p (and (not mastodon-toot--media-attachments) + (string= "" (mastodon-tl--clean-tabs-and-nl toot)))) (endpoint (mastodon-http--api "statuses")) (spoiler (when (and (not empty-toot-p) mastodon-toot--content-warning) (read-string "Warning: "))) - (args `(("status" . ,toot) - ("in_reply_to_id" . ,mastodon-toot--reply-to-id) - ("visibility" . ,mastodon-toot--visibility) - ("sensitive" . ,(when mastodon-toot--content-nsfw - (symbol-name t))) - ("visibility" . ,mastodon-toot--visibility) - ("spoiler_text" . ,spoiler)))) - (if empty-toot-p - (message "Empty toot. Cowardly refusing to post this.") - (mastodon-toot--kill) - (let ((response (mastodon-http--post endpoint args nil))) - (mastodon-http--triage response - (lambda () (message "Toot toot!"))))))) + (args-no-media `(("status" . ,toot) + ("in_reply_to_id" . ,mastodon-toot--reply-to-id) + ("visibility" . ,mastodon-toot--visibility) + ("sensitive" . ,(when mastodon-toot--content-nsfw + (symbol-name t))) + ("spoiler_text" . ,spoiler))) + (args-media + (when mastodon-toot--media-attachments + (mapcar + (lambda (id) + (cons "media_ids[]" id)) + mastodon-toot--media-attachment-ids))) + (args (append args-no-media args-media))) + (if (and mastodon-toot--media-attachments + (equal mastodon-toot--media-attachment-ids nil)) + (message "Looks like your uploads are not yet ready...") + (if empty-toot-p + (message "Empty toot. Cowardly refusing to post this.") + (mastodon-toot--kill) + (let ((response (mastodon-http--post endpoint args nil))) + (mastodon-http--triage response + (lambda () (message "Toot toot!")))))))) (defun mastodon-toot--process-local (acct) "Adds domain to local ACCT and replaces the curent user name with \"\". @@ -359,11 +396,14 @@ warning flags etc." (propertize "Visibility" 'toot-post-visibility t) " ⋅ " + (propertize "Attachment" + 'toot-attachment t) + " ⋅ " (propertize "CW" 'toot-post-cw-flag t) - ;; " " - ;; (propertize "NSFW" - ;; 'toot-post-nsfw-flag t) + " " + (propertize "NSFW" + 'toot-post-nsfw-flag t) "\n" divider (propertize "\n" @@ -388,22 +428,30 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (point-min))) (visibility-region (mastodon-tl--find-property-range 'toot-post-visibility (point-min))) - ;; (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag - ;; (point-min))) + (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag + (point-min))) (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag (point-min))) + (attachment-region (mastodon-tl--find-property-range + 'toot-attachment (point-min))) ) (add-text-properties (car count-region) (cdr count-region) (list 'display - (format "%s characters in message" + (format "%s characters" (- (point-max) (cdr header-region))))) (add-text-properties (car visibility-region) (cdr visibility-region) (list 'display (format "Visibility: %s" mastodon-toot--visibility))) - ;; (add-text-properties (car nsfw-region) (cdr nsfw-region) - ;; (list 'invisible (not mastodon-toot--content-nsfw) - ;; 'face 'mastodon-cw-face)) + (add-text-properties (car attachment-region) (cdr attachment-region) + (list 'display + (format "Attached: %s" + (mapconcat 'identity + mastodon-toot--media-attachment-filenames + ", ")))) + (add-text-properties (car nsfw-region) (cdr nsfw-region) + (list 'invisible (not mastodon-toot--content-nsfw) + 'face 'mastodon-cw-face)) (add-text-properties (car cw-region) (cdr cw-region) (list 'invisible (not mastodon-toot--content-warning) 'face 'mastodon-cw-face)))) |