Merge branch 'img-previews' into develop

1 files changed, 111 insertions, 48 deletions

diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index a8b121b..ec5a8ac 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"))
@@ -49,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")
 
@@ -88,7 +90,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
@@ -103,6 +105,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 +116,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'.")
 
@@ -300,19 +308,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.
 
@@ -340,10 +335,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)
@@ -414,6 +409,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 +426,74 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
                "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 ()
@@ -483,6 +547,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)
@@ -490,9 +558,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)
        " "
@@ -515,24 +580,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
@@ -540,18 +604,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.
@@ -561,12 +622,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