Merge branch 'develop'

6 files changed, 140 insertions, 100 deletions

diff --git a/README.org b/README.org
index 4289d32..73a42e5 100644
--- a/README.org
+++ b/README.org
@@ -205,6 +205,14 @@ You can download and use your instance's custom emoji
 | =C-c C-e= | add emoji (if =emojify= installed) |
 |---------+----------------------------------|
 
+**** draft toots
+
+- Compose buffer text is saved as you type, kept in =mastodon-toot-current-toot-text=.
+- =mastodon-toot-save-draft=: save the current toot as a draft.
+- =mastodon-toot-open-draft-toot=: Open a compose buffer and insert one of your draft toots.
+- =mastodon-toot-delete-draft-toot=: Delete a draft toot.
+- =mastodon-toot-delete-all-drafts=: Delete all your drafts.
+
 *** Other commands and account settings:
 
 - =mastodon-url-lookup=: Attempt to load URL in =mastodon.el=. URL may be the one at point or provided in the minibuffer. Should also work if =mastodon.el= is not yet loaded.
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index 086dcec..f32ccd4 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -73,7 +73,7 @@
   "Retrieve URL asynchronously.
 
 This is a thin abstraction over the system
-`url-retrieve-synchronously`.  Depending on which version of this
+`url-retrieve-synchronously'.  Depending on which version of this
 is available we will call it with or without a timeout."
   (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4)
       (url-retrieve-synchronously url)
@@ -100,6 +100,7 @@ Message status and JSON error from RESPONSE if unsuccessful."
 (defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p)
   "Make a METHOD type request using BODY, with Mastodon authorization.
 Unless UNAUTHENTICATED-P is non-nil."
+  (declare (debug 'body))
   `(let ((url-request-method ,method)
          (url-request-extra-headers
           (unless ,unauthenticated-p
@@ -107,6 +108,18 @@ Unless UNAUTHENTICATED-P is non-nil."
                         (concat "Bearer " (mastodon-auth--access-token)))))))
      ,body))
 
+(defun mastodon-http--build-query-string (args)
+  "Build a request query string from ARGS."
+  ;; (url-build-query-string args nil))
+  ;; url-build-query-string adds 'nil' to empty params so lets stay with our
+  ;; own:
+  (mapconcat (lambda (arg)
+               (concat (url-hexify-string (car arg))
+                       "="
+                       (url-hexify-string (cdr arg))))
+             args
+             "&"))
+
 (defun mastodon-http--post (url args headers &optional unauthenticated-p)
   "POST synchronously to URL with ARGS and HEADERS.
 
@@ -115,12 +128,7 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil.
    "POST"
    (let ((url-request-data
           (when args
-            (mapconcat (lambda (arg)
-                         (concat (url-hexify-string (car arg))
-                                 "="
-                                 (url-hexify-string (cdr arg))))
-                       args
-                       "&")))
+            (mastodon-http--build-query-string args)))
          (url-request-extra-headers
           (append url-request-extra-headers ; auth set in macro
                   ;; pleroma compat:
@@ -165,13 +173,6 @@ Pass response buffer to CALLBACK function."
    (with-temp-buffer
      (mastodon-http--url-retrieve-synchronously url))))
 
-(defun mastodon-http--append-query-string (url params)
-  "Append PARAMS to URL as query strings and return it.
-
-PARAMS should be an alist as required by `url-build-query-string'."
-  (let ((query-string (url-build-query-string params)))
-    (concat url "?" query-string)))
-
 ;; search functions:
 (defun mastodon-http--process-json-search ()
   "Process JSON returned by a search query to the server."
@@ -215,7 +216,9 @@ Optionally specify the PARAMS to send."
 Optionally specify the PARAMS to send."
   (mastodon-http--authorized-request
    "PATCH"
-   (let ((url (mastodon-http--append-query-string base-url params)))
+   (let ((url
+          (concat base-url "?"
+                  (mastodon-http--build-query-string params))))
      (mastodon-http--url-retrieve-synchronously url))))
 
  ;; Asynchronous functions
@@ -244,12 +247,7 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil."
    (let ((request-timeout 5)
          (url-request-data
           (when args
-            (mapconcat (lambda (arg)
-                         (concat (url-hexify-string (car arg))
-                                 "="
-                                 (url-hexify-string (cdr arg))))
-                       args
-                       "&"))))
+            (mastodon-http--build-query-string args))))
      (with-temp-buffer
        (url-retrieve url callback cbargs)))))
 
@@ -262,43 +260,43 @@ item uploaded, and `mastodon-toot--update-status-fields' is run."
   (let* ((file (file-name-nondirectory filename))
          (request-backend 'curl))
     (request
-     url
-     :type "POST"
-     :params `(("description" . ,caption))
-     :files `(("file" . (,file :file ,filename
-                               :mime-type "multipart/form-data")))
-     :parser 'json-read
-     :headers `(("Authorization" . ,(concat "Bearer "
-                                            (mastodon-auth--access-token))))
-     :sync nil
-     :success (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 "%s file %s with id %S and caption '%s' uploaded!"
-                            (capitalize (alist-get 'type data))
-                            file
-                            (alist-get 'id data)
-                            (alist-get 'description data))
-                   (mastodon-toot--update-status-fields))))
-     :error (cl-function
-             (lambda (&key error-thrown &allow-other-keys)
-               (cond
-                ;; handle curl errors first (eg 26, can't read file/path)
-                ;; because the '=' test below fails for them
-                ;; they have the form (error . error message 24)
-                ((not (proper-list-p error-thrown)) ; not dotted list
-		 (message "Got error: %s. Shit went south." (cdr error-thrown)))
-                ;; handle mastodon api errors
-                ;; they have the form (error http 401)
-		((= (car (last error-thrown)) 401)
-                 (message "Got error: %s Unauthorized: The access token is invalid" error-thrown))
-                ((= (car (last error-thrown)) 422)
-                 (message "Got error: %s Unprocessable entity: file or file type is unsupported or invalid" error-thrown))
-                (t
-                 (message "Got error: %s Shit went south"
-                          error-thrown))))))))
+      url
+      :type "POST"
+      :params `(("description" . ,caption))
+      :files `(("file" . (,file :file ,filename
+                                :mime-type "multipart/form-data")))
+      :parser 'json-read
+      :headers `(("Authorization" . ,(concat "Bearer "
+                                             (mastodon-auth--access-token))))
+      :sync nil
+      :success (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 "%s file %s with id %S and caption '%s' uploaded!"
+                             (capitalize (alist-get 'type data))
+                             file
+                             (alist-get 'id data)
+                             (alist-get 'description data))
+                    (mastodon-toot--update-status-fields))))
+      :error (cl-function
+              (lambda (&key error-thrown &allow-other-keys)
+                (cond
+                 ;; handle curl errors first (eg 26, can't read file/path)
+                 ;; because the '=' test below fails for them
+                 ;; they have the form (error . error message 24)
+                 ((not (proper-list-p error-thrown)) ; not dotted list
+		          (message "Got error: %s. Shit went south." (cdr error-thrown)))
+                 ;; handle mastodon api errors
+                 ;; they have the form (error http 401)
+		         ((= (car (last error-thrown)) 401)
+                  (message "Got error: %s Unauthorized: The access token is invalid" error-thrown))
+                 ((= (car (last error-thrown)) 422)
+                  (message "Got error: %s Unprocessable entity: file or file type is unsupported or invalid" error-thrown))
+                 (t
+                  (message "Got error: %s Shit went south"
+                           error-thrown))))))))
 
 (provide 'mastodon-http)
 ;;; mastodon-http.el ends here
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index ace15b2..9715a6c 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -186,7 +186,6 @@ with the image."
 MEDIA-TYPE is a symbol and either 'avatar or 'media-link.
 START is the position where we start loading the image.
 REGION-LENGTH is the range from start to propertize."
-  ;; TODO: Cache the avatars
   (let ((image-options (when (or (image-type-available-p 'imagemagick)
                                  (image-transforms-p)) ; inbuilt scaling in 27.1
                          (cond
@@ -196,8 +195,8 @@ REGION-LENGTH is the range from start to propertize."
                            `(:max-height ,mastodon-media--preview-max-height))))))
     (let ((buffer (current-buffer))
           (marker (copy-marker start))
-	  ;; Keep url.el from spamming us with messages about connecting to hosts:
-	  (url-show-status nil))
+	      ;; Keep url.el from spamming us with messages about connecting to hosts:
+	      (url-show-status nil))
       (condition-case nil
           ;; catch any errors in url-retrieve so as to not abort
           ;; whatever called us
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 7f78df7..054f6e5 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -274,7 +274,7 @@ Both args are strings.
 SOURCE means that the preference is in the 'source' part of the account JSON."
   (let* ((url (mastodon-http--api "accounts/update_credentials"))
          (pref-formatted (if source (concat "source[" pref "]") pref))
-         (response (mastodon-http--patch url `((,pref-formatted ,val)))))
+         (response (mastodon-http--patch url `((,pref-formatted . ,val)))))
     (mastodon-http--triage response
                            (lambda ()
                              (mastodon-profile-fetch-server-account-settings)
@@ -406,11 +406,11 @@ This endpoint only holds a few preferences. For others, see
 
 (defun mastodon-profile--fields-get (account)
   "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT.
-Returns a list of lists."
+Returns an alist."
   (let ((fields (mastodon-profile--account-field account 'fields)))
     (when fields
       (mapcar (lambda (el)
-                (list (alist-get 'name el)
+                (cons (alist-get 'name el)
                       (alist-get 'value el)))
               fields))))
 
@@ -424,7 +424,7 @@ Returns a list of lists."
                   (concat
                    (format "_ %s " (car field))
                    (make-string (- (+ 1 left-width) (length (car field))) ?_)
-                   (format " :: %s" (cadr field)))
+                   (format " :: %s" (cdr field)))
                   field)) ; hack to make links tabstops
                fields "")))
 
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 8e75705..130b01f 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -647,7 +647,9 @@ START and END are the boundaries of the link in the toot."
          keymap
          (help-echo (get-text-property start 'help-echo))
          extra-properties
-         (toot-url (mastodon-tl--field 'url toot))
+         ;; handle calling this on non-toots, e.g. for profiles:
+         (toot-url (when (proper-list-p toot)
+                     (mastodon-tl--field 'url toot)))
          (toot-url (when toot-url (url-generic-parse-url toot-url)))
          (toot-instance-url (if toot-url
                                 (concat (url-type toot-url) "://"
@@ -666,8 +668,10 @@ START and END are the boundaries of the link in the toot."
           (;; User handles:
            maybe-userhandle
            ;; this fails on mentions in profile notes:
-           (let ((maybe-userid (mastodon-tl--extract-userid-toot
-                                toot maybe-userhandle)))
+           (let ((maybe-userid
+                  (when (proper-list-p toot)
+                    (mastodon-tl--extract-userid-toot
+                     toot maybe-userhandle))))
              (setq mastodon-tab-stop-type 'user-handle
                    keymap mastodon-tl--link-keymap
                    help-echo (concat "Browse user profile of " maybe-userhandle)
@@ -1410,13 +1414,12 @@ INSTANCE is an instance domain name."
           (reblog (alist-get 'reblog toot))
           (account (or (alist-get 'account reblog)
                        (alist-get 'account toot)))
-          (acct (alist-get 'acct account))
+          (url (alist-get 'url account))
           (username (alist-get 'username account))
-          (instance
-           (concat "https://"
-                   (or instance
-                       (string-remove-prefix (concat username "@")
-                                             acct))))
+          (instance (if instance
+                        (concat "https://" instance)
+                      (string-remove-suffix (concat "/@" username)
+                                            url)))
           (response (mastodon-http--get-json
                      (if user
                          (mastodon-http--api "instance")
@@ -1494,17 +1497,24 @@ IND is the optional indentation level to print at."
           (mastodon-tl--print-json-keys
            (cdr el) (if ind (+ ind 4) 4)))
          (t
-          (when ind (indent-to ind))
-          (insert (mastodon-tl--format-key el pad)
-                  " "
-                  (mastodon-tl--newline-if-long el)
-                  ;; only send strings straight to --render-text
-                  ;; this makes hyperlinks work:
-                  (if (not (stringp (cdr el)))
-                      (mastodon-tl--render-text
-                       (prin1-to-string (cdr el)))
-                    (mastodon-tl--render-text (cdr el)))
-                  "\n")))))))
+          ;; basic handling of raw booleans:
+          (let ((val (cond ((equal (cdr el) ':json-false)
+                            "no")
+                           ((equal (cdr el) 't)
+                            "yes")
+                           (t
+                            (cdr el)))))
+            (when ind (indent-to ind))
+            (insert (mastodon-tl--format-key el pad)
+                    " "
+                    (mastodon-tl--newline-if-long el)
+                    ;; only send strings straight to --render-text
+                    ;; this makes hyperlinks work:
+                    (if (not (stringp val))
+                        (mastodon-tl--render-text
+                         (prin1-to-string val))
+                      (mastodon-tl--render-text val))
+                    "\n"))))))))
 
 (defun mastodon-tl--print-instance-rules-or-fields (alist)
   "Print ALIST of instance rules or contact account fields."
@@ -1700,7 +1710,13 @@ For use after e.g. deleting a toot."
          (mastodon-notifications--get))
         ((equal (mastodon-tl--buffer-name)
                 (concat "*mastodon-" (mastodon-auth--get-account-name) "-statuses*"))
-         (mastodon-profile--my-profile))))
+         (mastodon-profile--my-profile))
+        ((save-match-data
+           (string-match
+            "statuses/\\(?2:[[:digit:]]+\\)/context"
+            (mastodon-tl--get-endpoint))
+           (mastodon-tl--thread
+            (match-string 2 (mastodon-tl--get-endpoint)))))))
 
 (defun mastodon-tl--more ()
   "Append older toots to timeline, asynchronously."
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 8c9cc62..bcf9c83 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -50,6 +50,8 @@
 (defvar mastodon-instance-url)
 (defvar mastodon-tl--buffer-spec)
 (defvar mastodon-tl--enable-proportional-fonts)
+(defvar mastodon-profile-account-settings)
+
 (autoload 'mastodon-auth--user-acct "mastodon-auth")
 (autoload 'mastodon-http--api "mastodon-http")
 (autoload 'mastodon-http--delete "mastodon-http")
@@ -196,13 +198,17 @@ send.")
                               nil t)))
     (mastodon-profile--update-preference "privacy" vis :source)))
 
-(defun mastodon-toot--get-max-toot-chars (&optional no-toot)
-  "Fetch max_toot_chars from `mastodon-instance-url' asynchronously."
+(defun mastodon-toot--get-max-toot-chars (&optional _no-toot)
+  "Fetch max_toot_chars from `mastodon-instance-url' asynchronously.
+NO-TOOT means we are not calling from a toot buffer."
   (mastodon-http--get-json-async
-   (mastodon-http--api "instance") 'mastodon-toot--get-max-toot-chars-callback 'no-toot))
+   (mastodon-http--api "instance")
+   'mastodon-toot--get-max-toot-chars-callback 'no-toot))
 
-(defun mastodon-toot--get-max-toot-chars-callback (json-response &optional no-toot)
-  "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer."
+(defun mastodon-toot--get-max-toot-chars-callback (json-response
+                                                   &optional no-toot)
+  "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer.
+NO-TOOT means we are not calling from a toot buffer."
   (let ((max-chars
          (or
           (alist-get 'max_toot_chars json-response)
@@ -472,12 +478,23 @@ CANCEL means the toot was not sent, so we save the toot text as a draft."
 
 (defun mastodon-toot--cancel ()
   "Kill new-toot buffer/window. Does not POST content to Mastodon.
-Toot text is saved as a draft."
+If toot is not empty, prompt to save text as a draft."
   (interactive)
   (if (mastodon-toot-empty-p)
-      (mastodon-toot--kill :cancel)
-    (when (y-or-n-p "Discard draft toot? (text will be saved)")
-      (mastodon-toot--kill :cancel))))
+      (mastodon-toot--kill)
+    (when (y-or-n-p "Save draft toot?")
+      (mastodon-toot-save-draft))
+    (mastodon-toot--kill)))
+
+(defun mastodon-toot-save-draft ()
+  "Save the current compose toot text as a draft.
+Pushes `mastodon-toot-current-toot-text' to
+`mastodon-toot-draft-toots-list'."
+  (interactive)
+  (unless (eq mastodon-toot-current-toot-text nil)
+    (cl-pushnew mastodon-toot-current-toot-text
+                mastodon-toot-draft-toots-list :test 'equal)
+    (message "Draft saved!")))
 
 (defun mastodon-toot-empty-p (&optional text-only)
   "Return t if no text or attachments have been added to the compose buffer.
@@ -761,7 +778,10 @@ Customize `mastodon-toot-display-orig-in-reply-buffer' to display
 text of the toot being replied to in the compose buffer."
   (interactive)
   (let* ((toot (mastodon-tl--property 'toot-json))
-         (parent (mastodon-tl--field 'parent-toot toot)) ; for new notifs handling
+         ;; NB: we cannot use mastodon-tl--property for 'parent-toot
+         ;; because if it doesn't have one, it is fetched from next toot!
+         ;; we also cannot use --field because we need to get a different property first
+         (parent (get-text-property (point) 'parent-toot)) ; for new notifs handling
          (id (mastodon-tl--as-string
               (mastodon-tl--field 'id (or parent toot))))
          (account (mastodon-tl--field 'account toot))
@@ -1065,16 +1085,15 @@ REPLY-JSON is the full JSON of the toot being replied to."
                            (list 'invisible (not mastodon-toot--content-warning)
                                  'face 'mastodon-cw-face)))))
 
-(defun mastodon-toot-save-toot-text (&rest _args)
+(defun mastodon-toot--save-toot-text (&rest _args)
   "Save the current toot text in `mastodon-toot-current-toot-text'.
 Added to `after-change-functions' in new toot buffers."
-  (interactive)
   (let ((text (mastodon-toot--remove-docs)))
     (unless (string-empty-p text)
       (setq mastodon-toot-current-toot-text text))))
 
 (defun mastodon-toot-open-draft-toot ()
-  "Prompt for a draft toot and open a new compose buffer containing the draft."
+  "Prompt for a draft and compose a toot with it."
   (interactive)
   (if mastodon-toot-draft-toots-list
       (let ((text (completing-read "Select draft toot: "
@@ -1164,7 +1183,7 @@ a draft into the buffer."
     (mastodon-toot--update-status-fields)
     ;; draft toot text saving:
     (setq mastodon-toot-current-toot-text nil)
-    (push #'mastodon-toot-save-toot-text after-change-functions)
+    (push #'mastodon-toot--save-toot-text after-change-functions)
     (when initial-text
       (insert initial-text))))