aboutsummaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/mastodon-media.el7
-rw-r--r--lisp/mastodon-toot.el159
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