From 0034797ed285eff9ca85448b21a39fa27f40a3ce Mon Sep 17 00:00:00 2001 From: mousebot Date: Sat, 9 Oct 2021 15:18:41 +0200 Subject: handle caching of images we now store images ourselves for caching rather than relying on url-automatic-caching. --- lisp/mastodon-media.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 8ef9c44..8aadf0a 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -130,7 +130,7 @@ fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=") "The PNG data for a generic 200x200 'broken image' view.") (defun mastodon-media--process-image-response - (status-plist marker image-options region-length) + (status-plist marker image-options region-length url) "Callback function processing the url retrieve response for URL. STATUS-PLIST is the usual plist of status events as per `url-retrieve'. @@ -151,6 +151,8 @@ REGION-LENGTH is the length of the region that should be replaced with the image (when image-options 'imagemagick) nil) ; inbuilt scaling in 27.1 t image-options)))) + (unless (url-is-cached url) ; cache image if not already cached + (url-store-in-cache url-buffer)) (with-current-buffer (marker-buffer marker) ;; Save narrowing in our buffer (let ((inhibit-read-only t)) @@ -190,14 +192,16 @@ REGION-LENGTH is the range from start to propertize." ;; catch any errors in url-retrieve so as to not abort ;; whatever called us (if (url-is-cached url) + ;; if image url is cached, decompress and use it (with-current-buffer (url-fetch-from-cache url) (set-buffer-multibyte nil) (goto-char (point-min)) (zlib-decompress-region (goto-char (search-forward "\n\n")) (point-max)) - (mastodon-media--process-image-response nil marker image-options region-length)) + (mastodon-media--process-image-response nil marker image-options region-length url)) + ;; else fetch as usual and process-image-response will cache it (url-retrieve url #'mastodon-media--process-image-response - (list marker image-options region-length))) + (list marker image-options region-length url))) (error (with-current-buffer buffer ;; TODO: Consider adding retries (put-text-property marker @@ -205,7 +209,7 @@ REGION-LENGTH is the range from start to propertize." 'media-state 'loading-failed) :loading-failed)))))) -H + (defun mastodon-media--select-next-media-line (end-pos) "Find coordinates of the next media to load before END-POS. -- cgit v1.2.3 From 547e4cf02a62d4a625ba13017b65908d77da50a6 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 14 Oct 2021 12:34:17 +0200 Subject: readme --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index 60f04eb..dcccccf 100644 --- a/README.org +++ b/README.org @@ -70,10 +70,10 @@ I might add a few more features if the ones I added turn out to work ok. Possibl - [X] prevent loss of draft toots by the toot-send bug - [X] fix scaling of images - [ ] display post visibility status in timelines +- [ ] caching of images / avatars - better display of polls - display number of boosts/faves in toot byline - mention all thread participants in replies -- handle newlines in toots better, for poetry, etc. - improve (or even partially disable) async. It looks like 2-factor auth was never completed in the original repo. It's not a priority for me, auth ain't my thing. If you want to hack on it, its on the develop branch in the original repo. -- cgit v1.2.3 From 1f2ebe94c647fef509e06e9ef6f79697ef98a356 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 12:57:41 +0200 Subject: first test merge of hdurer's WIP: Posting of images --- lisp/mastodon-auth.el | 30 +++++------ lisp/mastodon-client.el | 8 +-- lisp/mastodon-http.el | 64 +++++++++++++++++++---- lisp/mastodon-media.el | 5 ++ lisp/mastodon-toot.el | 133 +++++++++++++++++++++++++++++++++++------------- 5 files changed, 176 insertions(+), 64 deletions(-) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 0b0c703..cd74ef8 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -73,12 +73,12 @@ If no auth-sources file, runs `mastodon-auth--generate-token-no-storing-credenti "Make POST to generate auth token, without using auth-sources file." (mastodon-http--post (concat mastodon-instance-url "/oauth/token") - `(("client_id" . ,(plist-get (mastodon-client) :client_id)) - ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) - ("grant_type" . "password") - ("username" . ,(read-string "Email: " user-mail-address)) - ("password" . ,(read-passwd "Password: ")) - ("scope" . "read write follow")) + `(("client_id" ,(plist-get (mastodon-client) :client_id)) + ("client_secret" ,(plist-get (mastodon-client) :client_secret)) + ("grant_type" "password") + ("username" ,(read-string "Email: " user-mail-address)) + ("password" ,(read-passwd "Password: ")) + ("scope" "read write follow")) nil :unauthenticated)) @@ -98,15 +98,15 @@ Reads and/or stores secrets in `MASTODON-AUTH-SOURCE-FILE'." (prog1 (mastodon-http--post (concat mastodon-instance-url "/oauth/token") - `(("client_id" . ,(plist-get (mastodon-client) :client_id)) - ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) - ("grant_type" . "password") - ("username" . ,(plist-get credentials-plist :user)) - ("password" . ,(let ((secret (plist-get credentials-plist :secret))) - (if (functionp secret) - (funcall secret) - secret))) - ("scope" . "read write follow")) + `(("client_id" ,(plist-get (mastodon-client) :client_id)) + ("client_secret" ,(plist-get (mastodon-client) :client_secret)) + ("grant_type" "password") + ("username" ,(plist-get credentials-plist :user)) + ("password" ,(let ((secret (plist-get credentials-plist :secret))) + (if (functionp secret) + (funcall secret) + secret))) + ("scope" "read write follow")) nil :unauthenticated) (when (functionp (plist-get credentials-plist :save-function)) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index bdfbca9..4503d6d 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -49,10 +49,10 @@ "POST client to Mastodon." (mastodon-http--post (mastodon-http--api "apps") - '(("client_name" . "mastodon.el") - ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") - ("scopes" . "read write follow") - ("website" . "https://github.com/jdenen/mastodon.el")) + '(("client_name" "mastodon.el") + ("redirect_uris" "urn:ietf:wg:oauth:2.0:oob") + ("scopes" "read write follow") + ("website" "https://github.com/jdenen/mastodon.el")) nil :unauthenticated)) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index bc48e8d..85ee588 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -90,29 +90,75 @@ Message status and JSON error from RESPONSE if unsuccessful." (let ((json-response (mastodon-http--process-json))) (message "Error %s: %s" status (cdr (assoc 'error json-response)))))))) +(defun mastodon-http--encode-multipart-form-data (boundary fields) + "Encode FIELDS suitable to post as multipart/form-data. + +It uses BOUNDARY as the boundary for the values. +FIELDS should be a list of either 2-element (name contents) lists +or 4-element list of (name file-name content-type contents)." + (with-temp-buffer + (dolist (field fields) + (insert "--" boundary "\r\n") + (if (= (length field) 2) + ;; a 2-element list is a simple name=value item: + (insert "Content-Disposition: form-data; name=\"" + (url-hexify-string (car field)) + "\"\r\n" + "\r\n" + (cadr field) "\r\n") + ;; a 4-element list ist a file to be attached: + (insert "Content-Disposition: form-data; name=\"" + (url-hexify-string (car field)) + "\"; filename=\"" + (url-hexify-string (cadr field)) + "\"\r\n" + "Content-type: " (caddr field) "\r\n" + "\r\n" + (cadddr field) "\r\n"))) + ;; Finally add the terminating boundary and another empty line: + (insert "--" boundary "--\r\n" + "\r\n") + (string-to-unibyte (buffer-string)))) + (defun mastodon-http--post (url args headers &optional unauthenticed-p) "POST synchronously to URL with ARGS and HEADERS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (let ((url-request-method "POST") - (url-request-data - (when args - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cdr arg)))) - args - "&"))) + (let* ((url-request-method "POST") + (boundary (md5 (format "b%s-%s-%s-%s" + (random 1000000000) (random 1000000000) + (random 1000000000) (random 1000000000)))) + (needs-multi-form (> (apply #'max (mapcar #'length args)) 2)) + (url-request-data + (when args + (if needs-multi-form + (mastodon-http--encode-multipart-form-data boundary args) + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cadr arg)))) + args + "&")))) (url-request-extra-headers (append + (when needs-multi-form + `(("Content-Type" . + ,(concat "multipart/form-data; boundary=\"" boundary "\"")))) (unless unauthenticed-p `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) headers))) + (message "Posting to %s with %d bytes of request data and headers %s" url (length url-request-data) url-request-extra-headers) (with-temp-buffer (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) (url-retrieve-synchronously url nil nil mastodon-http--timeout))))) +(defun mastodon-http--read-file-as-string (filename) + "" + (with-temp-buffer + (insert-file-contents filename) + (string-to-unibyte (buffer-string)))) + (defun mastodon-http--get (url) "Make synchronous GET request to URL. diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 8aadf0a..fd2a6b7 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -51,6 +51,11 @@ :group 'mastodon-media :type 'integer) +(defcustom mastodon-media--attachment-height 100 + "Height of the attached images preview." + :group 'mastodon-media + :type 'integer) + (defvar mastodon-media--generic-avatar-data (base64-decode-string "iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a8b121b..6c08859 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -30,6 +30,7 @@ ;;; Code: (defvar mastodon-instance-url) +(defvar mastodon-media--attachment-height) (when (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify")) @@ -103,6 +104,10 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p "Buffer-local variable to hold the id of the toot being replied to.") (make-variable-buffer-local 'mastodon-toot--reply-to-id) +(defvar mastodon-toot--media-attachments nil + "Buffer-local variable to hold the list of media attachments.") +(make-variable-buffer-local 'mastodon-toot--media-attachments) + (defvar mastodon-toot-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -110,9 +115,10 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (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-v") #'mastodon-toot--change-visibility) - (define-key map (kbd "C-c C-a") #'mastodon-toot--add-media-attachment) (when (require 'emojify nil :noerror) (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) + (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) + (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) map) "Keymap for `mastodon-toot'.") @@ -147,6 +153,14 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response callback)))) +(defun mastodon-toot--post-media (contents content-type description) + (let* ((url (mastodon-http--api "media")) + (response (mastodon-http--post + url + (list (list "description" description) + (list "file" "file" content-type contents))))) + response)) + (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." (interactive) @@ -414,6 +428,7 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (interactive) (setq mastodon-toot--content-nsfw (not mastodon-toot--content-nsfw)) + (message "NSFW flag is now %s" (if mastodon-toot--content-nsfw "on" "off")) (mastodon-toot--update-status-fields)) (defun mastodon-toot--change-visibility () @@ -430,6 +445,54 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." "public"))) (mastodon-toot--update-status-fields)) +(defun mastodon-toot--clear-all-attachments () + "" + (interactive) + (setq mastodon-toot--media-attachments nil) + (mastodon-toot--refresh-attachments-display) + (mastodon-toot--update-status-fields)) + +(defun mastodon-toot--attach-media (file content-type description) + "" + (interactive "fFilename: \nsContent type: \nsDescription: ") + (when (>= (length mastodon-toot--media-attachments) 4) + ;; Only a max. of 4 attachments are allowed, so pop the oldest one. + (pop mastodon-toot--media-attachments)) + (setq mastodon-toot--media-attachments + (nconc mastodon-toot--media-attachments + `(((:contents . ,(mastodon-http--read-file-as-string file)) + (:content-type . ,content-type) + (:description . ,description))))) + (mastodon-toot--refresh-attachments-display)) + +(defun mastodon-toot--refresh-attachments-display () + (let ((inhibit-read-only t) + (attachments-region (mastodon-tl--find-property-range + 'toot-attachments (point-min))) + (display-specs (mastodon-toot--format-attachments))) + (dotimes (i (- (cdr attachments-region) (car attachments-region))) + (add-text-properties (+ (car attachments-region) i) + (+ (car attachments-region) i 1) + (list 'display (or (nth i display-specs) "")))))) + +(defun mastodon-toot--format-attachments () + (or (let ((counter 0) + (image-options (when (image-type-available-p 'imagemagick) + `(:height ,mastodon-media--attachment-height)))) + (mapcan (lambda (attachment) + (let* ((data (cdr (assoc :contents attachment))) + (image (apply #'create-image data + (when image-options 'imagemagick) + t image-options)) + (type (cdr (assoc :content-type attachment))) + (description (cdr (assoc :description attachment)))) + (setq counter (1+ counter)) + (list (format "\n %d: " counter) + image + (format " \"%s\" (%s)" description type)))) + mastodon-toot--media-attachments)) + (list "None")) + ) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () @@ -483,6 +546,10 @@ on the status of NSFW, content warning flags, media attachments, etc." divider "\n" (mastodon-toot--make-mode-docs) "\n" divider "\n" + " Attachments: " + (propertize "None " 'toot-attachments t) + "\n" + divider "\n" " " (propertize "Count" 'toot-post-counter t) @@ -515,43 +582,35 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (defun mastodon-toot--update-status-fields (&rest args) "Update the status fields in the header based on the current state." - (let ((inhibit-read-only t) - (header-region (mastodon-tl--find-property-range 'toot-post-header + (ignore-errors ;; called from after-change-functions so let's not leak errors + (let ((inhibit-read-only t) + (header-region (mastodon-tl--find-property-range 'toot-post-header + (point-min))) + (count-region (mastodon-tl--find-property-range 'toot-post-counter (point-min))) - (count-region (mastodon-tl--find-property-range 'toot-post-counter + (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))) - (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))) - (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" - (- (point-max) (cdr header-region))))) - (add-text-properties (car visibility-region) (cdr visibility-region) - (list 'display - (format "Visibility: %s" - (if (equal - mastodon-toot--visibility - "private") - "followers-only" - mastodon-toot--visibility)))) - (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)))) + (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag + (point-min)))) + (add-text-properties (car count-region) (cdr count-region) + (list 'display + (format "%s characters in message" + (- (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 'display (if mastodon-toot--content-nsfw + (if mastodon-toot--media-attachments + "NSFW" "NSFW (no effect until attachments added)") + "") + 'face 'mastodon-cw-face)) + (add-text-properties (car cw-region) (cdr cw-region) + (list 'invisible (not mastodon-toot--content-warning) + 'face 'mastodon-cw-face))))) (defun mastodon-toot--compose-buffer (reply-to-user reply-to-id) "Create a new buffer to capture text for a new toot. @@ -561,12 +620,14 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (buffer (or buffer-exists (get-buffer-create "*new toot*"))) (inhibit-read-only t)) (switch-to-buffer-other-window buffer) + (mastodon-toot-mode t) (when (not buffer-exists) (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) + (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields))) (define-minor-mode mastodon-toot-mode -- cgit v1.2.3 From 72c14d797fe3848429b64812fb7145d11253fc88 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 13:13:38 +0200 Subject: handle image scaling with image-transforms-p (when emacs >= 27.1) --- lisp/mastodon-toot.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6c08859..1afad8a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -477,12 +477,15 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (defun mastodon-toot--format-attachments () (or (let ((counter 0) - (image-options (when (image-type-available-p 'imagemagick) + (image-options (when (or (image-type-available-p 'imagemagick) + (image-transforms-p)) `(:height ,mastodon-media--attachment-height)))) (mapcan (lambda (attachment) (let* ((data (cdr (assoc :contents attachment))) (image (apply #'create-image data - (when image-options 'imagemagick) + (if (version< emacs-version "27.1") + (when image-options 'imagemagick) + nil) ; inbuilt scaling in 27.1 t image-options)) (type (cdr (assoc :content-type attachment))) (description (cdr (assoc :description attachment)))) @@ -491,8 +494,8 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." image (format " \"%s\" (%s)" description type)))) mastodon-toot--media-attachments)) - (list "None")) - ) + (list "None"))) + ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () @@ -596,7 +599,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (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 -- cgit v1.2.3 From 13064aa96e0152da0dfbe93e5349aaef61646731 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 14:51:32 +0200 Subject: revert "private" visibility = "followers only" in toot draft --- lisp/mastodon-toot.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1afad8a..5b7d537 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -602,9 +602,13 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (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))) + (list 'display + (format "Visibility: %s" + (if (equal + mastodon-toot--visibility + "private") + "followers-only" + mastodon-toot--visibility)))) (add-text-properties (car nsfw-region) (cdr nsfw-region) (list 'display (if mastodon-toot--content-nsfw (if mastodon-toot--media-attachments -- cgit v1.2.3 From ff76a83fc57817731c407da3cf8a6ef6a71434c5 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 14:59:03 +0200 Subject: revert mastodon-http changes - we will keep my old implementation of attachment uploading, as it already works with the media_ids[] of the API. --- lisp/mastodon-http.el | 58 ++++++++------------------------------------------- 1 file changed, 9 insertions(+), 49 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 85ee588..052218c 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -90,64 +90,24 @@ Message status and JSON error from RESPONSE if unsuccessful." (let ((json-response (mastodon-http--process-json))) (message "Error %s: %s" status (cdr (assoc 'error json-response)))))))) -(defun mastodon-http--encode-multipart-form-data (boundary fields) - "Encode FIELDS suitable to post as multipart/form-data. - -It uses BOUNDARY as the boundary for the values. -FIELDS should be a list of either 2-element (name contents) lists -or 4-element list of (name file-name content-type contents)." - (with-temp-buffer - (dolist (field fields) - (insert "--" boundary "\r\n") - (if (= (length field) 2) - ;; a 2-element list is a simple name=value item: - (insert "Content-Disposition: form-data; name=\"" - (url-hexify-string (car field)) - "\"\r\n" - "\r\n" - (cadr field) "\r\n") - ;; a 4-element list ist a file to be attached: - (insert "Content-Disposition: form-data; name=\"" - (url-hexify-string (car field)) - "\"; filename=\"" - (url-hexify-string (cadr field)) - "\"\r\n" - "Content-type: " (caddr field) "\r\n" - "\r\n" - (cadddr field) "\r\n"))) - ;; Finally add the terminating boundary and another empty line: - (insert "--" boundary "--\r\n" - "\r\n") - (string-to-unibyte (buffer-string)))) - (defun mastodon-http--post (url args headers &optional unauthenticed-p) "POST synchronously to URL with ARGS and HEADERS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (let* ((url-request-method "POST") - (boundary (md5 (format "b%s-%s-%s-%s" - (random 1000000000) (random 1000000000) - (random 1000000000) (random 1000000000)))) - (needs-multi-form (> (apply #'max (mapcar #'length args)) 2)) - (url-request-data - (when args - (if needs-multi-form - (mastodon-http--encode-multipart-form-data boundary args) - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cadr arg)))) - args - "&")))) + (let ((url-request-method "POST") + (url-request-data + (when args + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cdr arg)))) + args + "&"))) (url-request-extra-headers (append - (when needs-multi-form - `(("Content-Type" . - ,(concat "multipart/form-data; boundary=\"" boundary "\"")))) (unless unauthenticed-p `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) headers))) - (message "Posting to %s with %d bytes of request data and headers %s" url (length url-request-data) url-request-extra-headers) (with-temp-buffer (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) -- cgit v1.2.3 From 6b2207251c9b44cd47cc03c8f9a68970e123c5d6 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:00:21 +0200 Subject: merge hdurers attachment upload and my own replace hdurer's mastodon-toot--post-media and my mastodon-toot--add-media-attachment with hdurer's mastodon-toot--attach-media (which holds the data in the toot draft) and my mastodon-toot--upload-media-attachments (which actually uploads them) --- lisp/mastodon-toot.el | 48 +++++++++++++++++++++--------------------------- 1 file changed, 21 insertions(+), 27 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5b7d537..7407a7c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -89,7 +89,7 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (make-variable-buffer-local 'mastodon-toot--visibility) (defvar mastodon-toot--media-attachments nil - "A flag indicating if the toot being composed has media attachments.") + "A list of the media attachments of the toot being composed .") (make-variable-buffer-local 'mastodon-toot--media-attachments) (defvar mastodon-toot--media-attachment-ids nil @@ -153,14 +153,6 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response callback)))) -(defun mastodon-toot--post-media (contents content-type description) - (let* ((url (mastodon-http--api "media")) - (response (mastodon-http--post - url - (list (list "description" description) - (list "file" "file" content-type contents))))) - response)) - (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." (interactive) @@ -314,19 +306,6 @@ 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: " - mastodon-toot--default-media-directory)) - (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. @@ -357,11 +336,11 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (message "Looks like your uploads are not yet ready...") (if empty-toot-p (message "Empty toot. Cowardly refusing to post this.") - (let ((response (mastodon-http--post endpoint args nil))) + (let ((response (mastodon-http--post endpoint args nil))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) - (message "Toot toot!")))))))) + (message "Toot toot!"))))))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -446,14 +425,16 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (mastodon-toot--update-status-fields)) (defun mastodon-toot--clear-all-attachments () - "" + "Remove all attachments from a toot draft." (interactive) (setq mastodon-toot--media-attachments nil) (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields)) (defun mastodon-toot--attach-media (file content-type description) - "" + "Prompt for a attachment FILE of CONTENT-TYPE with DESCRIPTION. +A preview is displayed in the toot create buffer, and the file +will be uploaded and attached to the toot upon sending." (interactive "fFilename: \nsContent type: \nsDescription: ") (when (>= (length mastodon-toot--media-attachments) 4) ;; Only a max. of 4 attachments are allowed, so pop the oldest one. @@ -462,9 +443,22 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (nconc mastodon-toot--media-attachments `(((:contents . ,(mastodon-http--read-file-as-string file)) (:content-type . ,content-type) - (:description . ,description))))) + (:description . ,description) + (:filename . ,(file-name-nondirectory file)))))) (mastodon-toot--refresh-attachments-display)) +(defun mastodon-toot--upload-media-attachments () + "Actually upload the attachment files using `mastodon-http--post-media-attachment'. +It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." + (interactive) + (mapcar (lambda (attachment) + (let* ((filename (cdr (assoc :filename attachment))) + (caption (cdr (assoc :description attachment))) + (url (concat mastodon-instance-url "/api/v1/media"))) + (message "Uploading %s..." filename) + (mastodon-http--post-media-attachment url filename caption))) + mastodon-toot--media-attachments)) + (defun mastodon-toot--refresh-attachments-display () (let ((inhibit-read-only t) (attachments-region (mastodon-tl--find-property-range -- cgit v1.2.3 From e93adbde20d8f8f0d0e3810ebc3f1890d362dae4 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:10:13 +0200 Subject: rever auth / client changes too --- lisp/mastodon-auth.el | 18 +++++++++--------- lisp/mastodon-client.el | 8 ++++---- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index cd74ef8..6729e81 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -98,15 +98,15 @@ Reads and/or stores secrets in `MASTODON-AUTH-SOURCE-FILE'." (prog1 (mastodon-http--post (concat mastodon-instance-url "/oauth/token") - `(("client_id" ,(plist-get (mastodon-client) :client_id)) - ("client_secret" ,(plist-get (mastodon-client) :client_secret)) - ("grant_type" "password") - ("username" ,(plist-get credentials-plist :user)) - ("password" ,(let ((secret (plist-get credentials-plist :secret))) - (if (functionp secret) - (funcall secret) - secret))) - ("scope" "read write follow")) + `(("client_id" . ,(plist-get (mastodon-client) :client_id)) + ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) + ("grant_type" . "password") + ("username" . ,(plist-get credentials-plist :user)) + ("password" . ,(let ((secret (plist-get credentials-plist :secret))) + (if (functionp secret) + (funcall secret) + secret))) + ("scope" . "read write follow")) nil :unauthenticated) (when (functionp (plist-get credentials-plist :save-function)) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index 4503d6d..bdfbca9 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -49,10 +49,10 @@ "POST client to Mastodon." (mastodon-http--post (mastodon-http--api "apps") - '(("client_name" "mastodon.el") - ("redirect_uris" "urn:ietf:wg:oauth:2.0:oob") - ("scopes" "read write follow") - ("website" "https://github.com/jdenen/mastodon.el")) + '(("client_name" . "mastodon.el") + ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") + ("scopes" . "read write follow") + ("website" . "https://github.com/jdenen/mastodon.el")) nil :unauthenticated)) -- cgit v1.2.3 From 9564994df6ade898831789200d3ac133ba9de07e Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:19:20 +0200 Subject: flycheck toot.el --- lisp/mastodon-toot.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7407a7c..a040efc 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -50,6 +50,7 @@ (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-http--post-media-attachment "mastodon-http") +(autoload 'mastodon-http--read-file-as-string "mastodon-http") (autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") @@ -331,9 +332,9 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) (args (append args-no-media args-media))) - (if (and mastodon-toot--media-attachments + (when (and mastodon-toot--media-attachments (equal mastodon-toot--media-attachment-ids nil)) - (message "Looks like your uploads are not yet ready...") + (message "Looks like your uploads are not yet ready...")) (if empty-toot-p (message "Empty toot. Cowardly refusing to post this.") (let ((response (mastodon-http--post endpoint args nil))) @@ -448,7 +449,7 @@ will be uploaded and attached to the toot upon sending." (mastodon-toot--refresh-attachments-display)) (defun mastodon-toot--upload-media-attachments () - "Actually upload the attachment files using `mastodon-http--post-media-attachment'. + "Actually upload attachments using `mastodon-http--post-media-attachment'. It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." (interactive) (mapcar (lambda (attachment) @@ -460,6 +461,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t mastodon-toot--media-attachments)) (defun mastodon-toot--refresh-attachments-display () + "Display attachment previews in toot draft buffer." (let ((inhibit-read-only t) (attachments-region (mastodon-tl--find-property-range 'toot-attachments (point-min))) @@ -470,6 +472,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (list 'display (or (nth i display-specs) "")))))) (defun mastodon-toot--format-attachments () + "Format the attachment previews in toot draft buffer." (or (let ((counter 0) (image-options (when (or (image-type-available-p 'imagemagick) (image-transforms-p)) -- cgit v1.2.3 From 46a2f82edf61b370aa5e8432a4f3f17614293e25 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:27:22 +0200 Subject: disambiguate media--attachment-height and preview-max-height --- lisp/mastodon-media.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index fd2a6b7..28fbd19 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -47,12 +47,12 @@ :type 'integer) (defcustom mastodon-media--preview-max-height 250 - "Max height of any media attachment preview to be shown." + "Max height of any media attachment preview to be shown in timelines." :group 'mastodon-media :type 'integer) -(defcustom mastodon-media--attachment-height 100 - "Height of the attached images preview." +(defcustom mastodon-media--attachment-height 80 + "Height of the attached images preview in the toot draft buffer." :group 'mastodon-media :type 'integer) -- cgit v1.2.3 From 1f25073c25ae6c8e44c72028fbf873f24544b8e9 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:27:51 +0200 Subject: remove my old attachment display --- lisp/mastodon-toot.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a040efc..8dfe00b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -557,9 +557,6 @@ on the status of NSFW, content warning flags, media attachments, etc." (propertize "Visibility" 'toot-post-visibility t) " ⋅ " - (propertize "Attachment" - 'toot-attachment t) - " ⋅ " (propertize "CW" 'toot-post-cw-flag t) " " -- cgit v1.2.3 From 1ccf12b34c14c3cc5c58ccf214865b3af1719d54 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 17:13:47 +0200 Subject: binding to upload media, and check uploads up before posting toot --- lisp/mastodon-toot.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8dfe00b..86cecfd 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -118,6 +118,7 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility) (when (require 'emojify nil :noerror) (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) + (define-key map (kbd "C-c C-u") #'mastodon-toot--upload-attached-media) (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) map) @@ -332,16 +333,16 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) (args (append args-no-media args-media))) - (when (and mastodon-toot--media-attachments + (if (and mastodon-toot--media-attachments (equal mastodon-toot--media-attachment-ids nil)) - (message "Looks like your uploads are not yet ready...")) + (message "Looks like your uploads are not up: C-c C-u to upload...") (if empty-toot-p (message "Empty toot. Cowardly refusing to post this.") (let ((response (mastodon-http--post endpoint args nil))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) - (message "Toot toot!"))))))) + (message "Toot toot!")))))))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -448,7 +449,7 @@ will be uploaded and attached to the toot upon sending." (:filename . ,(file-name-nondirectory file)))))) (mastodon-toot--refresh-attachments-display)) -(defun mastodon-toot--upload-media-attachments () +(defun mastodon-toot--upload-attached-media () "Actually upload attachments using `mastodon-http--post-media-attachment'. It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." (interactive) -- cgit v1.2.3 From 765da49f980673863b09a814630646c8044c96ad Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 17:14:13 +0200 Subject: FIX the filename we send to post-media-attachement - it needs to be with full path of course! --- lisp/mastodon-toot.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 86cecfd..c00e4bf 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -446,7 +446,7 @@ will be uploaded and attached to the toot upon sending." `(((:contents . ,(mastodon-http--read-file-as-string file)) (:content-type . ,content-type) (:description . ,description) - (:filename . ,(file-name-nondirectory file)))))) + (:filename . ,file))))) (mastodon-toot--refresh-attachments-display)) (defun mastodon-toot--upload-attached-media () @@ -457,9 +457,9 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (let* ((filename (cdr (assoc :filename attachment))) (caption (cdr (assoc :description attachment))) (url (concat mastodon-instance-url "/api/v1/media"))) - (message "Uploading %s..." filename) + (message "Uploading %s..." (file-name-nondirectory filename)) (mastodon-http--post-media-attachment url filename caption))) - mastodon-toot--media-attachments)) + mastodon-toot--media-attachments)) (defun mastodon-toot--refresh-attachments-display () "Display attachment previews in toot draft buffer." -- cgit v1.2.3 From e0cabe76d4107610c44b1bc6c570840ebadb5467 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 18:47:52 +0200 Subject: docstrings --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c00e4bf..ec5a8ac 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -462,7 +462,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t mastodon-toot--media-attachments)) (defun mastodon-toot--refresh-attachments-display () - "Display attachment previews in toot draft buffer." + "Update the display attachment previews in toot draft buffer." (let ((inhibit-read-only t) (attachments-region (mastodon-tl--find-property-range 'toot-attachments (point-min))) @@ -473,7 +473,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (list 'display (or (nth i display-specs) "")))))) (defun mastodon-toot--format-attachments () - "Format the attachment previews in toot draft buffer." + "Format the attachment previews for display in toot draft buffer." (or (let ((counter 0) (image-options (when (or (image-type-available-p 'imagemagick) (image-transforms-p)) -- cgit v1.2.3