Merge branch 'develop' into headers

3 files changed, 110 insertions, 38 deletions

diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index a9c8b39..a3ef2ae 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -5,7 +5,7 @@
 ;;         Marty Hiatt <martianhiatus@riseup.net>
 ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
 ;; Version: 1.0.0
-;; Package-Requires: ((emacs "27.1"))
+;; Package-Requires: ((emacs "27.1") (ts "0.3"))
 ;; Homepage: https://codeberg.org/martianh/mastodon.el
 
 ;; This file is not part of GNU Emacs.
@@ -32,6 +32,7 @@
 ;;; Code:
 
 (require 'shr)
+(require 'ts)
 (require 'thingatpt) ; for word-at-point
 (require 'time-date)
 (require 'cl-lib)
@@ -371,12 +372,12 @@ Used on initializing a timeline or thread."
      (propertize (concat "@" handle)
                  'face 'mastodon-handle-face
                  'mouse-face 'highlight
-		 'mastodon-tab-stop 'user-handle
+		         'mastodon-tab-stop 'user-handle
                  'account account
-		 'shr-url profile-url
-		 'keymap mastodon-tl--link-keymap
+		         'shr-url profile-url
+		         'keymap mastodon-tl--link-keymap
                  'mastodon-handle (concat "@" handle)
-		 'help-echo (concat "Browse user profile of @" handle))
+		         'help-echo (concat "Browse user profile of @" handle))
      ")")))
 
 (defun mastodon-tl--format-faves-count (toot)
@@ -592,10 +593,10 @@ this just means displaying toot client."
                           'face 'mastodon-display-name-face
                           'follow-link t
                           'mouse-face 'highlight
-		          'mastodon-tab-stop 'shr-url
-		          'shr-url app-url
+		                  'mastodon-tab-stop 'shr-url
+		                  'shr-url app-url
                           'help-echo app-url
-		          'keymap mastodon-tl--shr-map-replacement)))))
+		                  'keymap mastodon-tl--shr-map-replacement)))))
        (propertize "\n  ------------\n" 'face 'default))
       'favourited-p faved
       'boosted-p    boosted
@@ -949,6 +950,7 @@ this just means displaying toot client."
          (expiry (mastodon-tl--field 'expires_at poll))
          (expired-p (if (eq (mastodon-tl--field 'expired poll) :json-false) nil t))
          (multi (mastodon-tl--field 'multiple poll))
+         (vote-count (mastodon-tl--field 'voters_count poll))
          (options (mastodon-tl--field 'options poll))
          (option-titles (mapcar (lambda (x)
                                   (alist-get 'title x))
@@ -971,19 +973,31 @@ this just means displaying toot client."
                                         (length (alist-get 'title
                                                            option))))
                                     ?\ )
-                                   (if (eq (alist-get 'votes_count option) nil)
-                                       ""
-                                     (format "[%s votes]" (alist-get 'votes_count option))))))
+                                   ;; TODO: disambiguate no votes from hidden votes
+                                   (format "[%s votes]" (or (alist-get 'votes_count option)
+                                                            "0")))))
                        options
                        "\n")
-            (unless expired-p
-              (propertize (format "Expires: %s" expiry)
-                          'face 'font-lock-comment-face))
-            (when expired-p
-              (propertize "Poll expired."
-                          'face 'font-lock-comment-face))
+            "\n"
+            (propertize (format "%s people | " vote-count)
+                        'face 'font-lock-comment-face)
+            (let ((str (if expired-p
+                           "Poll expired."
+                         (mastodon-tl--format-poll-expiry expiry))))
+              (propertize str 'face 'font-lock-comment-face))
             "\n")))
 
+(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))))))
+
 (defun mastodon-tl--poll-vote (option)
   "If there is a poll at point, prompt user for OPTION to vote on it."
   (interactive
@@ -1519,7 +1533,7 @@ IND is the optional indentation level to print at."
             (when ind (indent-to ind))
             (insert (mastodon-tl--format-key el pad)
                     " "
-                    (mastodon-tl--newline-if-long el)
+                    (mastodon-tl--newline-if-long (cdr el))
                     ;; only send strings straight to --render-text
                     ;; this makes hyperlinks work:
                     (if (not (stringp val))
@@ -1529,25 +1543,36 @@ IND is the optional indentation level to print at."
                     "\n"))))))))
 
 (defun mastodon-tl--print-instance-rules-or-fields (alist)
-  "Print ALIST of instance rules or contact account fields."
-  (let ((key   (if (alist-get 'id alist) 'id 'name))
-        (value (if (alist-get 'id alist) 'text 'value)))
+  "Print ALIST of instance rules or contact account or emoji fields."
+  (let ((key   (cond ((alist-get 'id alist)
+                      'id)
+                     ((alist-get 'name alist)
+                      'name)
+                     ((alist-get 'shortcode alist)
+                      'shortcode)))
+        (value (cond ((alist-get 'id alist)
+                      'text)
+                     ((alist-get 'value alist)
+                      'value)
+                     ((alist-get 'url alist)
+                      'url))))
     (indent-to 4)
     (insert
      (format "%-5s: "
              (propertize (alist-get key alist)
                          'face '(:underline t)))
-            (mastodon-tl--newline-if-long (assoc value alist))
-            (format "%s" (mastodon-tl--render-text
-                          (alist-get value alist)))
-            "\n")))
+     (mastodon-tl--newline-if-long (alist-get value alist))
+     (format "%s" (mastodon-tl--render-text
+                   (alist-get value alist)))
+     "\n")))
 
 (defun mastodon-tl--newline-if-long (el)
   "Return a newline string if the cdr of EL is over 50 characters long."
-  (if (and (sequencep (cdr el))
-           (< 50 (length (cdr el))))
-      "\n"
-    ""))
+  (let ((rend (if (stringp el) (mastodon-tl--render-text el) el)))
+    (if (and (sequencep rend)
+             (< 50 (length rend)))
+        "\n"
+      "")))
 
 (defun mastodon-tl--follow-user (user-handle &optional notify)
   "Query for USER-HANDLE from current status and follow that user.
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 25446ef..70aaf14 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -603,7 +603,7 @@ to `emojify-user-emojis', and the emoji data is updated."
 (defun mastodon-toot--build-poll-params ()
   "Return an alist of parameters for POSTing a poll status."
   (append
-   (mastodon-toot--make-poll-params
+   (mastodon-toot--make-poll-options-params
     (plist-get mastodon-toot-poll :options))
    `(("poll[expires_in]" .  ,(plist-get mastodon-toot-poll :expiry)))
    `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi))))
@@ -941,7 +941,7 @@ which is used to attach it to a toot when posting."
                 mastodon-toot--media-attachments))
       (list "None")))
 
-(defun mastodon-toot--make-poll-params (options)
+(defun mastodon-toot--make-poll-options-params (options)
   "Return an parameter query alist from poll OPTIONS."
   (let ((key "poll[options][]"))
     (cl-loop for o in options
@@ -951,8 +951,8 @@ which is used to attach it to a toot when posting."
   "Prompt for new poll options and return as a list."
   (interactive)
   ;; re length, API docs show a poll 9 options.
-  (let* ((length (read-number "Number of poll options [2-9]: " 2))
-         (multiple-p (y-or-n-p "Multiple choice poll? "))
+  (let* ((length (read-number "Number of options [2-4]: " 2))
+         (multiple-p (y-or-n-p "Multiple choice? "))
          (options (mastodon-toot--read-poll-options length))
          (hide-totals (y-or-n-p "Hide votes until poll ends? "))
          (expiry (mastodon-toot--get-poll-expiry)))
@@ -968,8 +968,25 @@ which is used to attach it to a toot when posting."
 (defun mastodon-toot--get-poll-expiry ()
   "Prompt for a poll expiry time."
   ;; API requires this in seconds
-  ;; TODO: offer sane poll expiry options
-  (read-string "poll ends in [seconds, min 5 mins]: "))
+  (let* ((options (mastodon-toot--poll-expiry-options-alist))
+         (response (completing-read "poll ends in [or enter seconds]: "
+                                    options nil 'confirm)))
+    (or (alist-get response options nil nil #'equal)
+        (if (< (string-to-number response) 600)
+            "600" ;; min 5 mins
+          response))))
+
+(defun mastodon-toot--poll-expiry-options-alist ()
+  "Return an alist of seconds options."
+  `(("5 minutes" . ,(number-to-string (* 60 5)))
+    ("30 minutes" . ,(number-to-string (* 60 30)))
+    ("1 hour" . ,(number-to-string (* 60 60)))
+    ("6 hours" . ,(number-to-string (* 60 60 6)))
+    ("1 day" . ,(number-to-string (* 60 60 24)))
+    ("3 days" . ,(number-to-string (* 60 60 24 3)))
+    ("7 days" . ,(number-to-string (* 60 60 24 7)))
+    ("14 days" . ,(number-to-string (* 60 60 24 14)))
+    ("30 days" . ,(number-to-string (* 60 60 24 30)))))
 
 ;; we'll need to revisit this if the binds get
 ;; more diverse than two-chord bindings
@@ -1187,6 +1204,33 @@ Added to `after-change-functions' in new toot buffers."
   (setq mastodon-toot-draft-toots-list nil)
   (message "All drafts deleted!"))
 
+(defun mastodon-toot--propertize-tags-and-handles (&rest _args)
+  "Propertize tags and handles in toot compose buffer.
+Added to `after-change-functions'."
+  (when (mastodon-toot-compose-buffer-p)
+    (let ((header-region
+           (mastodon-tl--find-property-range 'toot-post-header
+                                             (point-min))))
+      ;; cull any prev props:
+      ;; stops all text after a handle or mention being propertized:
+      (set-text-properties (cdr header-region) (point-max) nil)
+      ;; TODO: confirm allowed hashtag/handle characters:
+      (mastodon-toot--propertize-item "#[1-9a-zA-Z_]+"
+                                      'success
+                                      (cdr header-region))
+      (mastodon-toot--propertize-item "@[1-9a-zA-Z._-]+"
+                                      'mastodon-display-name-face
+                                      (cdr header-region)))))
+
+(defun mastodon-toot--propertize-item (regex face start)
+  "Propertize item matching REGEX with FACE starting from START."
+  (save-excursion
+    (goto-char start)
+    (cl-loop while (search-forward-regexp regex nil :noerror)
+             do (add-text-properties (match-beginning 0)
+                                     (match-end 0)
+                                     `(face ,face)))))
+
 (defun mastodon-toot-compose-buffer-p ()
   "Return t if compose buffer is current."
   (equal (buffer-name (current-buffer)) "*new toot*"))
@@ -1236,6 +1280,7 @@ a draft into the buffer."
     ;; draft toot text saving:
     (setq mastodon-toot-current-toot-text nil)
     (push #'mastodon-toot--save-toot-text after-change-functions)
+    (push #'mastodon-toot--propertize-tags-and-handles after-change-functions)
     (when initial-text
       (insert initial-text))))
 
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index a5ba9e4..3b0a7d0 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -1,11 +1,13 @@
-;;; mastodon.el --- Client for Mastodon  -*- lexical-binding: t -*-
+;;; mastodon.el --- Client for Mastodon, a federated social network  -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2022 Marty Hiatt
 ;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org>
 ;; Author: Johnson Denen <johnson.denen@gmail.com>
+;;         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"))
+;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4") (ts "0.3"))
 ;; Homepage: https://codeberg.org/martianh/mastodon.el
 
 ;; This file is not part of GNU Emacs.
@@ -29,7 +31,7 @@
 
 ;; mastodon.el is an Emacs client for Mastodon <https://github.com/tootsuite/mastodon>,
 ;; the federated microblogging social network. It also works with Pleroma instances.
-;; see the readme file at https://codeberg.org/martianh/mastodon.el for set up and usage details.
+;; See the readme file at https://codeberg.org/martianh/mastodon.el for set up and usage details.
 
 ;;; Code:
 (require 'cl-lib) ; for `cl-some' call in mastodon