diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-profile.el | 19 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 56 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 13 | ||||
| -rw-r--r-- | lisp/mastodon-views.el | 30 | ||||
| -rw-r--r-- | lisp/mastodon.el | 2 |
5 files changed, 57 insertions, 63 deletions
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 183efbb..a252abc 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -133,11 +133,6 @@ contains") (defun mastodon-profile--toot-json () "Get the next toot-json." (interactive) - ;; NB: we cannot add - ;; (or (mastodon-tl--property 'profile-json) - ;; here because it searches forward endlessly - ;; TODO: it would be nice to be able to do so tho - ;; or handle --property failing (mastodon-tl--property 'toot-json)) (defun mastodon-profile--make-author-buffer (account &optional no-reblogs) @@ -719,7 +714,7 @@ IMG-TYPE is the JSON key from the account data." (interactive (list (if (and (not (mastodon-tl--profile-buffer-p)) - (not (get-text-property (point) 'toot-json))) + (not (mastodon-tl--property 'toot-json :no-move))) (message "Looks like there's no toot or user at point?") (let ((user-handles (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))) @@ -730,7 +725,7 @@ IMG-TYPE is the JSON key from the account data." (if (not (or ;; own profile has no need for toot-json test: (equal user-handle (mastodon-auth--get-account-name)) - (get-text-property (point) 'toot-json))) + (mastodon-tl--property 'toot-json :no-move))) (message "Looks like there's no toot or user at point?") (let ((account (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json)))) @@ -844,7 +839,7 @@ These include the author, author of reblogged entries and any user mentioned." "Remove a user from your followers. Optionally provide the ID of the account to remove." (interactive) - (let* ((account (unless id (get-text-property (point) 'toot-json))) + (let* ((account (unless id (mastodon-tl--property 'toot-json :no-move))) (id (or id (alist-get 'id account))) (handle (if account (alist-get 'acct account) @@ -922,19 +917,19 @@ NOTE-OLD is the text of any existing note." (let ((inhibit-read-only t)) (princ note)))) -(defun mastodon-profile--grab-profile-json () +(defun mastodon-profile--profile-json () "Return the profile-json property if we are in a profile buffer." (when (mastodon-tl--profile-buffer-p) (save-excursion (goto-char (point-min)) - (or (mastodon-tl--property 'profile-json) + (or (mastodon-tl--property 'profile-json :no-move) (error "No profile data found"))))) (defun mastodon-profile--add-or-view-private-note (action-fun &optional message view) "Add or view a private note for an account. ACTION-FUN does the adding or viewing, MESSAGE is a prompt for `mastodon-tl--interactive-user-handles-get', VIEW is a flag." - (let* ((profile-json (mastodon-profile--grab-profile-json)) + (let* ((profile-json (mastodon-profile--profile-json)) (handle (if (mastodon-tl--profile-buffer-p) (alist-get 'acct profile-json) (mastodon-tl--interactive-user-handles-get message))) @@ -955,7 +950,7 @@ ACTION-FUN does the adding or viewing, MESSAGE is a prompt for Familiar followers are accounts that you follow, and that follow the given account." (interactive) - (let* ((profile-json (mastodon-profile--grab-profile-json)) + (let* ((profile-json (mastodon-profile--profile-json)) (handle (if (mastodon-tl--profile-buffer-p) (alist-get 'acct profile-json) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2f879de..124d635 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -67,6 +67,7 @@ (autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") (autoload 'mastodon-profile--my-profile "mastodon-profile") +(autoload 'mastodon-profile--profile-json "mastodon-profile") (autoload 'mastodon-profile--search-account-by-handle "mastodon-profile") (autoload 'mastodon-profile--toot-json "mastodon-profile") (autoload 'mastodon-profile--view-author-profile "mastodon-profile") @@ -273,7 +274,7 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (if (null next-range) (message "Nothing else here.") (goto-char (car next-range)) - (message "%s" (get-text-property (point) 'help-echo))))) + (message "%s" (mastodon-tl--property 'help-echo :no-move))))) (defun mastodon-tl--previous-tab-item () "Move to the previous interesting item. @@ -293,7 +294,7 @@ text, i.e. hidden spoiler text." (if (null next-range) (message "Nothing else before this.") (goto-char (car next-range)) - (message "%s" (get-text-property (point) 'help-echo))))) + (message "%s" (mastodon-tl--property 'help-echo :no-move))))) (defun mastodon-tl--goto-toot-pos (find-pos refresh &optional pos) "Search for toot with FIND-POS. @@ -400,12 +401,12 @@ Optionally load TAG timeline directly." Do so if type of status at poins is not follow_request/follow." (let ((type (alist-get 'type - (get-text-property (point) 'toot-json))) - (echo (get-text-property (point) 'help-echo))) + (mastodon-tl--property 'toot-json :no-move))) + (echo (mastodon-tl--property 'help-echo :no-move))) (when echo ; not for followers/following in profile (unless (or (string= type "follow_request") (string= type "follow")) ; no counts for these - (message "%s" (get-text-property (point) 'help-echo)))))) + (message "%s" (mastodon-tl--property 'help-echo :no-move)))))) (defun mastodon-tl--byline-author (toot &optional avatar) "Propertize author of TOOT. @@ -1311,11 +1312,11 @@ in which case play first video or gif from current toot." ;; point in byline: url ;; point in toot: - (get-text-property (point) 'image-url))) + (mastodon-tl--property 'image-url :no-move))) (type (or ;; in byline: type ;; point in toot: - (mastodon-tl--property 'mastodon-media-type)))) + (mastodon-tl--property 'mastodon-media-type :no-move)))) (if url (if (or (equal type "gifv") (equal type "video")) @@ -1594,15 +1595,18 @@ Return value from boosted content if available." (t2 (replace-regexp-in-string "<\/?span>" "" t1))) (replace-regexp-in-string "<span class=\"h-card\">" "" t2))) -(defun mastodon-tl--property (prop &optional backward) +(defun mastodon-tl--property (prop &optional no-move backward) "Get property PROP for toot at point. -Move forward (down) the timeline unless BACKWARD is non-nil." - (or (get-text-property (point) prop) - (save-excursion - (if backward - (mastodon-tl--goto-prev-toot) - (mastodon-tl--goto-next-toot)) - (get-text-property (point) prop)))) +Move forward (down) the timeline unless NO-MOVE is non-nil. +BACKWARD means move backward (up) the timeline." + (if no-move + (get-text-property (point) prop) + (or (get-text-property (point) prop) + (save-excursion + (if backward + (mastodon-tl--goto-prev-toot) + (mastodon-tl--goto-next-toot)) + (get-text-property (point) prop))))) (defun mastodon-tl--newest-id () "Return toot-id from the top of the buffer." @@ -1672,12 +1676,9 @@ view all branches of a thread." (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 (get-text-property (point) 'base-toot-id))) - (type (mastodon-tl--field 'type (get-text-property (point) 'toot-json)))) + (let* ((id (or id (mastodon-tl--property 'base-toot-id :no-move))) + (type (mastodon-tl--field 'type (mastodon-tl--property 'toot-json :no-move)))) (if (or (string= type "follow_request") (string= type "follow")) ; no can thread these (error "No thread") @@ -1912,14 +1913,13 @@ LANGS is the accumulated array param alist if we re-run recursively." ;; fetch 'toot-json: (mastodon-tl--buffer-type-eq 'profile-followers) (mastodon-tl--buffer-type-eq 'profile-following)) - (list (alist-get 'acct (get-text-property (point) 'toot-json)))) - ;; profile view, no toots, point on profile note, ie. 'profile-json: + (list (alist-get 'acct + (mastodon-tl--property 'toot-json :no-move)))) + ;; profile view, no toots ;; needed for e.g. gup.pe groups which show no toots publically: - ((and (mastodon-tl--profile-buffer-p) - (get-text-property (point) 'profile-json)) - (list (alist-get 'acct (get-text-property (point) 'profile-json)))) - ;; avoid tl--property here because it calls next-toot - ;; which breaks non-toot buffers like foll reqs etc.: + ((mastodon-tl--profile-buffer-p) + (list (alist-get 'acct + (mastodon-profile--profile-json)))) (t (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))))) @@ -1961,7 +1961,7 @@ LANGS is an array parameters alist of languages to filer user's posts by." ;; if profile view, use 'profile-json as status: (if (mastodon-tl--profile-buffer-p) (mastodon-profile--lookup-account-in-status - user-handle (get-text-property (point) 'profile-json)) + user-handle (mastodon-profile--profile-json)) ;; if muting/blocking, we select from handles in current status (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json))))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0a3b602..a487932 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -295,7 +295,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((inhibit-read-only t) (bol (car byline-region)) (eol (cdr byline-region)) - (at-byline-p (eq (get-text-property (point) 'byline) t))) + (at-byline-p (eq (mastodon-tl--property 'byline :no-move) t))) (save-excursion (when remove (goto-char bol) @@ -1008,10 +1008,9 @@ 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 '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 - (base-toot (get-text-property (point) 'base-toot)) ; for new notifs handling + ;; no-move arg for base toot, because if it doesn't have one, it is + ;; fetched from next toot! + (base-toot (mastodon-tl--property 'base-toot :no-move)) ; 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)) @@ -1238,10 +1237,10 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." (mastodon-tl--buffer-type-eq 'scheduled-statuses))) (message "You can only schedule toots from the compose toot buffer or the scheduled toots view.")) (t - (let* ((id (when reschedule (get-text-property (point) 'id))) + (let* ((id (when reschedule (mastodon-tl--property 'id :no-move))) (ts (when reschedule (alist-get 'scheduled_at - (get-text-property (point) 'scheduled-json)))) + (mastodon-tl--property 'scheduled-json :no-move)))) (time-value (org-read-date t t nil "Schedule toot:" ;; default to scheduled timestamp if already set: diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 5cfbe41..762efa9 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -280,7 +280,7 @@ a: add account to this list, r: remove account from this list" (defun mastodon-views--edit-list-at-point () "Edit list at point." (interactive) - (let ((id (get-text-property (point) 'list-id))) + (let ((id (mastodon-tl--property 'list-id :no-move))) (mastodon-views--edit-list id))) (defun mastodon-views--edit-list (&optional id) @@ -289,7 +289,7 @@ If ID is provided, use that list." (interactive) (let* ((list-names (unless id (mastodon-views--get-lists-names))) (name-old (if id - (get-text-property (point) 'list-name) + (mastodon-tl--property 'list-name :no-move) (completing-read "Edit list: " list-names))) (id (or id (mastodon-views--get-list-id name-old))) @@ -313,7 +313,7 @@ If ID is provided, use that list." (defun mastodon-views--view-timeline-list-at-point () "View timeline of list at point." (interactive) - (let ((list-id (get-text-property (point) 'list-id))) + (let ((list-id (mastodon-tl--property 'list-id :no-move))) (mastodon-views--view-list-timeline list-id))) (defun mastodon-views--view-list-timeline (&optional id) @@ -346,7 +346,7 @@ Prompt for name and replies policy." (defun mastodon-views--delete-list-at-point () "Delete list at point." (interactive) - (let ((id (get-text-property (point) 'list-id))) + (let ((id (mastodon-tl--property 'list-id :no-move))) (mastodon-views--delete-list id))) (defun mastodon-views--delete-list (&optional id) @@ -374,7 +374,7 @@ If ID is provided, delete that list." (defun mastodon-views--add-account-to-list-at-point () "Prompt for account and add to list at point." (interactive) - (let ((id (get-text-property (point) 'list-id))) + (let ((id (mastodon-tl--property 'list-id :no-move))) (mastodon-views--add-account-to-list id))) (defun mastodon-views--add-account-to-list (&optional id account-id handle) @@ -386,7 +386,7 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." (format "Add %s to list: " handle) "Add account to list: ")) (list-name (if id - (get-text-property (point) 'list-name) + (mastodon-tl--property 'list-name :no-move) (completing-read list-prompt (mastodon-views--get-lists-names) nil t))) (list-id (or id (mastodon-views--get-list-id list-name))) @@ -414,7 +414,7 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." (defun mastodon-views--remove-account-from-list-at-point () "Prompt for account and remove from list at point." (interactive) - (let ((id (get-text-property (point) 'list-id))) + (let ((id (mastodon-tl--property 'list-id :no-move))) (mastodon-views--remove-account-from-list id))) (defun mastodon-views--remove-account-from-list (&optional id) @@ -422,7 +422,7 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." If ID is provided, use that list." (interactive) (let* ((list-name (if id - (get-text-property (point) 'list-name) + (mastodon-tl--property 'list-name :no-move) (completing-read "Remove account from list: " (mastodon-views--get-lists-names) nil t))) (list-id (or id (mastodon-views--get-list-id list-name))) @@ -527,7 +527,7 @@ If ID, just return that toot." (defun mastodon-views--reschedule-toot () "Reschedule the scheduled toot at point." (interactive) - (let ((id (get-text-property (point) 'id))) + (let ((id (mastodon-tl--property 'id :no-move))) (if (null id) (message "no scheduled toot at point?") (mastodon-toot--schedule-toot :reschedule)))) @@ -535,7 +535,7 @@ If ID, just return that toot." (defun mastodon-views--copy-scheduled-toot-text () "Copy the text of the scheduled toot at point." (interactive) - (let* ((toot (get-text-property (point) 'toot)) + (let* ((toot (mastodon-tl--property 'toot :no-move)) (params (alist-get 'params toot)) (text (alist-get 'text params))) (kill-new text))) @@ -545,7 +545,7 @@ If ID, just return that toot." ID is that of the scheduled toot to cancel. NO-CONFIRM means there is no ask or message, there is only do." (interactive) - (let ((id (or id (get-text-property (point) 'id)))) + (let ((id (or id (mastodon-tl--property 'id :no-move)))) (if (null id) (message "no scheduled toot at point?") (when (or no-confirm @@ -561,10 +561,10 @@ NO-CONFIRM means there is no ask or message, there is only do." (defun mastodon-views--edit-scheduled-as-new () "Edit scheduled status as new toot." (interactive) - (let ((id (get-text-property (point) 'id))) + (let ((id (mastodon-tl--property 'id :no-move))) (if (null id) (message "no scheduled toot at point?") - (let* ((toot (get-text-property (point) 'scheduled-json)) + (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) (scheduled (alist-get 'scheduled_at toot)) (params (alist-get 'params toot)) (text (alist-get 'text params)) @@ -661,8 +661,8 @@ Prompt for a context, must be a list containting at least one of \"home\", (defun mastodon-views--delete-filter () "Delete filter at point." (interactive) - (let* ((filter-id (get-text-property (point) 'toot-id)) - (phrase (get-text-property (point) 'phrase)) + (let* ((filter-id (mastodon-tl--property 'toot-id :no-move)) + (phrase (mastodon-tl--property 'phrase :no-move)) (url (mastodon-http--api (format "filters/%s" filter-id)))) (if (null phrase) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index d54380d..8875419 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -309,7 +309,7 @@ not, just browse the URL in the normal fashion." (interactive) (let* ((query (or query-url (thing-at-point-url-at-point) - (get-text-property (point) 'shr-url) + (mastodon-tl--property 'shr-url :no-move) (read-string "Lookup URL: ")))) (if (not (mastodon--masto-url-p query)) ;; this doesn't work as shr-browse-url doesn't take a url arg |