aboutsummaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus [a t] riseup [d o t] net>2022-11-26 16:20:25 +0100
committermarty hiatt <martianhiatus [a t] riseup [d o t] net>2022-11-26 16:20:25 +0100
commitfe1705d5453d9a8b1293e59b3e4bd57620e5a876 (patch)
tree8aa383d626b273084f5111834bedb535eee99bc4 /lisp
parentfc003dced37165fdf36223461216304ae4d0b420 (diff)
parent75896755e97a75523eb9e4a8aef3d30350c30299 (diff)
Merge branch 'develop' into filter-follow-by-lang
Diffstat (limited to 'lisp')
-rw-r--r--lisp/mastodon-async.el13
-rw-r--r--lisp/mastodon-profile.el57
-rw-r--r--lisp/mastodon-search.el19
-rw-r--r--lisp/mastodon-tl.el114
-rw-r--r--lisp/mastodon-toot.el41
5 files changed, 130 insertions, 114 deletions
diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el
index 8a08416..58e7b93 100644
--- a/lisp/mastodon-async.el
+++ b/lisp/mastodon-async.el
@@ -229,14 +229,11 @@ ENDPOINT is the endpoint for the stream and timeline."
(mastodon-tl--timeline (mastodon-http--get-json
(mastodon-http--api endpoint))))
(mastodon-mode)
- (setq mastodon-tl--buffer-spec
- `(buffer-name
- ,buffer-name
- endpoint ,endpoint
- update-function
- ,(if (equal name "notifications")
- 'mastodon-notifications--timeline
- 'mastodon-tl--timeline)))
+ (mastodon-tl--set-buffer-spec buffer-name
+ endpoint
+ ,(if (equal name "notifications")
+ 'mastodon-notifications--timeline
+ 'mastodon-tl--timeline))
(setq-local mastodon-tl--enable-relative-timestamps nil)
(setq-local mastodon-tl--display-media-p t)
(current-buffer))))
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 3ba00b9..1200972 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -71,6 +71,10 @@
(autoload 'mastodon-tl--get-endpoint "mastodon-tl.el")
(autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot")
(autoload 'mastodon-tl--add-account-to-list "mastodon-tl")
+(autoload 'mastodon-http--get-response "mastodon-http")
+(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl")
+(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl")
+(autoload 'mastodon-tl--symbol "mastodon-tl")
(defvar mastodon-instance-url)
(defvar mastodon-tl--buffer-spec)
@@ -186,7 +190,9 @@ NO-REBLOGS means do not display boosts in statuses."
(mastodon-profile--make-profile-buffer-for
mastodon-profile--account
"following"
- #'mastodon-profile--add-author-bylines)
+ #'mastodon-profile--add-author-bylines
+ nil
+ :headers)
(error "Not in a mastodon profile")))
(defun mastodon-profile--open-followers ()
@@ -196,7 +202,9 @@ NO-REBLOGS means do not display boosts in statuses."
(mastodon-profile--make-profile-buffer-for
mastodon-profile--account
"followers"
- #'mastodon-profile--add-author-bylines)
+ #'mastodon-profile--add-author-bylines
+ nil
+ :headers)
(error "Not in a mastodon profile")))
(defun mastodon-profile--view-favourites ()
@@ -279,7 +287,8 @@ JSON is the data returned by the server."
(defun mastodon-profile--update-user-profile-note ()
"Fetch user's profile note and display for editing."
(interactive)
- (let* ((url (mastodon-http--api "accounts/verify_credentials"))
+ (let* ((endpoint "accounts/verify_credentials")
+ (url (mastodon-http--api endpoint))
(json (mastodon-http--get-json url))
(source (alist-get 'source json))
(note (alist-get 'note source))
@@ -287,6 +296,9 @@ JSON is the data returned by the server."
(inhibit-read-only t))
(switch-to-buffer-other-window buffer)
(text-mode)
+ (mastodon-tl--set-buffer-spec (buffer-name buffer)
+ endpoint
+ nil)
(setq-local header-line-format
(propertize
"Edit your profile note. C-c C-c to send, C-c C-k to cancel."
@@ -489,6 +501,9 @@ This endpoint only holds a few preferences. For others, see
(switch-to-buffer-other-window buf)
(erase-buffer)
(special-mode)
+ (mastodon-tl--set-buffer-spec (buffer-name buf)
+ "preferences"
+ nil)
(let ((inhibit-read-only t))
(while response
(let ((el (pop response)))
@@ -552,16 +567,24 @@ FIELDS means provide a fields vector fetched by other means."
(defun mastodon-profile--make-profile-buffer-for (account endpoint-type
update-function
- &optional no-reblogs)
+ &optional no-reblogs headers)
"Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION.
-NO-REBLOGS means do not display boosts in statuses."
+NO-REBLOGS means do not display boosts in statuses.
+HEADERS means also fetch link headers for pagination."
(let* ((id (mastodon-profile--account-field account 'id))
(args (when no-reblogs '(("exclude_reblogs" . "t"))))
(url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type)))
(acct (mastodon-profile--account-field account 'acct))
(buffer (concat "*mastodon-" acct "-" endpoint-type "*"))
+ (response (if headers
+ (mastodon-http--get-response url args)
+ (mastodon-http--get-json url args)))
+ (json (if headers (car response) response))
+ (endpoint (format "accounts/%s/%s" id endpoint-type))
+ (link-header (when headers
+ (mastodon-tl--get-link-header-from-response
+ (cdr response))))
(note (mastodon-profile--account-field account 'note))
- (json (mastodon-http--get-json url args))
(locked (mastodon-profile--account-field account 'locked))
(followers-count (mastodon-tl--as-string
(mastodon-profile--account-field
@@ -585,11 +608,11 @@ NO-REBLOGS means do not display boosts in statuses."
(switch-to-buffer buffer)
(mastodon-mode)
(mastodon-profile-mode)
- (setq mastodon-profile--account account
- mastodon-tl--buffer-spec
- `(buffer-name ,buffer
- endpoint ,(format "accounts/%s/%s" id endpoint-type)
- update-function ,update-function))
+ (setq mastodon-profile--account account)
+ (mastodon-tl--set-buffer-spec buffer
+ endpoint
+ update-function
+ link-header)
(let* ((inhibit-read-only t)
(is-statuses (string= endpoint-type "statuses"))
(is-followers (string= endpoint-type "followers"))
@@ -612,9 +635,7 @@ NO-REBLOGS means do not display boosts in statuses."
(propertize (concat "@" acct)
'face 'default)
(if (equal locked t)
- (if (fontp (char-displayable-p #10r9993))
- " 🔒"
- " [locked]")
+ (concat " " (mastodon-tl--symbol 'locked))
"")
"\n ------------\n"
;; profile note:
@@ -722,14 +743,6 @@ IMG_TYPE is the JSON key from the account data."
(message "Loading your profile...")
(mastodon-profile--show-user (mastodon-auth--get-account-name)))
-(defun mastodon-profile--view-author-profile ()
- "View the profile of author of present toot."
- (interactive)
- (let* ((toot-json (mastodon-tl--property 'toot-json))
- (acct (alist-get 'account toot-json))
- (handle (alist-get 'acct acct)))
- (mastodon-profile--show-user handle)))
-
(defun mastodon-profile--account-field (account field)
"Return FIELD from the ACCOUNT.
FIELD is used to identify regions under 'account"
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index 65c5aba..4aa5721 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -40,12 +40,13 @@
(autoload 'mastodon-auth--access-token "mastodon-auth")
(autoload 'mastodon-http--get-search-json "mastodon-http")
(autoload 'mastodon-http--api "mastodon-http")
+(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl")
+
(defvar mastodon-toot--completion-style-for-mentions)
(defvar mastodon-instance-url)
(defvar mastodon-tl--link-keymap)
(defvar mastodon-http--timeout)
(defvar mastodon-toot--enable-completion-for-mentions)
-(defvar mastodon-tl--buffer-spec)
;; functions for completion of mentions in mastodon-toot
@@ -101,11 +102,9 @@ QUERY is the string to search."
(mastodon-mode)
(let ((inhibit-read-only t))
(erase-buffer)
- (setq mastodon-tl--buffer-spec
- `(buffer-name ,buffer
- endpoint ,(format "api/v1/trends")
- update-function
- (lambda (toot) (message "Trends."))))
+ (mastodon-tl--set-buffer-spec buffer
+ "api/v1/trends"
+ nil)
;; hashtag results:
(insert (mastodon-tl--set-face
(concat "\n ------------\n"
@@ -141,11 +140,9 @@ QUERY is the string to search."
(mastodon-mode)
(let ((inhibit-read-only t))
(erase-buffer)
- (setq mastodon-tl--buffer-spec
- `(buffer-name ,buffer
- endpoint ,(format "api/v2/search")
- update-function
- (lambda (toot) (message "Searched."))))
+ (mastodon-tl--set-buffer-spec buffer
+ "api/v2/search"
+ nil)
;; user results:
(insert (mastodon-tl--set-face
(concat "\n ------------\n"
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 3b9a8c6..7d23b69 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -123,6 +123,23 @@ nil."
:group 'mastodon-tl
:type '(boolean :tag "Whether to display user avatars in timelines"))
+(defcustom mastodon-tl--symbols
+ '((reply . ("💬" . "R"))
+ (boost . ("🔁" . "B"))
+ (favourite . ("⭐" . "F"))
+ (bookmark . ("🔖" . "K"))
+ (media . ("📹" . "[media]"))
+ (verified . ("" . "V"))
+ (locked . ("🔒" . "[locked]"))
+ (private . ("🔒" . "[followers]"))
+ (direct . ("✉" . "[direct]"))
+ (edited . ("✍" . "[edited]")))
+ "A set of symbols (and fallback strings) to be used in timeline.
+If a symbol does not look right (tofu), it means your
+font settings do not support it."
+ :type '(alist :key-type symbol :value-type string)
+ :group 'mastodon-tl)
+
(defvar-local mastodon-tl--update-point nil
"When updating a mastodon buffer this is where new toots will be inserted.
@@ -137,10 +154,6 @@ If nil `(point-min)' is used instead.")
(defvar-local mastodon-tl--timestamp-update-timer nil
"The timer that, when set will scan the buffer to update the timestamps.")
-(defvar mastodon-tl--link-header-buffers
- '("*mastodon-favourites*" "*mastodon-bookmarks*")
- "A list of buffers that use link headers for pagination.")
-
;; KEYMAPS
(defvar mastodon-tl--link-keymap
@@ -242,11 +255,21 @@ types of mastodon links and not just shr.el-generated ones.")
(when (require 'mpv nil :no-error)
(let ((map (make-sparse-keymap)))
(define-key map (kbd "<C-return>") 'mastodon-tl--mpv-play-video-from-byline)
- (define-key map (kbd "<return>") 'mastodon-profile--view-author-profile)
+ (define-key map (kbd "<return>") 'mastodon-profile--get-toot-author)
(keymap-canonicalize map)))
"The keymap to be set for the author byline.
It is active where point is placed by `mastodon-tl--goto-next-toot.'")
+(defun mastodon-tl--symbol (name)
+ "Return the unicode symbol (as a string) corresponding to NAME.
+If symbol is not displayable, an ASCII equivalent is returned. If
+NAME is not part of the symbol table, '?' is returned."
+ (if-let* ((symbol (alist-get name mastodon-tl--symbols)))
+ (if (char-displayable-p (string-to-char (car symbol)))
+ (car symbol)
+ (cdr symbol))
+ "?"))
+
;; NAV
(defun mastodon-tl--next-tab-item ()
@@ -623,13 +646,13 @@ this just means displaying toot client."
;; the toot having just been favourited/boosted.
(concat (when boosted
(mastodon-tl--format-faved-or-boosted-byline
- (mastodon-tl--return-boost-char)))
+ (mastodon-tl--symbol 'boost)))
(when faved
(mastodon-tl--format-faved-or-boosted-byline
- (mastodon-tl--return-fave-char)))
+ (mastodon-tl--symbol 'favourite)))
(when bookmarked
(mastodon-tl--format-faved-or-boosted-byline
- (mastodon-tl--return-bookmark-char))))
+ (mastodon-tl--symbol 'bookmark))))
;; we remove avatars from the byline also, so that they also do not mess
;; with `mastodon-tl--goto-next-toot':
(when (and mastodon-tl--show-avatars
@@ -645,14 +668,9 @@ this just means displaying toot client."
(funcall author-byline toot)
;; visibility:
(cond ((equal visibility "direct")
- (if (fontp (char-displayable-p #10r9993))
- " ✉"
- " [direct]"))
+ (concat " " (mastodon-tl--symbol 'direct)))
((equal visibility "private")
- (if (fontp (char-displayable-p #10r128274))
- " 🔒"
- " [followers]")))
- ;; action:
+ (concat " " (mastodon-tl--symbol 'private))))
(funcall action-byline toot)
" "
;; TODO: Once we have a view for toot (responses etc.) make
@@ -680,9 +698,9 @@ this just means displaying toot client."
'keymap mastodon-tl--shr-map-replacement)))))
(if edited-time
(concat
- (if (fontp (char-displayable-p #10r128274))
- " ✍ "
- " [edited] ")
+ " "
+ (mastodon-tl--symbol 'edited)
+ " "
(propertize
(format-time-string mastodon-toot-timestamp-format
edited-parsed)
@@ -701,30 +719,6 @@ this just means displaying toot client."
(mastodon-toot--get-toot-edits (alist-get 'id toot)))
'byline t))))
-(defun mastodon-tl--return-boost-char ()
- ""
- (cond
- ((fontp (char-displayable-p #10r128257))
- "🔁")
- (t
- "B")))
-
-(defun mastodon-tl--return-fave-char ()
- ""
- (cond
- ((fontp (char-displayable-p #10r11088))
- "⭐")
- ((fontp (char-displayable-p #10r9733))
- "★")
- (t
- "F")))
-
-(defun mastodon-tl--return-bookmark-char ()
- ""
- (if (fontp (char-displayable-p #10r128278))
- "🔖"
- "K"))
-
(defun mastodon-tl--format-edit-timestamp (timestamp)
"Convert edit TIMESTAMP into a descriptive string."
(let ((parsed (ts-human-duration
@@ -1375,10 +1369,12 @@ BUFFER is buffer name, ENDPOINT is buffer's enpoint,
UPDATE-FUNCTION is its update function.
LINK-HEADER is the http Link header if present."
(setq mastodon-tl--buffer-spec
- `(buffer-name ,buffer
- endpoint ,endpoint
- update-function ,update-function
- link-header ,link-header)))
+ `(account ,(cons mastodon-active-user
+ mastodon-instance-url)
+ buffer-name ,buffer
+ endpoint ,endpoint
+ update-function ,update-function
+ link-header ,link-header)))
(defun mastodon-tl--more-json (endpoint id)
"Return JSON for timeline ENDPOINT before ID."
@@ -1458,7 +1454,7 @@ ID is that of the toot to view."
(mastodon-mode)
(mastodon-tl--set-buffer-spec buffer
(format "statuses/%s" id)
- (lambda (_toot) (message "END of thread.")))
+ nil)
(let ((inhibit-read-only t))
(mastodon-tl--toot toot :detailed-p))))))
@@ -1498,7 +1494,7 @@ ID is that of the toot to view."
(mastodon-tl--set-buffer-spec
buffer
(format "statuses/%s/context" id)
- (lambda (_toot) (message "END of thread.")))
+ 'mastodon-tl--thread)
(let ((inhibit-read-only t))
(mastodon-tl--timeline (alist-get 'ancestors context))
(goto-char (point-max))
@@ -1958,6 +1954,9 @@ INSTANCE is an instance domain name."
(let ((buf (get-buffer-create "*mastodon-instance*")))
(with-current-buffer buf
(switch-to-buffer-other-window buf)
+ (mastodon-tl--set-buffer-spec (buffer-name buf)
+ "instance"
+ nil)
(let ((inhibit-read-only t))
(erase-buffer)
(special-mode)
@@ -2364,11 +2363,22 @@ For use after e.g. deleting a toot."
(param (cadr split)))
(concat url-base "&" param)))
+(defun mastodon-tl--use-link-header-p ()
+ "Return t if we are in a view that uses Link header pagination.
+Currently this includes favourites, bookmarks, and profile pages
+when showing followers or accounts followed."
+ (let ((buf (buffer-name (current-buffer)))
+ (endpoint (mastodon-tl--get-endpoint)))
+ (or (member buf '("*mastodon-favourites*" "*mastodon-bookmarks*"))
+ (and (string-prefix-p "accounts" endpoint)
+ (or (string-suffix-p "followers" endpoint)
+ (string-suffix-p "following" endpoint))))))
+
(defun mastodon-tl--more ()
"Append older toots to timeline, asynchronously."
(interactive)
(message "Loading older toots...")
- (if (member (buffer-name (current-buffer)) mastodon-tl--link-header-buffers)
+ (if (mastodon-tl--use-link-header-p)
;; link-header: can't build a URL with --more-json-async, endpoint/id:
(let* ((next (car (mastodon-tl--link-header)))
;;(prev (cadr (mastodon-tl--link-header)))
@@ -2569,7 +2579,7 @@ from the start if it is nil."
"Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously.
UPDATE-FUNCTION is used to recieve more toots.
HEADERS means to also collect the response headers. Used for paginating
-favourites."
+favourites and bookmarks."
(let ((url (mastodon-http--api endpoint))
(buffer (concat "*mastodon-" buffer-name "*")))
(if headers
@@ -2582,8 +2592,8 @@ favourites."
"Initialize BUFFER with timeline targeted by ENDPOINT.
UPDATE-FUNCTION is used to recieve more toots.
RESPONSE is the data returned from the server by
-`mastodon-http--process-json', a cons cell of JSON and http
-headers."
+`mastodon-http--process-json', with arg HEADERS a cons cell of
+JSON and http headers, without it just the JSON."
(let* ((json (if headers (car response) response))
(headers (if headers (cdr response) nil))
(link-header (mastodon-tl--get-link-header-from-response headers)))
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 21bfe96..688717d 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -78,7 +78,7 @@
(autoload 'mastodon-http--build-array-params-alist "mastodon-http")
(autoload 'mastodon-tl--get-endpoint "mastodon-tl")
(autoload 'mastodon-http--put "mastodon-http")
-(autoload 'mastodon-tl--return-fave-char "mastodon-tl")
+(autoload 'mastodon-tl--symbol "mastodon-tl")
;; for mastodon-toot--translate-toot-text
(autoload 'mastodon-tl--content "mastodon-tl")
@@ -345,8 +345,8 @@ TYPE is a symbol, either 'favourite or 'boost."
(list 'favourited-p (not faved))))
(mastodon-toot--action-success
(if boost-p
- (mastodon-tl--return-boost-char)
- (mastodon-tl--return-fave-char))
+ (mastodon-tl--symbol 'boost)
+ (mastodon-tl--symbol 'favourite))
byline-region remove))
(message (format "%s #%s" (if boost-p msg action) id))))))
(message (format "Nothing to %s here?!?" action-string)))))
@@ -366,23 +366,21 @@ TYPE is a symbol, either 'favourite or 'boost."
"Bookmark or unbookmark toot at point."
(interactive)
(let* ( ;(toot (mastodon-tl--property 'toot-json))
- (id (mastodon-tl--property 'base-toot-id))
- ;; (mastodon-tl--as-string (mastodon-tl--toot-id toot)))
- (bookmarked-p (mastodon-tl--property 'bookmarked-p))
- (prompt (if bookmarked-p
- (format "Toot already bookmarked. Remove? ")
- (format "Bookmark this toot? ")))
- (byline-region
- (when id
- (mastodon-tl--find-property-range 'byline (point))))
- (action (if bookmarked-p "unbookmark" "bookmark"))
- (bookmark-str (if (fontp (char-displayable-p #10r128278))
- "🔖"
- "K"))
- (message (if bookmarked-p
- "Bookmark removed!"
- "Toot bookmarked!"))
- (remove (when bookmarked-p t)))
+ (id (mastodon-tl--property 'base-toot-id))
+ ;; (mastodon-tl--as-string (mastodon-tl--toot-id toot)))
+ (bookmarked-p (mastodon-tl--property 'bookmarked-p))
+ (prompt (if bookmarked-p
+ (format "Toot already bookmarked. Remove? ")
+ (format "Bookmark this toot? ")))
+ (byline-region
+ (when id
+ (mastodon-tl--find-property-range 'byline (point))))
+ (action (if bookmarked-p "unbookmark" "bookmark"))
+ (bookmark-str (mastodon-tl--symbol 'bookmark))
+ (message (if bookmarked-p
+ "Bookmark removed!"
+ "Toot bookmarked!"))
+ (remove (when bookmarked-p t)))
(if byline-region
(when (y-or-n-p prompt)
(mastodon-toot--action
@@ -1115,7 +1113,8 @@ LENGTH is the maximum character length allowed for a poll option."
("30 days" . ,(number-to-string (* 60 60 24 30)))))
(defun mastodon-toot--set-toot-lang ()
- "Prompt for a language and return its two letter ISO 639 1 code."
+ "Prompt for a language and set `mastodon-toot--language'.
+Return its two letter ISO 639 1 code."
(interactive)
(let* ((choice (completing-read "Language for this toot: "
mastodon-iso-639-1)))