Merge branch 'develop' into capf-completion

8 files changed, 124 insertions, 80 deletions

diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index 69a571d..d677e57 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -132,15 +132,15 @@ Used for API form data parameters that take an array."
   (cl-loop for x in array
            collect (cons param-str x)))
 
-(defun mastodon-http--post (url &optional args headers unauthenticated-p)
-  "POST synchronously to URL, optionally with ARGS and HEADERS.
+(defun mastodon-http--post (url &optional params headers unauthenticated-p)
+  "POST synchronously to URL, optionally with PARAMS and HEADERS.
 
 Authorization header is included by default unless UNAUTHENTICATED-P is non-nil."
   (mastodon-http--authorized-request
    "POST"
    (let ((url-request-data
-          (when args
-            (mastodon-http--build-params-string args)))
+          (when params
+            (mastodon-http--build-params-string params)))
          (url-request-extra-headers
           (append url-request-extra-headers ; auth set in macro
                   ;; pleroma compat:
@@ -237,11 +237,12 @@ PARAMS is an alist of any extra parameters to send with the request."
 
 (defun mastodon-http--put (url &optional params headers)
   "Make PUT request to URL.
-PARAMS is an alist of any extra parameters to send with the request."
+PARAMS is an alist of any extra parameters to send with the request.
+HEADERS is an alist of any extra headers to send with the request."
   (mastodon-http--authorized-request
    "PUT"
    (let ((url-request-data
-          (when args (mastodon-http--build-params-string params)))
+          (when params (mastodon-http--build-params-string params)))
          (url-request-extra-headers
           (append url-request-extra-headers ; auth set in macro
                   ;; pleroma compat:
@@ -288,35 +289,36 @@ PARAMS is an alist of any extra parameters to send with the request."
      "GET"
      (url-retrieve url callback cbargs))))
 
-(defun mastodon-http--get-response-async (url &optional params callback &rest args)
-  "Make GET request to URL. Call CALLBACK with http response and ARGS."
+(defun mastodon-http--get-response-async (url &optional params callback &rest cbargs)
+  "Make GET request to URL. Call CALLBACK with http response and CBARGS.
+PARAMS is an alist of any extra parameters to send with the request."
   (mastodon-http--get-async
    url
    params
    (lambda (status)
      (when status ;; only when we actually get sth?
-       (apply callback (mastodon-http--process-response) args)))))
+       (apply callback (mastodon-http--process-response) cbargs)))))
 
-(defun mastodon-http--get-json-async (url &optional params callback &rest args)
-  "Make GET request to URL. Call CALLBACK with json-list and ARGS.
+(defun mastodon-http--get-json-async (url &optional params callback &rest cbargs)
+  "Make GET request to URL. Call CALLBACK with json-list and CBARGS.
 PARAMS is an alist of any extra parameters to send with the request."
   (mastodon-http--get-async
    url
    params
    (lambda (status)
      (when status ;; only when we actually get sth?
-       (apply callback (mastodon-http--process-json) args)))))
+       (apply callback (mastodon-http--process-json) cbargs)))))
 
-(defun mastodon-http--post-async (url args headers &optional callback &rest cbargs)
-  "POST asynchronously to URL with ARGS and HEADERS.
+(defun mastodon-http--post-async (url params headers &optional callback &rest cbargs)
+  "POST asynchronously to URL with PARAMS and HEADERS.
 Then run function CALLBACK with arguements CBARGS.
 Authorization header is included by default unless UNAUTHENTICED-P is non-nil."
   (mastodon-http--authorized-request
    "POST"
    (let ((request-timeout 5)
          (url-request-data
-          (when args
-            (mastodon-http--build-params-string args))))
+          (when params
+            (mastodon-http--build-params-string params))))
      (with-temp-buffer
        (url-retrieve url callback cbargs)))))
 
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 9715a6c..c783130 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -35,6 +35,8 @@
 ;;; Code:
 (require 'url-cache)
 
+(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl")
+
 (defvar url-show-status)
 
 (defvar mastodon-tl--shr-image-map-replacement)
@@ -306,34 +308,23 @@ Replace them with the referenced image."
                                  t image-options))
      " ")))
 
-(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type caption)
+(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url
+                                                           type caption)
   "Return the string to be written that renders the image at MEDIA-URL.
 FULL-REMOTE-URL is used for `shr-browse-image'.
 TYPE is the attachment's type field on the server.
 CAPTION is the image caption if provided."
   (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")
-        (help-echo (if caption
-                       (concat help-echo-base
-                               "\n\""
-                               caption "\"")
-                     help-echo-base)))
+         (help-echo (if caption
+                        (concat help-echo-base
+                                "\n\""
+                                caption "\"")
+                      help-echo-base)))
     (concat
-     (propertize "[img]"
-                 'media-url media-url
-                 'media-state 'needs-loading
-                 'media-type 'media-link
-                 'mastodon-media-type type
-                 'display (create-image mastodon-media--generic-broken-image-data nil t)
-                 'mouse-face 'highlight
-                 'mastodon-tab-stop 'image ; for do-link-action-at-point
-                 'image-url full-remote-url ; for shr-browse-image
-                 'keymap mastodon-tl--shr-image-map-replacement
-                 'help-echo (if (or (string= type "image")
-                                    (string= type nil)
-                                    (string= type "unknown")) ;handle borked images
-                                help-echo
-                              (concat help-echo "\nC-RET: play " type " with mpv")))
-                 " ")))
+     (mastodon-tl--propertize-img-str-or-url
+      "[img]" media-url full-remote-url type help-echo
+      (create-image mastodon-media--generic-broken-image-data nil t))
+     " ")))
 
 (provide 'mastodon-media)
 ;;; mastodon-media.el ends here
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 69cd65d..3ba00b9 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -113,7 +113,6 @@
 
 (define-minor-mode mastodon-profile-mode
   "Toggle mastodon profile minor mode.
-
 This minor mode is used for mastodon profile pages and adds a couple of
 extra keybindings."
   :init-value nil
@@ -154,7 +153,8 @@ contains")
   (mastodon-tl--property 'toot-json))
 
 (defun mastodon-profile--make-author-buffer (account &optional no-reblogs)
-  "Take an ACCOUNT json and insert a user account into a new buffer."
+  "Take an ACCOUNT json and insert a user account into a new buffer.
+NO-REBLOGS means do not display boosts in statuses."
   (mastodon-profile--make-profile-buffer-for
    account "statuses" #'mastodon-tl--timeline no-reblogs))
 
@@ -553,7 +553,8 @@ FIELDS means provide a fields vector fetched by other means."
 (defun mastodon-profile--make-profile-buffer-for (account endpoint-type
                                                           update-function
                                                           &optional no-reblogs)
-  "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION."
+  "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION.
+NO-REBLOGS means do not display boosts in statuses."
   (let* ((id (mastodon-profile--account-field account 'id))
          (args (when no-reblogs '(("exclude_reblogs" . "t"))))
          (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type)))
@@ -616,15 +617,18 @@ FIELDS means provide a fields vector fetched by other means."
                  " [locked]")
              "")
            "\n ------------\n"
-           (mastodon-tl--render-text note account)
+           ;; profile note:
            ;; account here to enable tab-stops in profile note
+           (mastodon-tl--render-text note account)
+           ;; meta fields:
            (if fields
                (concat "\n"
                        (mastodon-tl--set-face
                         (mastodon-profile--fields-insert fields)
-                        'success)
-                       "\n")
+                        'success))
              "")
+           "\n"
+           ;; Joined date:
            (propertize
             (mastodon-profile--format-joined-date-string joined)
             'face 'success)
@@ -664,7 +668,7 @@ FIELDS means provide a fields vector fetched by other means."
     (goto-char (point-min))))
 
 (defun mastodon-profile--format-joined-date-string (joined)
-  "Format a Joined timestamp."
+  "Format a human-readable Joined string from timestamp JOINED."
   (let ((joined-ts (ts-parse joined)))
     (format "Joined %s" (concat (ts-month-name joined-ts)
                                 " "
@@ -673,7 +677,6 @@ FIELDS means provide a fields vector fetched by other means."
 
 (defun mastodon-profile--get-toot-author ()
   "Open profile of author of toot under point.
-
 If toot is a boost, opens the profile of the booster."
   (interactive)
   (mastodon-profile--make-author-buffer
@@ -729,7 +732,6 @@ IMG_TYPE is the JSON key from the account data."
 
 (defun mastodon-profile--account-field (account field)
   "Return FIELD from the ACCOUNT.
-
 FIELD is used to identify regions under 'account"
   (cdr (assoc field account)))
 
@@ -760,7 +762,6 @@ Used to view a user's followers and those they're following."
 
 (defun mastodon-profile--search-account-by-handle (handle)
   "Return an account based on a user's HANDLE.
-
 If the handle does not match a search return then retun NIL."
   (let* ((handle (if (string= "@" (substring handle 0 1))
                      (substring handle 1 (length handle))
@@ -783,15 +784,14 @@ If the handle does not match a search return then retun NIL."
 
 (defun mastodon-profile--extract-users-handles (status)
   "Return all user handles found in STATUS.
-
 These include the author, author of reblogged entries and any user mentioned."
   (when status
     (let ((this-account
            (or (alist-get 'account status) ; status is a toot
                status)) ; status is a user listing
-	      (mentions (or (alist-get 'mentions (alist-get 'status status))
+	  (mentions (or (alist-get 'mentions (alist-get 'status status))
                         (alist-get 'mentions status)))
-	      (reblog (or (alist-get 'reblog (alist-get 'status status))
+	  (reblog (or (alist-get 'reblog (alist-get 'status status))
                       (alist-get 'reblog status))))
       (seq-filter
        'stringp
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index 7ff8b07..9d8ee65 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -180,8 +180,7 @@ user's profile note. This is also called by
         json))
 
 (defun mastodon-search--propertize-user (acct &optional note)
-  "Propertize display string for ACCT, optionally including profile
-NOTE."
+  "Propertize display string for ACCT, optionally including profile NOTE."
   (let ((user (mastodon-search--get-user-info acct)))
     (propertize
      (concat (propertize (car user)
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index e65d3a5..1a726c4 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -107,6 +107,13 @@ By default fixed width fonts are used."
   :type '(boolean :tag "Enable using proportional rather than fixed \
 width fonts when rendering HTML text"))
 
+(defcustom mastodon-tl--display-caption-not-url-when-no-media t
+  "Display an image's caption rather than URL.
+Only has an effect when `mastodon-tl--display-media-p' is set to
+nil."
+  :group 'mastodon-tl
+  :type 'boolean)
+
 (defvar-local mastodon-tl--buffer-spec nil
   "A unique identifier and functions for each Mastodon buffer.")
 
@@ -684,7 +691,7 @@ this just means displaying toot client."
                           (mastodon-tl--relative-time-description edited-parsed)
                         edited-parsed)))
          "")
-       (propertize "\n  ------------\n  " 'face 'default))
+       (propertize "\n  ------------\n" 'face 'default))
       'favourited-p faved
       'boosted-p    boosted
       'bookmarked-p bookmarked
@@ -1031,27 +1038,70 @@ message is a link which unhides/hides the main body."
 
 (defun mastodon-tl--media (toot)
   "Retrieve a media attachment link for TOOT if one exists."
-  (let* ((media-attachements (mastodon-tl--field 'media_attachments toot))
-         (media-string (mapconcat
-                        (lambda (media-attachement)
-                          (let ((preview-url
-                                 (alist-get 'preview_url media-attachement))
-                                (remote-url
-                                 (or (alist-get 'remote_url media-attachement)
-                                     ;; fallback b/c notifications don't have remote_url
-                                     (alist-get 'url media-attachement)))
-                                (type (alist-get 'type media-attachement))
-                                (caption (alist-get 'description media-attachement)))
-                            (if mastodon-tl--display-media-p
-                                (mastodon-media--get-media-link-rendering
-                                 preview-url remote-url type caption) ; 2nd arg for shr-browse-url
-                              (concat "Media::" preview-url "\n"))))
-                        media-attachements "")))
+  (let* ((media-attachments (mastodon-tl--field 'media_attachments toot))
+         (media-string (mapconcat #'mastodon-tl--media-attachment
+                                  media-attachments "")))
     (if (not (and mastodon-tl--display-media-p
                   (string-empty-p media-string)))
         (concat "\n" media-string)
       "")))
 
+(defun mastodon-tl--media-attachment (media-attachment)
+  "Return a propertized string for MEDIA-ATTACHMENT."
+  (let* ((preview-url
+          (alist-get 'preview_url media-attachment))
+         (remote-url
+          (or (alist-get 'remote_url media-attachment)
+              ;; fallback b/c notifications don't have remote_url
+              (alist-get 'url media-attachment)))
+         (type (alist-get 'type media-attachment))
+         (caption (alist-get 'description media-attachment))
+         (display-str
+          (if (and mastodon-tl--display-caption-not-url-when-no-media
+                   caption)
+              (concat "Media:: " caption)
+            (concat "Media:: " preview-url))))
+    (if mastodon-tl--display-media-p
+        ;; return placeholder [img]:
+        (mastodon-media--get-media-link-rendering
+         preview-url remote-url type caption) ; 2nd arg for shr-browse-url
+      ;; return URL/caption:
+      (concat
+       (mastodon-tl--propertize-img-str-or-url
+        (concat "Media:: " preview-url) ;; string
+        preview-url remote-url type caption
+        display-str ;; display
+        ;; FIXME: shr-link underlining is awful for captions with
+        ;; newlines, as the underlining runs to the edge of the
+        ;; frame even if the text doesn'
+        'shr-link)
+       "\n"))))
+
+(defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type
+                                                   help-echo &optional display face)
+  "Propertize an media placeholder string \"[img]\" or media URL.
+
+STR is the string to propertize, MEDIA-URL is the preview link,
+FULL-REMOTE-URL is the link to the full resolution image on the
+server, TYPE is the media type.
+HELP-ECHO, DISPLAY, and FACE are the text properties to add."
+  (propertize str
+              'media-url media-url
+              'media-state (when (string= str "[img]") 'needs-loading)
+              'media-type 'media-link
+              'mastodon-media-type type
+              'display display
+              'face face
+              'mouse-face 'highlight
+              'mastodon-tab-stop 'image ; for do-link-action-at-point
+              'image-url full-remote-url ; for shr-browse-image
+              'keymap mastodon-tl--shr-image-map-replacement
+              'help-echo (if (or (string= type "image")
+                                 (string= type nil)
+                                 (string= type "unknown")) ;handle borked images
+                             help-echo
+                           (concat help-echo "\nC-RET: play " type " with mpv"))))
+
 (defun mastodon-tl--content (toot)
   "Retrieve text content from TOOT.
 Runs `mastodon-tl--render-text' and fetches poll or media."
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index b12e7e1..1e364df 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -78,6 +78,7 @@
 (autoload 'mastodon-http--build-array-params-alist "mastodon-http")
 (autoload 'mastodon-tl--get-endpoint "mastodon-tl")
 (autoload 'mastodon-http--put "mastodon-http")
+(autoload 'mastodon-tl--return-fave-char "mastodon-tl")
 
 ;; for mastodon-toot--translate-toot-text
 (autoload 'mastodon-tl--content "mastodon-tl")
diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el
index 7478aaf..1ce9514 100644
--- a/test/mastodon-profile-tests.el
+++ b/test/mastodon-profile-tests.el
@@ -237,7 +237,7 @@ content generation in the function under test."
     (if (version< emacs-version "27.1")
         (mock (image-type-available-p 'imagemagick) => t)
       (mock (image-transforms-p) => t))
-    (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses")
+    (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses" nil)
           =>
           gargon-statuses-json)
     (mock (mastodon-profile--get-statuses-pinned *)
@@ -271,7 +271,8 @@ content generation in the function under test."
          "@Gargron\n"
          " ------------\n"
          "<p>Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.</p>\n"
-         "_ Patreon __ :: <a href=\"https://www.patreon.com/mastodon\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://www.</span><span class=\"\">patreon.com/mastodon</span><span class=\"invisible\"></span></a>_ Homepage _ :: <a href=\"https://zeonfederated.com\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">zeonfederated.com</span><span class=\"invisible\"></span></a>\n"
+         "_ Patreon __ :: <a href=\"https://www.patreon.com/mastodon\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://www.</span><span class=\"\">patreon.com/mastodon</span><span class=\"invisible\"></span></a>_ Homepage _ :: <a href=\"https://zeonfederated.com\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">zeonfederated.com</span><span class=\"invisible\"></span></a>"
+         "\n"
          "Joined March 2016"
          "\n\n"
          " ------------\n"
diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index 0ac5caf..a80c3ee 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -317,7 +317,7 @@ Strict-Transport-Security: max-age=31536000
 			              byline)
 			             "Account 42 (@acct42@example.space) 2999-99-99 00:11:22
   ------------
-  "))
+"))
         (should (eq (get-text-property handle-location 'mastodon-tab-stop byline)
                     'user-handle))
         (should (string= (get-text-property handle-location 'mastodon-handle byline)
@@ -340,7 +340,7 @@ Strict-Transport-Security: max-age=31536000
                                              'mastodon-tl--byline-boosted))
                        "Account 42 (@acct42@example.space) 2999-99-99 00:11:22
   ------------
-  ")))))
+")))))
 
 (ert-deftest mastodon-tl--byline-boosted ()
   "Should format the boosted toot correctly."
@@ -357,7 +357,7 @@ Strict-Transport-Security: max-age=31536000
                                              'mastodon-tl--byline-boosted))
                        "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22
   ------------
-  ")))))
+")))))
 
 (ert-deftest mastodon-tl--byline-favorited ()
   "Should format the favourited toot correctly."
@@ -374,7 +374,7 @@ Strict-Transport-Security: max-age=31536000
                                              'mastodon-tl--byline-boosted))
                        "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22
   ------------
-  ")))))
+")))))
 
 
 (ert-deftest mastodon-tl--byline-boosted/favorited ()
@@ -392,7 +392,7 @@ Strict-Transport-Security: max-age=31536000
                                              'mastodon-tl--byline-boosted))
                        "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22
   ------------
-  ")))))
+")))))
 
 (ert-deftest mastodon-tl--byline-reblogged ()
   "Should format the reblogged toot correctly."
@@ -418,7 +418,7 @@ Strict-Transport-Security: max-age=31536000
 			             "Account 42 (@acct42@example.space)
   Boosted Account 43 (@acct43@example.space) original time
   ------------
-  "))
+"))
         (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline)
                     'user-handle))
         (should (equal (get-text-property handle1-location 'help-echo byline)
@@ -451,7 +451,7 @@ Strict-Transport-Security: max-age=31536000
                        "Account 42 (@acct42@example.space)
   Boosted Account 43 (@acct43@example.space) original time
   ------------
-  ")))))
+")))))
 
 (ert-deftest mastodon-tl--byline-reblogged-boosted/favorited ()
   "Should format the reblogged toot that was also boosted & favoritedcorrectly."
@@ -475,7 +475,7 @@ Strict-Transport-Security: max-age=31536000
                        "(B) (F) Account 42 (@acct42@example.space)
   Boosted Account 43 (@acct43@example.space) original time
   ------------
-  ")))))
+")))))
 
 (ert-deftest mastodon-tl--byline-timestamp-has-relative-display ()
   "Should display the timestamp with a relative time."