Merge branch 'develop'

8 files changed, 99 insertions, 85 deletions

diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index aef8975..49c94a4 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -338,18 +338,27 @@ The upload is asynchronous. On succeeding,
 item uploaded, and `mastodon-toot--update-status-fields' is run."
   (let* ((file (file-name-nondirectory filename))
          (request-backend 'curl)
+         (desc `(("description" . ,caption)))
          (cb (cl-function
               (lambda (&key data &allow-other-keys)
                 (when data
-                  (push (alist-get 'id data)
-                        mastodon-toot--media-attachment-ids) ; add ID to list
-                  (message (alist-get 'id data))
-                  (message "Uploading %s... (done)" file)
-                  (mastodon-toot--update-status-fields))))))
+                  (let* ((id (alist-get 'id data)))
+                    ;; update ids:
+                    (push id mastodon-toot--media-attachment-ids)
+                    ;; pleroma, PUT the description:
+                    ;; this is how the mangane akkoma web client does it
+                    ;; and it seems easier than the other options!
+                    (when (and caption
+                               (not (equal caption (alist-get 'description data))))
+                      (let ((url (mastodon-http--api (format "media/%s" id))))
+                        ;; (message "PUTting image description")
+                        (mastodon-http--put url desc)))
+                    (message "Uploading %s... (done)" file)
+                    (mastodon-toot--update-status-fields)))))))
     (request
       url
       :type "POST"
-      :params `(("description" . ,caption))
+      :params desc
       :files `(("file" . (,file :file ,filename
                                 :mime-type "multipart/form-data")))
       :parser 'json-read
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index ff40633..bc902aa 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -34,6 +34,7 @@
 
 ;;; Code:
 (require 'url-cache)
+(require 'mm-decode)
 
 (autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl")
 
@@ -177,44 +178,33 @@ with the image."
               (set-marker marker nil)))
           (kill-buffer url-buffer))))))
 
-(defun mastodon-media--process-full-sized-image-response
-    (status-plist image-options url)
+(defun mastodon-media--process-full-sized-image-response (status-plist url)
   ;; FIXME: refactor this with but not into
   ;; `mastodon-media--process-image-response'.
   "Callback function processing the `url-retrieve' response for URL.
 URL is a full-sized image URL attached to a timeline image.
-STATUS-PLIST is a plist of status events as per `url-retrieve'.
-IMAGE-OPTIONS are the precomputed options to apply to the image."
-  (let ((url-buffer (current-buffer))
-        (is-error-response-p (eq :error (car status-plist))))
-    (let* ((data (unless is-error-response-p
-                   (goto-char (point-min))
-                   (search-forward "\n\n")
-                   (buffer-substring (point) (point-max))))
-           (image (when data
-                    (apply #'create-image data
-                           (if (version< emacs-version "27.1")
-                               (when image-options 'imagemagick)
-                             nil) ; inbuilt scaling in 27.1
-                           t nil))))
-      (when mastodon-media--enable-image-caching
-        (unless (url-is-cached url) ;; cache if not already cached
-          (url-store-in-cache url-buffer)))
+STATUS-PLIST is a plist of status events as per `url-retrieve'."
+  (if-let (error-response (plist-get status-plist :error))
+      (message "error in loading image: %S" error-response)
+    (when mastodon-media--enable-image-caching
+      (unless (url-is-cached url) ;; cache if not already cached
+        (url-store-in-cache)))
+    ;; thanks to rahguzar for this idea:
+    ;; https://codeberg.org/martianh/mastodon.el/issues/540
+    (let* ((handle (mm-dissect-buffer t))
+           (image (mm-get-image handle))
+           (str (image-property image :data)))
+      ;; (setf (image-property image :max-width)
+      ;; (window-pixel-width))
       (with-current-buffer (get-buffer-create "*masto-image*")
         (let ((inhibit-read-only t))
           (erase-buffer)
-          (insert " ")
-          (when image
-            (add-text-properties (point-min) (point-max)
-                                 `( display ,image
-                                    keymap ,(if (boundp 'shr-image-map)
-                                                shr-image-map
-                                              shr-map)
-                                    image-url ,url
-                                    shr-url ,url))
-            (image-mode)
-            (goto-char (point-min))
-            (switch-to-buffer-other-window (current-buffer))))))))
+          (insert-image image str)
+          (special-mode) ; prevent image-mode loop bug
+          (image-mode)
+          (goto-char (point-min))
+          (switch-to-buffer-other-window (current-buffer))
+          (image-transform-fit-both))))))
 
 (defun mastodon-media--load-image-from-url (url media-type start region-length)
   "Take a URL and MEDIA-TYPE and load the image asynchronously.
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index f7276d6..0e367c9 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -177,10 +177,11 @@ Status notifications are given when
     (switch-to-buffer (current-buffer))
     (insert str)
     (goto-char (point-min))
-    (while (setq prop (text-property-search-forward 'face 'shr-text t))
-      (add-text-properties (prop-match-beginning prop)
-                           (prop-match-end prop)
-                           '(face (font-lock-comment-face shr-text))))
+    (let (prop)
+      (while (setq prop (text-property-search-forward 'face 'shr-text t))
+        (add-text-properties (prop-match-beginning prop)
+                             (prop-match-end prop)
+                             '(face (font-lock-comment-face shr-text)))))
     (buffer-string)))
 
 (defun mastodon-notifications--format-note (note type)
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 5929f1c..7b5a700 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -131,7 +131,7 @@ is updated on entering mastodon mode and on toggle any setting it
 contains")
 
 (define-minor-mode mastodon-profile-update-mode
-  "Minor mode to update Mastodon user profile."
+  "Minor mode to update user profile."
   :group 'mastodon-profile
   :keymap mastodon-profile-update-mode-map
   :global nil)
@@ -524,7 +524,7 @@ FIELDS means provide a fields vector fetched by other means."
 (defun mastodon-profile--fields-insert (fields)
   "Format and insert field pairs (a.k.a profile metadata) in FIELDS."
   (let* ((car-fields (mapcar #'car fields))
-         (left-width (cl-reduce #'max (mapcar #'length car-fields))))
+         (left-width (apply #'max (mapcar #'length car-fields))))
     (mapconcat (lambda (field)
                  (mastodon-tl--render-text
                   (concat
@@ -790,7 +790,7 @@ If the handle does not match a search return then retun NIL."
       (elt matching-account 0))))
 
 (defun mastodon-profile--account-from-id (user-id)
-  "Request an account object relating to a USER-ID from Mastodon."
+  "Request an account object relating to a USER-ID."
   (mastodon-http--get-json
    (mastodon-http--api (format "accounts/%s" user-id))))
 
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 4034ebf..4c0375d 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -216,7 +216,7 @@ respects the user's `browse-url' settings."
 ;;; VARIABLES
 
 (defvar-local mastodon-tl--buffer-spec nil
-  "A unique identifier and functions for each Mastodon buffer.")
+  "A unique identifier and functions for each mastodon buffer.")
 
 (defvar-local mastodon-tl--update-point nil
   "When updating a mastodon buffer this is where new toots will be inserted.
@@ -1149,11 +1149,10 @@ SENSITIVE is a flag from the item's JSON data."
               (goto-char (point-min))
               (zlib-decompress-region
                (goto-char (search-forward "\n\n")) (point-max))
-              (mastodon-media--process-full-sized-image-response
-               nil nil url))
+              (mastodon-media--process-full-sized-image-response nil url))
           ;; else fetch and load:
           (url-retrieve url #'mastodon-media--process-full-sized-image-response
-                        (list nil url)))))))
+                        `(,url)))))))
 
 
 ;; POLLS
@@ -1366,7 +1365,11 @@ in which case play first video or gif from current toot."
         (if (mastodon-tl--media-video-p type)
             (progn
               (message "'q' to kill mpv.")
-              (mpv-start "--loop" url))
+              (condition-case x
+                  (mpv-start "--loop" url)
+                (void-function
+                 (message "Looks like mpv.el not installed. Error: %s"
+                          (error-message-string x)))))
           (message "no moving image here?"))
       (message "no moving image here?"))))
 
@@ -1716,7 +1719,9 @@ call this function after it is set or use something else."
           ((mastodon-tl--endpoint-str-= "instance")
            'instance-description)
           ((string= "*mastodon-toot-edits*" buffer-name)
-           'toot-edits))))
+           'toot-edits)
+          ((string= "*masto-image*" (buffer-name))
+           'mastodon-image))))
 
 (defun mastodon-tl--buffer-type-eq (type)
   "Return t if current buffer type is equal to symbol TYPE."
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 82ad03b..a48d5d9 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -549,16 +549,18 @@ base toot."
   "Translate text of toot at point.
 Uses `lingva.el'."
   (interactive)
-  (if (not (require 'lingva nil :no-error))
-      (message "Looks like you need to install lingva.el first.")
-    (if mastodon-tl--buffer-spec
-        (if-let ((toot (mastodon-tl--property 'item-json)))
-            (lingva-translate nil
-                              (mastodon-tl--content toot)
-                              (when mastodon-tl--enable-proportional-fonts
-                                t))
-          (message "No toot to translate?"))
-      (message "No mastodon buffer?"))))
+  (if mastodon-tl--buffer-spec
+      (if-let ((toot (mastodon-tl--property 'item-json)))
+          (condition-case x
+              (lingva-translate nil
+                                (mastodon-tl--content toot)
+                                (when mastodon-tl--enable-proportional-fonts
+                                  t))
+            (void-function
+             (message "Looks like you need to install lingva.el. Error: %s"
+                      (error-message-string x))))
+        (message "No toot to translate?"))
+    (message "No mastodon buffer?")))
 
 (defun mastodon-toot--own-toot-p (toot)
   "Check if TOOT is user's own, for deleting, editing, or pinning it."
@@ -697,7 +699,7 @@ CANCEL means the toot was not sent, so we save the toot text as a draft."
     (mastodon-toot--restore-previous-window-config prev-window-config)))
 
 (defun mastodon-toot--cancel ()
-  "Kill new-toot buffer/window. Does not POST content to Mastodon.
+  "Kill new-toot buffer/window. Does not POST content.
 If toot is not empty, prompt to save text as a draft."
   (interactive)
   (if (mastodon-toot--empty-p)
@@ -838,7 +840,7 @@ to `emojify-user-emojis', and the emoji data is updated."
 ;;; SEND TOOT FUNCTION
 
 (defun mastodon-toot--send ()
-  "POST contents of new-toot buffer to Mastodon instance and kill buffer.
+  "POST contents of new-toot buffer to fediverse instance and kill buffer.
 If media items have been attached and uploaded with
 `mastodon-toot--attach-media', they are attached to the toot.
 If `mastodon-toot--edit-item-id' is non-nil, PUT contents to
@@ -1374,7 +1376,7 @@ LENGTH is the maximum character length allowed for a poll option."
                            collect (read-string
                                     (format "Poll option [%s/%s] [max %s chars]: "
                                             x count length))))
-         (longest (cl-reduce #'max (mapcar #'length choices))))
+         (longest (apply #'max (mapcar #'length choices))))
     (if (> longest length)
         (progn
           (message "looks like you went over the max length. Try again.")
@@ -1843,7 +1845,15 @@ a draft into the buffer.
 EDIT means we are editing an existing toot, not composing a new one."
   (let* ((buffer-name (if edit "*edit toot*" "*new toot*"))
          (buffer-exists (get-buffer buffer-name))
-         (buffer (or buffer-exists (get-buffer-create buffer-name)))
+         (buffer (if (not buffer-exists)
+                     (get-buffer-create buffer-name)
+                   ;; if a user hits reply while a compose buffer is already
+                   ;; open, we really ought to wipe it all and start over.
+                   (switch-to-buffer-other-window buffer-exists)
+                   (if (not (y-or-n-p "Overwrite existing compose buffer?"))
+                       (user-error "Aborting")
+                     (kill-buffer-and-window)
+                     (get-buffer-create buffer-name))))
          (inhibit-read-only t)
          (reply-text (alist-get 'content
                                 (or (alist-get 'reblog reply-json)
@@ -1858,19 +1868,18 @@ EDIT means we are editing an existing toot, not composing a new one."
               ;; use toot visibility setting from the server:
               (mastodon-profile--get-source-pref 'privacy)
               "public")) ; fallback
-    (unless buffer-exists
-      (if mastodon-toot-display-orig-in-reply-buffer
-          (progn
-            (mastodon-toot--display-docs-and-status-fields reply-text)
-            (mastodon-toot--fill-reply-in-compose))
-        (mastodon-toot--display-docs-and-status-fields))
-      ;; `reply-to-user' (alone) is also used by `mastodon-tl--dm-user', so
-      ;; perhaps we should not always call --setup-as-reply, or make its
-      ;; workings conditional on reply-to-id. currently it only checks for
-      ;; reply-to-user.
-      (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json
-                                     ;; only initial-text if reply (not edit):
-                                     (when reply-json initial-text)))
+    (if mastodon-toot-display-orig-in-reply-buffer
+        (progn
+          (mastodon-toot--display-docs-and-status-fields reply-text)
+          (mastodon-toot--fill-reply-in-compose))
+      (mastodon-toot--display-docs-and-status-fields))
+    ;; `reply-to-user' (alone) is also used by `mastodon-tl--dm-user', so
+    ;; perhaps we should not always call --setup-as-reply, or make its
+    ;; workings conditional on reply-to-id. currently it only checks for
+    ;; reply-to-user.
+    (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json
+                                   ;; only initial-text if reply (not edit):
+                                   (when reply-json initial-text))
     (unless mastodon-toot--max-toot-chars
       ;; no need to fetch from `mastodon-profile-account-settings' as
       ;; `mastodon-toot--max-toot-chars' is set when we set it
@@ -1944,7 +1953,7 @@ Only text that is not one of these faces will be spell-checked."
 
 
 (define-minor-mode mastodon-toot-mode
-  "Minor mode to capture Mastodon toots."
+  "Minor mode for composing toots."
   :keymap mastodon-toot-mode-map
   :global nil)
 
diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el
index d0f310b..e9e89c0 100644
--- a/lisp/mastodon-views.el
+++ b/lisp/mastodon-views.el
@@ -852,7 +852,7 @@ MISSKEY means the instance is a Misskey or derived server."
 IND is the optional indentation level to print at."
   (let* ((cars (mapcar (lambda (x) (symbol-name (car x)))
                        response))
-         (pad (1+ (cl-reduce #'max (mapcar #'length cars)))))
+         (pad (1+ (apply #'max (mapcar #'length cars)))))
     (while response
       (let ((el (pop response)))
         (cond
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 4667450..70ab73c 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -110,8 +110,8 @@
   :group 'external)
 
 (defcustom mastodon-instance-url "https://mastodon.social"
-  "Base URL for the Mastodon instance you want to be active.
-For example, if your mastodon username is
+  "Base URL for the fediverse instance you want to be active.
+For example, if your username is
 \"example_user@social.instance.org\", and you want this account
 to be active, the value of this variable should be
 \"https://social.instance.org\".
@@ -125,7 +125,7 @@ changes to take effect."
 
 (defcustom mastodon-active-user nil
   "Username of the active user.
-For example, if your mastodon username is
+For example, if your username is
 \"example_user@social.instance.org\", and you want this account
 to be active, the value of this variable should be
 \"example_user\".
@@ -275,7 +275,7 @@ See `mastodon-toot-display-orig-in-reply-buffer'.")
 
 ;;;###autoload
 (defun mastodon ()
-  "Connect Mastodon client to `mastodon-instance-url' instance."
+  "Connect client to `mastodon-instance-url' instance."
   (interactive)
   (let* ((tls (list "home"
                     "local"
@@ -295,7 +295,7 @@ See `mastodon-toot-display-orig-in-reply-buffer'.")
     (if buffer
         (pop-to-buffer buffer '(display-buffer-same-window))
       (mastodon-tl--get-home-timeline)
-      (message "Loading Mastodon account %s on %s..."
+      (message "Loading fediverse account %s on %s..."
                (mastodon-auth--user-acct)
                mastodon-instance-url))))
 
@@ -477,7 +477,7 @@ Calls `mastodon-tl--get-buffer-type', which see."
 (add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun)
 
 (define-derived-mode mastodon-mode special-mode "Mastodon"
-  "Major mode for Mastodon, the federated microblogging network."
+  "Major mode for fediverse services using the Mastodon API."
   (read-only-mode 1))
 
 (provide 'mastodon)