diff options
| -rw-r--r-- | lisp/mastodon-notifications.el | 6 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 78 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 45 |
3 files changed, 67 insertions, 62 deletions
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 1ecdbfb..7c5d40b 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -221,7 +221,7 @@ Status notifications are given when (defun mastodon-notifications--insert-status (toot body author-byline action-byline id - &optional parent-toot) + &optional base-toot) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. @@ -236,10 +236,10 @@ takes a single function. By default it is `mastodon-tl--byline-boosted'. ID is the notification's own id, which is attached as a property. -If the status is a favourite or a boost, PARENT-TOOT is the JSON +If the status is a favourite or a boost, BASE-TOOT is the JSON of the toot responded to." (when toot ; handle rare blank notif server bug - (mastodon-tl--insert-status toot body author-byline action-byline id parent-toot))) + (mastodon-tl--insert-status toot body author-byline action-byline id base-toot))) (defun mastodon-notifications--by-type (note) "Filters NOTE for those listed in `mastodon-notifications--types-alist'." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b352c6d..86a7b56 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -106,12 +106,6 @@ width fonts when rendering HTML text")) :group 'mastodon-tl :type '(boolean :tag "Whether to display user avatars in timelines")) -;; (defvar mastodon-tl--show-avatars nil -;; (if (version< emacs-version "27.1") -;; (image-type-available-p 'imagemagick) -;; (image-transforms-p)) -;; "A boolean value stating whether to show avatars in timelines.") - (defvar-local mastodon-tl--update-point nil "When updating a mastodon buffer this is where new toots will be inserted. @@ -953,7 +947,7 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (mastodon-tl--media toot)))) (defun mastodon-tl--insert-status (toot body author-byline action-byline - &optional id parent-toot detailed-p) + &optional id base-toot detailed-p) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. @@ -965,9 +959,10 @@ such as boosting favouriting and following to the byline. It also takes a single function. By default it is `mastodon-tl--byline-boosted'. -ID is that of the toot, which is attached as a property if it is -a notification. If the status is a favourite or a boost, -PARENT-TOOT is the JSON of the toot responded to. +ID is that of the status if it is a notification, which is +attached as a `toot-id' property if provided. If the +status is a favourite or boost notification, BASE-TOOT is the +JSON of the toot responded to. DETAILED-P means display more detailed info. For now this just means displaying toot client." @@ -978,13 +973,16 @@ this just means displaying toot client." body " \n" (mastodon-tl--byline toot author-byline action-byline detailed-p)) - 'toot-id (or id ; for notifications - (alist-get 'id toot)) + 'toot-id (or id ; notification's own id + (alist-get 'id toot)) ; toot id 'base-toot-id (mastodon-tl--toot-id - ;; if a favourite/boost notif, get ID of toot responded to: - (or parent-toot toot)) + ;; if status is a notif, get id from base-toot + ;; (-tl--toot-id toot) will not work here: + (or base-toot + ;; else normal toot with reblog check: + toot)) 'toot-json toot - 'parent-toot parent-toot) + 'base-toot base-toot) "\n") (when mastodon-tl--display-media-p (mastodon-media--inline-images start-pos (point))))) @@ -1283,20 +1281,11 @@ webapp" (reblog (alist-get 'reblog json))) (if reblog (alist-get 'id reblog) id))) -(defun mastodon-tl--single-toot (&optional id) +(defun mastodon-tl--single-toot (id) "View toot at point in separate buffer. ID is that of the toot to view." (interactive) - (let* ((id - (or id - (if (equal (mastodon-tl--get-endpoint) "notifications") - ;; for boosts/faves: - (if (mastodon-tl--property 'parent-toot) - (mastodon-tl--as-string (mastodon-tl--toot-id - (mastodon-tl--property 'parent-toot))) - (mastodon-tl--property 'base-toot-id)) - (mastodon-tl--property 'base-toot-id)))) - (buffer (format "*mastodon-toot-%s*" id)) + (let* ((buffer (format "*mastodon-toot-%s*" id)) (toot (mastodon-http--get-json (mastodon-http--api (concat "statuses/" id))))) (if (equal (caar toot) 'error) @@ -1312,17 +1301,12 @@ ID is that of the toot to view." (defun mastodon-tl--thread (&optional id) "Open thread buffer for toot at point or with ID." + ;; NB: this is called by `mastodon-url-lookup', which means it must work + ;; without `mastodon-tl--buffer-spec' being set! + ;; so avoid calls to `mastodon-tl--property' and friends (interactive) - (let* ((id - (or id - (if (equal (mastodon-tl--get-endpoint) "notifications") - ;; for boosts/faves: - (if (mastodon-tl--property 'parent-toot) - (mastodon-tl--as-string (mastodon-tl--toot-id - (mastodon-tl--property 'parent-toot))) - (mastodon-tl--property 'base-toot-id)) - (mastodon-tl--property 'base-toot-id)))) - (type (mastodon-tl--field 'type (mastodon-tl--property 'toot-json)))) + (let* ((id (or id (get-text-property (point) 'base-toot-id))) + (type (mastodon-tl--field 'type (get-text-property (point) 'toot-json)))) (if (or (string= type "follow_request") (string= type "follow")) ; no can thread these (error "No thread") @@ -1509,16 +1493,28 @@ BRIEF means to show fewer details. INSTANCE is an instance domain name." (interactive) (mastodon-tl--do-if-toot - (let* ((toot (mastodon-tl--property 'toot-json)) + (let* ((profile-p (get-text-property (point) 'profile-json)) + (toot (if profile-p + (mastodon-tl--property 'profile-json) ; profile may have 0 toots + (mastodon-tl--property 'toot-json))) (reblog (alist-get 'reblog toot)) (account (or (alist-get 'account reblog) (alist-get 'account toot))) - (url (alist-get 'url account)) - (username (alist-get 'username account)) + (url (if profile-p + (alist-get 'url toot) ; profile + (alist-get 'url account))) + (username (if profile-p + (alist-get 'username toot) ;; profile + (alist-get 'username account))) (instance (if instance (concat "https://" instance) - (string-remove-suffix (concat "/@" username) - url))) + ;; pleroma URL is https://instance.com/users/username + (if (string-suffix-p "users/" (url-basepath url)) + (string-remove-suffix "/users/" + (url-basepath url)) + ;; mastodon: + (string-remove-suffix (concat "/@" username) + url)))) (response (mastodon-http--get-json (if user (mastodon-http--api "instance") diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 95eac31..438e887 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -820,16 +820,15 @@ 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)) - ;; NB: we cannot use mastodon-tl--property for 'parent-toot + ;; NB: we cannot use mastodon-tl--property for 'base-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)))) + (base-toot (get-text-property (point) 'base-toot)) ; for new notifs handling + (id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot)))) (account (mastodon-tl--field 'account toot)) (user (alist-get 'acct account)) - (mentions (mastodon-toot--mentions (or parent toot))) - (boosted (mastodon-tl--field 'reblog (or parent toot))) + (mentions (mastodon-toot--mentions (or base-toot toot))) + (boosted (mastodon-tl--field 'reblog (or base-toot toot))) (booster (when boosted (alist-get 'acct (alist-get 'account toot))))) @@ -857,7 +856,7 @@ text of the toot being replied to in the compose buffer." ;; user in mentions already: mentions))) id - (or parent toot)))) + (or base-toot toot)))) (defun mastodon-toot--toggle-warning () "Toggle `mastodon-toot--content-warning'." @@ -968,9 +967,18 @@ which is used to attach it to a toot when posting." collect `(,key . ,o)))) (defun mastodon-toot--fetch-max-poll-options () - "Return the maximum number of poll options from the user's instance. " + "Return the maximum number of poll options." + (mastodon-toot--fetch-poll-field 'max_options)) + +(defun mastodon-toot--fetch-max-poll-option-chars () + "Return the maximum number of characters a poll option may have." + (or (mastodon-toot--fetch-poll-field 'max_characters_per_option) + 50)) ; masto default + +(defun mastodon-toot--fetch-poll-field (field) + "Return FIELD from the poll settings from the user's instance. " (let* ((instance (mastodon-http--get-json (mastodon-http--api "instance")))) - (alist-get 'max_options + (alist-get field (alist-get 'polls (alist-get 'configuration instance) instance)))) @@ -989,19 +997,20 @@ MAX is the maximum number set by their instance." (interactive) ;; re length, API docs show a poll 9 options. (let* ((max-options (mastodon-toot--fetch-max-poll-options)) - (length (mastodon-toot--read-poll-options-count max-options)) + (count (mastodon-toot--read-poll-options-count max-options)) + (length (mastodon-toot--fetch-max-poll-option-chars)) (multiple-p (y-or-n-p "Multiple choice? ")) - (options (mastodon-toot--read-poll-options length)) + (options (mastodon-toot--read-poll-options count length)) (hide-totals (y-or-n-p "Hide votes until poll ends? ")) (expiry (mastodon-toot--get-poll-expiry))) (setq mastodon-toot-poll `(:options ,options :length ,length :multi ,multiple-p :hide ,hide-totals :expiry ,expiry)) (message "poll created!"))) -(defun mastodon-toot--read-poll-options (length) +(defun mastodon-toot--read-poll-options (count length) "Read a list of options for poll of LENGTH options." - (cl-loop for x from 1 to length - collect (read-string (format "Poll option [%s/%s]: " x length)))) + (cl-loop for x from 1 to count + collect (read-string (format "Poll option [%s/%s] [max %s chars]: " x count length)))) (defun mastodon-toot--get-poll-expiry () "Prompt for a poll expiry time." @@ -1253,10 +1262,10 @@ Added to `after-change-functions'." ;; 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_]+" + (mastodon-toot--propertize-item "[\n\t ]\\(?2:#[1-9a-zA-Z_]+\\)[\n\t ]" 'success (cdr header-region)) - (mastodon-toot--propertize-item "@[1-9a-zA-Z._-]+" + (mastodon-toot--propertize-item "[\n\t ]\\(?2:@[1-9a-zA-Z._-]+\\)[\n\t ]" 'mastodon-display-name-face (cdr header-region))))) @@ -1265,8 +1274,8 @@ Added to `after-change-functions'." (save-excursion (goto-char start) (cl-loop while (search-forward-regexp regex nil :noerror) - do (add-text-properties (match-beginning 0) - (match-end 0) + do (add-text-properties (match-beginning 2) + (match-end 2) `(face ,face))))) (defun mastodon-toot-compose-buffer-p () |