diff options
| -rw-r--r-- | lisp/mastodon-media.el | 7 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 159 |
2 files changed, 117 insertions, 49 deletions
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index b58eab6..a401de5 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -47,7 +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 80 + "Height of the attached images preview in the toot draft buffer." :group 'mastodon-media :type 'integer) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index f3cbfb0..4215dec 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")) @@ -52,6 +53,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") (autoload 'mastodon-search--search-accounts-query "mastodon-search") @@ -98,7 +100,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 @@ -113,6 +115,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) @@ -120,9 +126,11 @@ 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-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) "Keymap for `mastodon-toot'.") @@ -310,19 +318,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. @@ -350,10 +345,10 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (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...") + (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))) + (let ((response (mastodon-http--post endpoint args nil))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) @@ -464,6 +459,7 @@ The prefix string is tested against both user handles and display names." (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 () @@ -480,6 +476,74 @@ The prefix string is tested against both user handles and display names." "public"))) (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. + (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) + (:filename . ,file))))) + (mastodon-toot--refresh-attachments-display)) + +(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) + (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..." (file-name-nondirectory filename)) + (mastodon-http--post-media-attachment url filename caption))) + mastodon-toot--media-attachments)) + +(defun mastodon-toot--refresh-attachments-display () + "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))) + (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 () + "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)) + `(:height ,mastodon-media--attachment-height)))) + (mapcan (lambda (attachment) + (let* ((data (cdr (assoc :contents attachment))) + (image (apply #'create-image data + (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)))) + (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 () @@ -533,6 +597,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) @@ -540,9 +608,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) " " @@ -565,24 +630,23 @@ 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) + (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" + (- (point-max) (cdr header-region))))) + (add-text-properties (car visibility-region) (cdr visibility-region) (list 'display (format "Visibility: %s" (if (equal @@ -590,18 +654,15 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." "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)))) + (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. @@ -611,6 +672,7 @@ 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)) @@ -620,6 +682,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (company-mode-on)) (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 |