Merge branch 'scratch/mastodon' into develop

9 files changed, 102 insertions, 90 deletions

diff --git a/.gitignore b/.gitignore
index ad98902..be78d26 100644
--- a/.gitignore
+++ b/.gitignore
@@ -17,4 +17,4 @@ dist/
 /lisp/mastodon-autoloads.el
 
 # ELSA files
-/lisp/.elsa/
\ No newline at end of file
+/lisp/.elsa/
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el
index eb57368..5069271 100644
--- a/lisp/mastodon-auth.el
+++ b/lisp/mastodon-auth.el
@@ -172,15 +172,13 @@ When ASK is absent return nil."
 Generate/save token if none known yet."
   (cond (mastodon-auth--token-alist
          ;; user variables are known and initialised.
-         (alist-get mastodon-instance-url mastodon-auth--token-alist
-                    nil nil 'equal))
+         (alist-get mastodon-instance-url mastodon-auth--token-alist))
         ((plist-get (mastodon-client--active-user) :access_token)
          ;; user variables need to be read from plstore.
          (push (cons mastodon-instance-url
                      (plist-get (mastodon-client--active-user) :access_token))
                mastodon-auth--token-alist)
-         (alist-get mastodon-instance-url mastodon-auth--token-alist
-                    nil nil 'equal))
+         (alist-get mastodon-instance-url mastodon-auth--token-alist))
         ((null mastodon-active-user)
          ;; user not aware of 2FA-related changes and has not set
          ;; `mastodon-active-user'. Make user aware and error out.
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 5cd233a..04cf0c2 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -148,40 +148,39 @@ with the image."
   (when (marker-buffer marker) ; if buffer hasn't been killed
     (let ((url-buffer (current-buffer))
           (is-error-response-p (eq :error (car status-plist))))
-      (unwind-protect
-          (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 image-options))))
-            (when mastodon-media--enable-image-caching
-              (unless (url-is-cached url) ; cache if not already cached
-                (url-store-in-cache url-buffer)))
-            (with-current-buffer (marker-buffer marker)
-              ;; Save narrowing in our buffer
-              (let ((inhibit-read-only t))
-                (save-restriction
-                  (widen)
-                  (put-text-property marker
-                                     (+ marker region-length) 'media-state 'loaded)
-                  (when image
-                    ;; We only set the image to display if we could load
-                    ;; it; we already have set a default image when we
-                    ;; added the tag.
-                    (put-text-property marker (+ marker region-length)
-                                       'display image))
-                  ;; We are done with the marker; release it:
-                  (set-marker marker nil)))
-              (kill-buffer url-buffer)))))))
+      (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 image-options))))
+        (when mastodon-media--enable-image-caching
+          (unless (url-is-cached url)   ; cache if not already cached
+            (url-store-in-cache url-buffer)))
+        (with-current-buffer (marker-buffer marker)
+          ;; Save narrowing in our buffer
+          (let ((inhibit-read-only t))
+            (save-restriction
+              (widen)
+              (put-text-property marker
+                                 (+ marker region-length) 'media-state 'loaded)
+              (when image
+                ;; We only set the image to display if we could load
+                ;; it; we already have set a default image when we
+                ;; added the tag.
+                (put-text-property marker (+ marker region-length)
+                                   'display image))
+              ;; We are done with the marker; release it:
+              (set-marker marker nil)))
+          (kill-buffer url-buffer))))))
 
 (defun mastodon-media--load-image-from-url (url media-type start region-length)
   "Take a URL and MEDIA-TYPE and load the image asynchronously.
-MEDIA-TYPE is a symbol and either `avatar' or `media-link.'
+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."
   (let ((image-options (when (or (image-type-available-p 'imagemagick)
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index df96122..5f6d1ba 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -31,12 +31,13 @@
 
 ;;; Code:
 
+(require 'mastodon)
+
 (autoload 'mastodon-http--api "mastodon-http")
 (autoload 'mastodon-http--get-params-async-json "mastodon-http")
 (autoload 'mastodon-http--post "mastodon-http")
 (autoload 'mastodon-http--triage "mastodon-http")
 (autoload 'mastodon-media--inline-images "mastodon-media")
-(autoload 'mastodon-notifications-get "mastodon")
 (autoload 'mastodon-tl--byline "mastodon-tl")
 (autoload 'mastodon-tl--byline-author "mastodon-tl")
 (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl")
@@ -55,7 +56,6 @@
 
 (defvar mastodon-tl--buffer-spec)
 (defvar mastodon-tl--display-media-p)
-(defvar mastodon-mode-map)
 
 (defvar mastodon-notifications--types-alist
   '(("follow" . mastodon-notifications--follow)
@@ -80,11 +80,12 @@
   "Alist of subjects for notification types.")
 
 (defvar mastodon-notifications--map
-  (let ((map (copy-keymap mastodon-mode-map)))
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map mastodon-mode-map)
     (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept)
     (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject)
     (define-key map (kbd "C-k") #'mastodon-notifications--clear-current)
-    (keymap-canonicalize map))
+    map)
   "Keymap for viewing notifications.")
 
 (defun mastodon-notifications--byline-concat (message)
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index a5abe5a..0a3a236 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -250,14 +250,14 @@ NO-REBLOGS means do not display boosts in statuses."
     (mastodon-tl--set-buffer-spec (buffer-name buffer) "accounts/verify_credentials" nil)
     (setq-local header-line-format
                 (propertize msg-str
-                            'face font-lock-comment-face))
+                            'face 'font-lock-comment-face))
     (mastodon-profile-update-mode t)
     (insert (propertize (concat (propertize "0"
                                             'note-counter t
                                             'display nil)
                                 "/500 characters")
                         'read-only t
-                        'face font-lock-comment-face
+                        'face 'font-lock-comment-face
                         'note-header t)
             "\n")
     (make-local-variable 'after-change-functions)
@@ -827,7 +827,7 @@ Currently limited to 100 handles. If not found, try
          (response (mastodon-http--get-json url `(("limit" . "100"))))
          (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id response))
          (choice (completing-read "Remove from followers: " handles))
-         (id (alist-get choice handles nil nil 'equal)))
+         (id (alist-get choice handles)))
     (mastodon-profile--remove-user-from-followers id)))
 
 (defun mastodon-profile--add-private-note-to-account ()
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index df7de7b..c921ba9 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -32,7 +32,6 @@
 ;;; Code:
 
 (require 'shr)
-(require 'ts)
 (require 'thingatpt) ; for word-at-point
 (require 'time-date)
 (require 'cl-lib)
@@ -204,8 +203,8 @@ If nil `(point-min)' is used instead.")
 
 (defvar mastodon-tl--link-keymap
   (let ((map (make-sparse-keymap)))
-    (define-key map [return] 'mastodon-tl--do-link-action-at-point)
-    (define-key map [mouse-2] 'mastodon-tl--do-link-action)
+    (define-key map [return] #'mastodon-tl--do-link-action-at-point)
+    (define-key map [mouse-2] #'mastodon-tl--do-link-action)
     (define-key map [follow-link] 'mouse-face)
     map)
   "The keymap for link-like things in buffer (except for shr.el generate links).
@@ -678,7 +677,7 @@ this just means displaying toot client."
             (propertize
              (format-time-string mastodon-toot-timestamp-format
                                  edited-parsed)
-             'face font-lock-comment-face
+             'face 'font-lock-comment-face
              'timestamp edited-parsed
              'display (if mastodon-tl--enable-relative-timestamps
                           (mastodon-tl--relative-time-description edited-parsed)
@@ -710,6 +709,7 @@ The descriptive string is a human readable version relative to
 the current time while the next change timestamp give the first
 time that this description will change in the future.
 TIMESTAMP is assumed to be in the past."
+  ;; FIXME: Use `mastodon-tl--human-duration'!
   (let* ((now (or current-time (current-time)))
          (time-difference (time-subtract now timestamp))
          (seconds-difference (float-time time-difference))
@@ -1145,25 +1145,41 @@ LONGEST-OPTION is the option whose length determines the formatting."
                 (propertize str 'face 'font-lock-comment-face))
               "\n"))))
 
+(defconst mastodon-tl--time-units
+  '("sec"   60.0                          ;Use a float to convert `n' to float.
+    "min"   60
+    "hour"  24
+    "day"   7
+    "week"  4.345
+    "month" 12
+    "year"))
+
 (defun mastodon-tl--format-poll-expiry (timestamp)
   "Convert poll expiry TIMESTAMP into a descriptive string."
-  (let ((parsed (ts-human-duration
-                 (ts-diff (ts-parse timestamp) (ts-now)))))
-    (cond ((> (plist-get parsed :days) 0)
-           (format "%s days, %s hours left"
-                   (plist-get parsed :days)
-                   (plist-get parsed :hours)))
-          ((> (plist-get parsed :hours) 0)
-           (format "%s hours, %s minutes left"
-                   (plist-get parsed :hours)
-                   (plist-get parsed :minutes)))
-          ((> (plist-get parsed :minutes) 0)
-           (format "%s minutes left" (plist-get parsed :minutes)))
-          (t ; we failed to guess:
-           (format "%s days, %s hours, %s minutes left"
-                   (plist-get parsed :days)
-                   (plist-get parsed :hours)
-                   (plist-get parsed :minutes))))))
+  ;; FIXME: Could we document the format of TIMESTAMP here?
+  (let* ((ts (encode-time (parse-time-string timestamp)))
+         (seconds (time-to-seconds (time-subtract ts nil))))
+    (concat (mastodon-tl--human-duration (max 0 seconds)) " left")))
+
+(defun mastodon-tl--human-duration (seconds)
+  "Return a string describing SECONDS in a more human-friendly way."
+  (cl-assert (>= seconds 0))
+  (let* ((units mastodon-tl--time-units)
+         (n1 seconds) (unit1 (pop units)) n2 unit2
+         next)
+    (while (and units (> (truncate (setq next (/ n1 (car units)))) 0))
+      (setq unit2 unit1)
+      (setq n2 (- n1 (* (car units) (truncate n1 (car units)))))
+      (setq n1 next)
+      (pop units)
+      (setq unit1 (pop units)))
+    (setq n1 (truncate n1))
+    (if n2 (setq n2 (truncate n2)))
+    (if (memq n2 '(nil 0))
+        (format "%d %s%s" n1 unit1 (if (> n1 1) "s" ""))
+      (format "%d %s%s, %d %s%s"
+              n1 unit1 (if (> n1 1) "s" "")
+              n2 unit2 (if (> n2 1) "s" "")))))
 
 (defun mastodon-tl--read-poll-option ()
   "Read a poll option to vote on a poll."
@@ -1361,19 +1377,19 @@ To disable showing the stats, customize
                                 'favourited-p (eq 't .favourited)
                                 'favourites-field t
                                 'help-echo (format "%s favourites" .favourites_count)
-                                'face font-lock-comment-face)
-                    (propertize " | " 'face font-lock-comment-face)
+                                'face 'font-lock-comment-face)
+                    (propertize " | " 'face 'font-lock-comment-face)
                     (propertize boosts
                                 'boosted-p (eq 't .reblogged)
                                 'boosts-field t
                                 'help-echo (format "%s boosts" .reblogs_count)
-                                'face font-lock-comment-face)
-                    (propertize " | " 'face font-lock-comment-face)
+                                'face 'font-lock-comment-face)
+                    (propertize " | " 'face 'font-lock-comment-face)
                     (propertize replies
                                 'replies-field t
                                 'replies-count .replies_count
                                 'help-echo (format "%s replies" .replies_count)
-                                'face font-lock-comment-face)))
+                                'face 'font-lock-comment-face)))
            (status
             (concat
              (propertize " "
@@ -2191,7 +2207,7 @@ report the account for spam."
                    "rules [TAB for options, | to separate]: "
                    alist nil t)))
     (mapcar (lambda (x)
-              (alist-get x alist nil nil 'equal))
+              (alist-get x alist))
             choices)))
 
 
@@ -2274,7 +2290,7 @@ when showing followers or accounts followed."
 (defun mastodon-tl--get-link-header-from-response (headers)
   "Get http Link header from list of http HEADERS."
   ;; pleroma uses "link", so case-insensitive match required:
-  (when-let ((link-headers (alist-get "Link" headers nil nil 'cl-equalp)))
+  (when-let ((link-headers (alist-get "Link" headers nil nil #'cl-equalp)))
     (split-string link-headers ", ")))
 
 (defun mastodon-tl--more ()
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index abd3340..d974e04 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -687,7 +687,7 @@ TEXT-ONLY means don't check for attachments or polls."
 ;;; EMOJIS
 
 (defalias 'mastodon-toot--insert-emoji
-  'emojify-insert-emoji
+  #'emojify-insert-emoji
   "Prompt to insert an emoji.")
 
 (defun mastodon-toot--emoji-dir ()
@@ -905,7 +905,7 @@ instance to edit a toot."
                 (insert (propertize (if (= count 1)
                                         (format "%s [original]:\n" count)
                                       (format "%s:\n" count))
-                                    'face font-lock-comment-face)
+                                    'face 'font-lock-comment-face)
                         (mastodon-toot--insert-toot-iter x)
                         "\n")
                 (cl-incf count))
@@ -915,7 +915,7 @@ instance to edit a toot."
                    (format "Edits to toot by %s:"
                            (alist-get 'username
                                       (alist-get 'account (car history))))
-                   'face font-lock-comment-face))
+                   'face 'font-lock-comment-face))
       (mastodon-tl--set-buffer-spec (buffer-name (current-buffer))
                                     (format "statuses/%s/history" id)
                                     nil))))
@@ -1130,7 +1130,7 @@ Return its two letter ISO 639 1 code."
   (let* ((choice (completing-read "Language for this toot: "
                                   mastodon-iso-639-1)))
     (setq mastodon-toot--language
-          (alist-get choice mastodon-iso-639-1 nil nil 'equal))
+          (alist-get choice mastodon-iso-639-1))
     (message "Language set to %s" choice)
     (mastodon-toot--update-status-fields)))
 
@@ -1623,7 +1623,7 @@ Added to `after-change-functions' in new toot buffers."
                                     mastodon-toot-draft-toots-list
                                     nil t)))
         (setq mastodon-toot-draft-toots-list
-              (cl-delete draft mastodon-toot-draft-toots-list :test 'equal))
+              (cl-delete draft mastodon-toot-draft-toots-list :test #'equal))
         (message "Draft deleted!"))
     (message "No drafts to delete.")))
 
@@ -1773,7 +1773,7 @@ Only text that is not one of these faces will be spell-checked."
 (add-hook 'mastodon-toot-mode-hook
     	  (lambda ()
             (setq flyspell-generic-check-word-predicate
-                  'mastodon-toot-mode-flyspell-verify)))
+                  #'mastodon-toot-mode-flyspell-verify)))
 
 ;;;###autoload
 (add-hook 'mastodon-toot-mode-hook
diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el
index 9809365..ad36664 100644
--- a/lisp/mastodon-views.el
+++ b/lisp/mastodon-views.el
@@ -177,7 +177,7 @@ provides the JSON data."
   (if (seq-empty-p data)
       (insert (propertize
                (format "Looks like you have no %s for now." view-name)
-               'face font-lock-comment-face
+               'face 'font-lock-comment-face
                'byline t
                'toot-id "0")) ; so point can move here when no item
     (funcall insert-fun data)
@@ -391,7 +391,7 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting."
          (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id followings))
          (account (or handle (completing-read "Account to add: "
                                               handles nil t)))
-         (account-id (or account-id (alist-get account handles nil nil 'equal)))
+         (account-id (or account-id (alist-get account handles)))
          (url (mastodon-http--api (format "lists/%s/accounts" list-id)))
          (response (mastodon-http--post url `(("account_ids[]" . ,account-id)))))
     (mastodon-views--list-action-triage
@@ -425,7 +425,7 @@ If ID is provided, use that list."
          (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id accounts))
          (account (completing-read "Account to remove: "
                                    handles nil t))
-         (account-id (alist-get account handles nil nil 'equal))
+         (account-id (alist-get account handles))
          (url (mastodon-http--api (format "lists/%s/accounts" list-id)))
          (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id)))
          (response (mastodon-http--delete url args)))
@@ -645,12 +645,12 @@ Prompt for a context, must be a list containting at least one of \"home\",
          (url (mastodon-http--api (format "filters/%s" filter-id))))
     (if (null phrase)
         (error "No filter at point?")
-      (when (y-or-n-p (format "Delete filter %s? " phrase)))
-      (let ((response (mastodon-http--delete url)))
-        (mastodon-http--triage
-         response (lambda ()
-                    (mastodon-views--view-filters)
-                    (message "Filter for \"%s\" deleted!" phrase)))))))
+      (when (y-or-n-p (format "Delete filter %s? " phrase))
+        (let ((response (mastodon-http--delete url)))
+          (mastodon-http--triage
+           response (lambda ()
+                      (mastodon-views--view-filters)
+                      (message "Filter for \"%s\" deleted!" phrase))))))))
 
 
 ;;; FOLLOW SUGGESTIONS
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 63f9a32..bc06570 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -7,7 +7,7 @@
 ;;         Marty Hiatt <martianhiatus@riseup.net>
 ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
 ;; Version: 1.0.0
-;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4") (ts "0.3"))
+;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4"))
 ;; Homepage: https://codeberg.org/martianh/mastodon.el
 
 ;; This file is not part of GNU Emacs.
@@ -224,8 +224,7 @@ Use. e.g. \"%c\" for your locale's date and time format."
 (defcustom mastodon-mode-hook nil
   "Hook run when entering Mastodon mode."
   :type 'hook
-  :options '(provide-discover-context-menu)
-  :group 'mastodon)
+  :options '(provide-discover-context-menu))
 
 (defface mastodon-handle-face
   '((t :inherit default))
@@ -435,7 +434,6 @@ Calls `mastodon-tl--get-buffer-type', which see."
 
 (define-derived-mode mastodon-mode special-mode "Mastodon"
   "Major mode for Mastodon, the federated microblogging network."
-  :group 'mastodon
   (read-only-mode 1))
 
 (provide 'mastodon)