branch: elpa/mastodon
commit f6247f0c9b8c15b19e8ddca2f600ceb2cf48beb9
Merge: 163ba2b0b8 e24f6ee5db
Author: marty hiatt <martianhia...@disroot.org>
Commit: marty hiatt <martianhia...@disroot.org>
Merge branch 'develop'
---
README.org | 11 +--
lisp/mastodon-http.el | 7 +-
lisp/mastodon-profile.el | 3 +-
lisp/mastodon-tl.el | 172 ++++++++++++++++++++++++++++++++++++++--------
lisp/mastodon-toot.el | 7 +-
lisp/mastodon.el | 11 ++-
test/mastodon-tl-tests.el | 47 +++++++++++++
7 files changed, 213 insertions(+), 45 deletions(-)
diff --git a/README.org b/README.org
index 1b80e59c3d..caf9b0e629 100644
--- a/README.org
+++ b/README.org
@@ -565,11 +565,12 @@ am=, if you want to actually contribute a commit.
*** Fixes and features
-1. Create an [[https://codeberg.org/martianh/mastodon.el/issues][issue]]
detailing what you'd like to do.
-2. Fork the repository and create a branch off of =develop=.
-3. Run the tests and ensure that your code doesn't break any of them.
-4. Create a pull request (to develop) referencing the issue created in
- step 1.
+1. Install
[[https://cask.readthedocs.io/en/latest/guide/installation.html][Cask]] if you
don't already have it installed
+2. Create an [[https://codeberg.org/martianh/mastodon.el/issues][issue]]
detailing what you'd like to do.
+3. Fork the repository and create a branch off of =develop=.
+4. Run the tests (with =make tests=) and ensure that your code doesn't break
any of them.
+5. Create a pull request (to develop) referencing the issue created in
+ step 2.
*** Coding style
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index a55097dff2..a91f272dd4 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -220,9 +220,10 @@ Callback to `mastodon-http--get-response-async', usually
(goto-char (point-min))
(re-search-forward "^$" nil 'move)
(let ((json-array-type (if vector 'vector 'list))
- (json-string (decode-coding-string
- (buffer-substring-no-properties (point) (point-max))
- 'utf-8)))
+ (json-string (string-trim-right
+ (decode-coding-string
+ (buffer-substring-no-properties (point) (point-max))
+ 'utf-8))))
(kill-buffer)
(cond ((or (string-empty-p json-string) (null json-string))
nil)
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 95d275d253..177179fdf1 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -693,7 +693,8 @@ MAX-ID is a flag to include the max_id pagination
parameter."
(mastodon-profile--image-from-account account 'avatar_static)
(mastodon-profile--image-from-account account 'header_static)
"\n"
- (propertize .display_name 'face 'mastodon-display-name-face)
+ (when .display_name
+ (propertize .display_name 'face 'mastodon-display-name-face))
;; roles
(when .roles
(concat " " (mastodon-profile--render-roles .roles)))
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 508332b098..b1a5b90cdd 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -95,6 +95,9 @@
(autoload 'mastodon-notifications--current-type "mastodon-notifications")
(autoload 'mastodon-notifications--timeline "mastodon-notifications")
(autoload 'mastodon-notifications--empty-group-json-p "mastodon-notifications")
+(autoload 'mastodon-search--print-tags "mastodon-search")
+(autoload 'mastodon-profile-show-user "mastodon-profile")
+
(defvar mastodon-toot--visibility)
(defvar mastodon-toot-mode)
(defvar mastodon-active-user)
@@ -508,8 +511,8 @@ MAX-ID is a flag to add the max_id pagination parameter."
(interactive "p")
(let* ((params
`(("limit" . ,mastodon-tl--timeline-posts-count)
- ,(when max-id
- `("max_id" . ,(mastodon-tl--buffer-property 'max-id))))))
+ ,@(when max-id
+ `(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))))
(message "Loading home timeline...")
(mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil
params
@@ -637,7 +640,8 @@ is extracted from it."
(let ((data (or (alist-get 'account toot)
toot))) ;; grouped nofifs use account data directly
(let-alist data
- (propertize (if (not (string-empty-p .display_name))
+ (propertize (if (and .display_name
+ (not (string-empty-p .display_name)))
.display_name
.username)
'face 'mastodon-display-name-face
@@ -1164,6 +1168,39 @@ the toot)."
(string-prefix-p "/tag" path)) ;; "/tag/" or "/tags/"
(nth 2 split))))
+(defun mastodon-tl--base-tags (tags body-tags)
+ "Return a string of all tags not in BODY-TAGS, linkified.
+TAGS is a list of tag alists, from a post's JSON."
+ (when (mastodon-tl--base-tags-print-p tags body-tags)
+ (concat
+ "\n"
+ (cl-loop for tag in tags
+ concat (concat (mastodon-tl--render-base-tag tag body-tags)
+ " ")))))
+
+(defun mastodon-tl--base-tags-print-p (tags body-tags)
+ "Non-nil if we need to print base tags.
+We need to do so if TAGS contains any elements not in BODY-TAGS."
+ (cl-remove-if (lambda (tag)
+ (member (alist-get 'name tag) body-tags))
+ tags))
+
+(defun mastodon-tl--render-base-tag (tag body-tags)
+ "Return TAG as a linkified string, provided it is not in BODY-TAGS."
+ (let ((name (alist-get 'name tag)))
+ (unless (member (downcase name) body-tags)
+ (mastodon-tl--buttonify-link
+ (concat "#" name)
+ 'mastodon-tab-stop 'hashtag
+ 'mastodon-tag name
+ 'mouse-face '(highlight)
+ 'keymap mastodon-tl--link-keymap
+ 'face '(shr-text shr-link)
+ 'follow-link t
+ 'shr-tab-stop t
+ 'shr-url (alist-get 'url tag)
+ 'help-echo (concat "Browse tag #" name)))))
+
;;; HYPERLINKS
@@ -1796,6 +1833,25 @@ Runs `mastodon-tl--render-text' and fetches poll or
media."
(let ((prev-id (mastodon-tl--prev-item-id)))
(string= reply-to-id prev-id)))
+(defun mastodon-tl--body-tags (body)
+ "Return a plain string list of the tags in BODY."
+ ;; NB: replies on text props 'mastodon-tab-stop and 'shr-url
+ ;; FIXME: snac tags fail our prop test, not sure about others.
+ (let (list prop)
+ (with-temp-buffer
+ (insert body)
+ (goto-char (point-min))
+ (save-match-data
+ (while
+ (setq prop (text-property-search-forward
+ 'mastodon-tab-stop 'hashtag t))
+ (goto-char (prop-match-beginning prop))
+ (let ((tag (mastodon-tl--property 'mastodon-tag)))
+ (when tag
+ (push (downcase tag) list)))
+ (goto-char (prop-match-end prop)))))
+ list))
+
(defun mastodon-tl--insert-status
(toot body &optional detailed-p thread domain unfolded no-byline
cw-expanded)
@@ -1818,7 +1874,8 @@ CW-EXPANDED means treat content warnings as unfolded."
(length> body mastodon-tl--fold-toots-at-length)))
(cw-p (not
(string-empty-p
- (alist-get 'spoiler_text toot)))))
+ (alist-get 'spoiler_text toot))))
+ (body-tags (mastodon-tl--body-tags body)))
(insert
(propertize ;; body + byline:
(concat
@@ -1845,6 +1902,11 @@ CW-EXPANDED means treat content warnings as unfolded."
"LESS" cw-p (not cw-expanded))
""))
'toot-body t) ;; includes newlines etc. for folding
+ ;; post tags:
+ (let ((tags (alist-get 'tags toot)))
+ ;; FIXME: we also need to test here for normal body tags, and if
+ ;; so, don't go ahead:
+ (if tags (concat (mastodon-tl--base-tags tags body-tags)) ""))
;; byline:
"\n"
(if no-byline
@@ -2281,7 +2343,10 @@ call this function after it is set or use something
else."
((mastodon-tl--endpoint-str-= "timelines/link")
'link-timeline)
((mastodon-tl--endpoint-str-= "announcements")
- 'announcements))))
+ 'announcements)
+ ;; followed hashtags
+ ((mastodon-tl--endpoint-str-= "followed_tags")
+ 'followed-hashtags))))
(defun mastodon-tl--buffer-type-eq (type)
"Return t if current buffer type is equal to symbol TYPE."
@@ -2322,7 +2387,8 @@ We hide replies if user explictly set the
`mastodon-tl--hide-replies' or used PREFIX combination to open a
timeline."
(and (mastodon-tl--timeline-proper-p) ; Only if we are in a proper timeline
- (or mastodon-tl--hide-replies ; User configured to hide replies
+ (or (mastodon-tl--buffer-property 'hide-replies nil :noerror)
+ mastodon-tl--hide-replies ; User configured to hide replies
(equal '(4) prefix)))) ; Timeline called with C-u prefix
@@ -2443,10 +2509,15 @@ webapp"
;;; THREADS
-(defun mastodon-tl-single-toot (id)
- "View toot at point in separate buffer.
-ID is that of the toot to view."
+(defun mastodon-tl-view-single-toot ()
+ "View toot at point in a separate buffer."
(interactive)
+ (let ((id (mastodon-tl--property 'base-item-id)))
+ (mastodon-tl--single-toot id)))
+
+(defun mastodon-tl--single-toot (id)
+ "View toot in separate buffer.
+ID is that of the toot to view."
(let* ((buffer (format "*mastodon-toot-%s*" id))
(toot (mastodon-http--get-json
(mastodon-http--api (concat "statuses/" id)))))
@@ -2467,7 +2538,7 @@ ID is that of the toot to view."
(defun mastodon-tl--update-toot (json)
"Call `mastodon-tl-single-toot' on id found in JSON."
(let ((id (alist-get 'id json)))
- (mastodon-tl-single-toot id)))
+ (mastodon-tl--single-toot id)))
(defun mastodon-tl-view-whole-thread ()
"From a thread view, view entire thread.
@@ -2481,6 +2552,19 @@ view all branches of a thread."
(let ((id (mastodon-tl--property 'base-item-id)))
(mastodon-tl--thread-do id))))
+(defun mastodon-tl-return ()
+ "Load user profile or thread of item at point.
+If item at point is a follow or follow request, load user profile.
+Else load thread."
+ (interactive)
+ (let ((notif (mastodon-tl--property 'notification-type)))
+ (if (or (equal "follow" notif)
+ (equal "follow_request" notif))
+ (let* ((json (mastodon-tl--property 'item-json))
+ (handle (alist-get 'acct json)))
+ (mastodon-profile-show-user handle))
+ (mastodon-tl-thread))))
+
(defun mastodon-tl-thread ()
"Open thread buffer for toot at point."
(interactive)
@@ -2493,12 +2577,16 @@ view all branches of a thread."
This is the non-interactive version, so we can call it
programmatically and not crash into
`mastodon-toot--with-toot-item'."
- ;; this function's var must not be id as the above macro binds id and even
- ;; if we provide the arg (e.g. url-lookup), the macro definition overrides
- ;; it, making the optional arg unusable!
+ ;; this function's var must not be id as the above macro binds id and
+ ;; even if we provide the arg (e.g. url-lookup), the macro definition
+ ;; overrides it, making the optional arg unusable!
(let* ((id (or thread-id (mastodon-tl--property 'base-item-id :no-move)))
- (type (mastodon-tl--field 'type
- (mastodon-tl--property 'item-json
:no-move)))
+ (type
+ (if (and (mastodon-tl--buffer-type-eq 'notifications)
+ mastodon-group-notifications)
+ (mastodon-tl--property 'notification-type)
+ (mastodon-tl--field 'type
+ (mastodon-tl--property 'item-json :no-move))))
(unfolded-state (mastodon-tl--buffer-property 'thread-unfolded
(current-buffer)
:noerror))
(mastodon-tl--expand-content-warnings
@@ -2524,7 +2612,7 @@ programmatically and not crash into
(if (not (< 0 (+ (length (alist-get 'ancestors context))
(length (alist-get 'descendants context)))))
;; just print the lone toot:
- (mastodon-tl-single-toot id)
+ (mastodon-tl--single-toot id)
;; we have a thread:
(with-mastodon-buffer buffer #'mastodon-mode nil
(let ((marker (make-marker)))
@@ -2988,8 +3076,8 @@ If TAG is provided, unfollow it."
(lambda (_)
(message "tag #%s unfollowed!" tag)))))
-(defun mastodon-tl-list-followed-tags (&optional prefix)
- "List followed tags. View timeline of tag user choses.
+(defun mastodon-tl-jump-to-followed-tag (&optional prefix)
+ "Prompt for a followed tag and view its timeline.
PREFIX is sent to `mastodon-tl-get-tag-timeline', which see."
(interactive "p")
(let* ((followed-tags-json (mastodon-tl--followed-tags))
@@ -2999,6 +3087,25 @@ PREFIX is sent to `mastodon-tl-get-tag-timeline', which
see."
(user-error "You have to follow some tags first")
(mastodon-tl-get-tag-timeline prefix tag))))
+(defun mastodon-tl-list-followed-tags ()
+ "List followed tags. View timeline of tag user choses.
+PREFIX is sent to `mastodon-tl-get-tag-timeline', which see."
+ (interactive)
+ (let* ((json (mastodon-tl--followed-tags))
+ (sorted (sort json :key (lambda (x)
+ (downcase (alist-get 'name x)))))
+ (buf "*mastodon-followed-tags*"))
+ (if (null sorted)
+ (user-error "You have to follow some tags first")
+ (with-mastodon-buffer (get-buffer-create buf)
+ #'mastodon-mode nil
+ (mastodon-tl--set-buffer-spec
+ buf "followed_tags" #'mastodon-tl-list-followed-tags)
+ (mastodon-search--insert-heading "followed tags")
+ (insert "\n")
+ (mastodon-search--print-tags sorted)
+ (goto-char (point-min))))))
+
(defun mastodon-tl-followed-tags-timeline (&optional prefix)
"Open a timeline of multiple tags.
With a single PREFIX arg, only show posts with media.
@@ -3279,20 +3386,22 @@ and profile pages when showing followers or accounts
followed."
(mastodon-tl--update-params)
'mastodon-tl--more* (current-buffer) (point)))
(t ;; max_id paginate (timelines, items with ids/timestamps):
- (let ((max-id (mastodon-tl--oldest-id)))
+ (let ((max-id (mastodon-tl--oldest-id))
+ (params (mastodon-tl--update-params)))
(mastodon-tl--more-json-async
(mastodon-tl--endpoint)
- max-id
- (mastodon-tl--update-params)
- 'mastodon-tl--more* (current-buffer) (point) nil max-id))))))
+ max-id params
+ 'mastodon-tl--more*
+ (current-buffer) (point) nil max-id))))))
-(defun mastodon-tl--more* (response buffer point-before
- &optional headers max-id)
+(defun mastodon-tl--more*
+ (response buffer point-before &optional headers max-id)
"Append older toots to timeline, asynchronously.
Runs the timeline's update function on RESPONSE, in BUFFER.
When done, places point at POINT-BEFORE.
HEADERS is the http headers returned in the response, if any.
-MAX-ID is the pagination parameter, a string."
+MAX-ID is the pagination parameter, a string.
+UPDATE-PARAMS is from prev buffer spec, added to the new one."
(with-current-buffer buffer
(if (not response)
(user-error "No more results")
@@ -3335,10 +3444,12 @@ MAX-ID is the pagination parameter, a string."
(goto-char point-before)
;; update buffer spec to new link-header or max-id:
;; (other values should just remain as they were)
- (mastodon-tl--set-buffer-spec (mastodon-tl--buffer-name)
- (mastodon-tl--endpoint)
- (mastodon-tl--update-function)
- link-header nil nil max-id)
+ (mastodon-tl--set-buffer-spec
+ (mastodon-tl--buffer-name)
+ (mastodon-tl--endpoint)
+ (mastodon-tl--update-function)
+ link-header (mastodon-tl--update-params)
+ (mastodon-tl--hide-replies-p) max-id)
(message "Loading... done.")))))))
(defun mastodon-tl--find-property-range (property start-point
@@ -3507,7 +3618,8 @@ This location is defined by a non-nil value of
"Update timeline with new toots."
(interactive)
;; FIXME: actually these buffers should just reload by calling their own
- ;; load function (actually g is mostly mapped as such):
+ ;; load function (actually g is mostly mapped as such)
+ ;; well actually, g should be for reload, update is different.
(if (or (member (mastodon-tl--get-buffer-type)
'(trending-statuses
trending-tags
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 9ebb1ef0c7..697e582049 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -258,7 +258,7 @@ send.")
(defvar mastodon-toot-tag-regex
(rx (| (any ?\( "\n" "\t" " ") bol)
- (group-n 2 ?# (+ (any "A-Z" "a-z" "0-9")))
+ (group-n 2 ?# (+ (any "_" "A-Z" "a-z" "0-9")))
(| "'" word-boundary))) ; boundary or possessive
(defvar mastodon-toot-emoji-regex
@@ -1486,8 +1486,9 @@ Return a cons of a human readable string, and a
seconds-from-now string."
(response (completing-read "poll ends in [or enter seconds]: "
options nil 'confirm)))
(or (assoc response options #'string=)
- (if (< (string-to-number response) 600)
- (car options))))) ;; min 5 mins
+ (if (< (string-to-number response) 300)
+ (cons "5 minutes" (number-to-string (* 60 5))) ;; min 5 mins
+ (cons (format "%s seconds" response) response)))))
(defun mastodon-toot--poll-expiry-options-alist ()
"Return an alist of expiry options options in seconds."
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 1e973d78de..185a85edd9 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -6,7 +6,7 @@
;; Author: Johnson Denen <johnson.de...@gmail.com>
;; Marty Hiatt <mouse...@disroot.org>
;; Maintainer: Marty Hiatt <mouse...@disroot.org>
-;; Version: 2.0.0
+;; Version: 2.0.1
;; Package-Requires: ((emacs "28.1") (persist "0.4") (tp "0.7"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
@@ -73,6 +73,8 @@
(when (require 'lingva nil :no-error)
(autoload 'mastodon-toot-translate-toot-text "mastodon-toot"))
(autoload 'mastodon-toot--view-toot-history "mastodon-tl")
+(autoload 'mastodon-tl-return "mastodon-tl")
+(autoload 'mastodon-tl-jump-to-followed-tag "mastodon-tl")
;; for M-x visibility
;; (views.el uses `mastodon-mode-map', so we can't easily require it)
@@ -228,6 +230,7 @@ Also nil `mastodon-auth--token-alist'."
;; navigation between timelines
(define-key map (kbd "#") #'mastodon-tl-get-tag-timeline)
(define-key map (kbd "\"") #'mastodon-tl-list-followed-tags)
+ (define-key map (kbd "C-\"") #'mastodon-tl-jump-to-followed-tag)
(define-key map (kbd "'") #'mastodon-tl-followed-tags-timeline)
(define-key map (kbd "C-'") #'mastodon-tl-tag-group-timeline)
(define-key map (kbd "A") #'mastodon-profile-get-toot-author)
@@ -256,7 +259,7 @@ Also nil `mastodon-auth--token-alist'."
(define-key map (kbd "v") #'mastodon-tl-poll-vote)
(define-key map (kbd "E") #'mastodon-toot-view-toot-edits)
(define-key map (kbd "T") #'mastodon-tl-thread)
- (define-key map (kbd "RET") #'mastodon-tl-thread)
+ (define-key map (kbd "RET") #'mastodon-tl-return)
(define-key map (kbd "m") #'mastodon-tl-dm-user)
(define-key map (kbd "=") #'mastodon-tl-view-first-full-image)
(when (require 'lingva nil :no-error)
@@ -518,7 +521,9 @@ If FORCE, do a lookup regardless of the result of
`mastodon--fedi-url-p'."
(string-match "^/comment/[[:digit:]]+$" query) ; lemmy
(string-match "^/@[^/]+/statuses/[[:alnum:]]" query) ; GTS
(string-match "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$"
query) ; hometown
- (string-match "^/notes/[[:alnum:]]+$" query))))) ; misskey post
+ (string-match "^/notes/[[:alnum:]]+$" query) ; misskey post
+ (string-match "^/w/[[:alnum:]_]+$" query) ; peertube post
+ ))))
(defun mastodon-live-buffers ()
"Return a list of open mastodon buffers.
diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index a4f6fa8249..6078cf2927 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -110,6 +110,35 @@
(reblogged)))
"A sample reblogged/boosted toot (parsed json)")
+(defconst mastodon-tl-test-empty-display-name
+ '((id . 61208)
+ (created_at . "2017-04-24T19:01:02.000Z")
+ (in_reply_to_id)
+ (in_reply_to_account_id)
+ (sensitive . :json-false)
+ (spoiler_text . "")
+ (visibility . "public")
+ (account (id . 42)
+ (username . "acct42")
+ (acct . "acct42@example.space")
+ (display_name . nil)
+ (locked . :json-false)
+ (created_at . "2017-04-01T00:00:00.000Z")
+ (followers_count . 99)
+ (following_count . 13)
+ (statuses_count . 101)
+ (note . "E"))
+ (media_attachments . ())
+ (mentions . ())
+ (tags . ())
+ (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status")
+ (url . "https://example.space/users/acct42/updates/123456789";)
+ (content . "<p>Just some text</p>")
+ (reblogs_count . 0)
+ (favourites_count . 0)
+ (reblog))
+ "A sample toot (parsed json)")
+
(defconst mastodon-tl--follow-notify-true-response
"HTTP/1.1 200 OK
Date: Mon, 20 Dec 2021 13:42:29 GMT
@@ -532,6 +561,24 @@ Strict-Transport-Security: max-age=31536000
"7 years, 4 months ago"
(plist-get properties 'display)))))))
+(ert-deftest mastodon-tl--byline-no-displayname ()
+ "Should not fail when display_name is nil."
+ (let* ((mastodon-tl--show-avatars-p nil)
+ (toot (cons '(reblogged . t) mastodon-tl-test-empty-display-name))
+ (timestamp (cdr (assoc 'created_at toot))))
+ (with-mock
+ (mock (date-to-time timestamp) => '(22782 21551))
+ (mock (mastodon-tl--symbol 'boost) => "B")
+ (mock (mastodon-tl--toot-stats toot) => "")
+ (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551))
=> "2999-99-99 00:11:22")
+
+ (should (string= (substring-no-properties
+ (mastodon-tl--byline toot))
+ (concat "(B) acct42 (@acct42@example.space) 2999-99-99
00:11:22
+ "
+ mastodon-tl--horiz-bar "
+"))))))
+
(ert-deftest mastodon-tl--consider-timestamp-for-updates-no-active-callback ()
"Should update the timestamp update variables as expected."
