diff options
| -rw-r--r-- | .woodpecker.yml | 2 | ||||
| -rw-r--r-- | README.org | 50 | ||||
| -rw-r--r-- | lisp/mastodon-discover.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 5 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 41 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 45 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 82 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 82 | ||||
| -rw-r--r-- | lisp/mastodon.el | 8 | ||||
| -rw-r--r-- | test/mastodon-notifications-tests.el | 8 | ||||
| -rw-r--r-- | test/mastodon-profile-tests.el | 116 |
11 files changed, 249 insertions, 192 deletions
diff --git a/.woodpecker.yml b/.woodpecker.yml index ba2c7b5..01b1cba 100644 --- a/.woodpecker.yml +++ b/.woodpecker.yml @@ -12,4 +12,4 @@ pipeline: - cask install - cask emacs -batch -l test/ert-helper.el -f ert-run-tests-batch-and-exit -+branches: [ main, develop ] +branches: [ main, develop ] @@ -122,6 +122,7 @@ take place if your =mastodon-token-file= does not contain =:client_id= and | =H= | Open home timeline | | =L= | Open local timeline | | =N= | Open notifications timeline | +| =@= | Open mentions-only notifications timeline | | =u= | Update current timeline | | =T= | Open thread for toot under =point= | | =#= | Prompt for tag and open its timeline | @@ -155,6 +156,7 @@ take place if your =mastodon-token-file= does not contain =:client_id= and |---------------+-----------------------------------------------------------------------| | | Notifications view | | =a=, =j= | accept/reject follow request | +| =c= | clear notification at point | |---------------+-----------------------------------------------------------------------| | | *Quitting* | | =q= | Quit mastodon buffer, leave window open | @@ -209,27 +211,27 @@ You can download and use your instance's custom emoji **** draft toots - Compose buffer text is saved as you type, kept in =mastodon-toot-current-toot-text=. -- =mastodon-toot-save-draft=: save the current toot as a draft. -- =mastodon-toot-open-draft-toot=: Open a compose buffer and insert one of your draft toots. -- =mastodon-toot-delete-draft-toot=: Delete a draft toot. -- =mastodon-toot-delete-all-drafts=: Delete all your drafts. +- =mastodon-toot--save-draft=: save the current toot as a draft. +- =mastodon-toot--open-draft-toot=: Open a compose buffer and insert one of your draft toots. +- =mastodon-toot--delete-draft-toot=: Delete a draft toot. +- =mastodon-toot--delete-all-drafts=: Delete all your drafts. *** Other commands and account settings: - =mastodon-url-lookup=: Attempt to load URL in =mastodon.el=. URL may be the one at point or provided in the minibuffer. Should also work if =mastodon.el= is not yet loaded. -- =mastodon-tl-view-instance-description=: View information about the instance that the author of the toot at point is on. -- =mastodon-tl-view-own-instance=: View information about your own instance. -- =mastodon-search-trending-tags=: View a list of trending hashtags on your instance. +- =mastodon-tl--view-instance-description=: View information about the instance that the author of the toot at point is on. +- =mastodon-tl--view-own-instance=: View information about your own instance. +- =mastodon-search--trending-tags=: View a list of trending hashtags on your instance. -- =mastodon-profile-update-display-name=: Update the display name for your account. -- =mastodon-profile-update-user-profile-note=: Update your bio note. -- =mastodon-profile-update-meta-fields=: Update your metadata fields. -- =mastodon-profile-set-default-toot-visibility=: Set the default visibility for your toots. -- =mastodon-profile-account-locked-toggle=: Toggle the locked status of your account. Locked accounts have to manually approve follow requests. -- =mastodon-profile-account-discoverable-toggle=: Toggle the discoverable status of your account. Non-discoverable accounts are not listed in the profile directory. -- =mastodon-profile-account-bot-toggle=: Toggle whether your account is flagged as a bot. -- =mastodon-profile-account-sensitive-toggle=: Toggle whether your posts are marked as sensitive (nsfw) by default. +- =mastodon-profile--update-display-name=: Update the display name for your account. +- =mastodon-profile--update-user-profile-note=: Update your bio note. +- =mastodon-profile--update-meta-fields=: Update your metadata fields. +- =mastodon-profile--set-default-toot-visibility=: Set the default visibility for your toots. +- =mastodon-profile--account-locked-toggle=: Toggle the locked status of your account. Locked accounts have to manually approve follow requests. +- =mastodon-profile--account-discoverable-toggle=: Toggle the discoverable status of your account. Non-discoverable accounts are not listed in the profile directory. +- =mastodon-profile--account-bot-toggle=: Toggle whether your account is flagged as a bot. +- =mastodon-profile--account-sensitive-toggle=: Toggle whether your posts are marked as sensitive (nsfw) by default. *** Customization @@ -255,7 +257,7 @@ See =M-x customize-group RET mastodon= to view all customize options. Works for federated, local, and home timelines and for notifications. It's a little touchy, one thing to avoid is trying to load a timeline more than once at a time. It can go off the rails a bit, but it's still pretty cool. The -current maintainer of =mastodon.el= is unable to debug improve this feature. +current maintainer of =mastodon.el= is unable to debug or improve this feature. To enable, it, add =(require 'mastodon-async)= to your =init.el=. Then you can view a timeline with one of the commands that begin with @@ -297,19 +299,11 @@ Optional dependencies: - =mpv= and =mpv.el= for viewing videos and gifs - =lingva.el= for translating toots -** Nota Bene regarding work on this library - -I resurrected this library a few years ago, and have added stacks of features and fixes over time. I do it in my spare time and tend to implement features I want to use. I am not a professional programmer. I never aimed to implement all Mastodon features, nor to provide a professional service to others. I have implemented some things I don't use, such as filters, but mostly I can only fix bugs with things that I regularly rely on. - -Please keep this in mind when requesting features that are not implemented. Feel free to open an issue and start a discussion, but don't try to order things from me. - -The better option is to look at the code and seeing how you can implement the feature yourself. A lot of the functionality you'll need is already implemented. I'm happy to give pointers on what you might use. - ** Contributing PRs, issues, feature requests, and general feedback are very welcome! -*** Bugs +*** Bug reports 1. =mastodon.el= has bugs, as well as lots of room for improvement. 2. I receive very little feedback, so if I don't run into the bug it often doesn't get fixed. @@ -321,13 +315,15 @@ PRs, issues, feature requests, and general feedback are very welcome! 1. Create an [[https://github.com/jdenen/mastodon.el/issues][issue]] detailing the feature you'd like to add. 2. Fork the repository and create a branch off of =develop=. -3. Create a pull request referencing the issue created in step 1. +3. Run the tests and ensure that your code doesn't break any of them. +4. Create a pull request referencing the issue created in step 1. *** Fixes 1. In an [[https://github.com/jdenen/mastodon.el/issues][issue]], let me know that you're working to fix it. 2. Fork the repository and create a branch off of =develop=. -3. Create a pull request referencing the issue from step 1. +3. Run the tests and ensure that your code doesn't break any of them. +4. Create a pull request referencing the issue from step 1. ** Contributors: diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 0ef64e2..5d1a86e 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -100,7 +100,7 @@ ("-" "zoom out" 'image-decrease-size) ("u" "copy URL" 'shr-maybe-probe-and-copy-url)) ("Profile view" - ("C-c C-c" "Cycle profile views" mastodon-profile-account-view-cycle)) + ("C-c C-c" "Cycle profile views" mastodon-profile--account-view-cycle)) ("Quit" ("q" "Quit mastodon and bury buffer." kill-this-buffer) ("Q" "Quit mastodon buffer and kill window." kill-buffer-and-window))))))) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 843afc1..d9e1d80 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -124,6 +124,11 @@ Unless UNAUTHENTICATED-P is non-nil." args "&")) +(defun mastodon-http--build-array-args-alist (param-str array) + "Return parameters alist using PARAM-STR and ARRAY param values." + (cl-loop for x in array + collect (cons param-str x))) + (defun mastodon-http--post (url args headers &optional unauthenticated-p) "POST synchronously to URL with ARGS and HEADERS. diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index f05e670..a33a96b 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -52,25 +52,26 @@ (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) +(defvar mastodon-mode-map) (defvar mastodon-notifications--types-alist - '(("mention" . mastodon-notifications--mention) - ("follow" . mastodon-notifications--follow) + '(("follow" . mastodon-notifications--follow) ("favourite" . mastodon-notifications--favourite) ("reblog" . mastodon-notifications--reblog) + ("mention" . mastodon-notifications--mention) + ("poll" . mastodon-notifications--poll) ("follow_request" . mastodon-notifications--follow-request) - ("status" . mastodon-notifications--status) - ("poll" . mastodon-notifications--poll)) + ("status" . mastodon-notifications--status)) "Alist of notification types and their corresponding function.") (defvar mastodon-notifications--response-alist - '(("Mentioned" . "you") - ("Followed" . "you") + '(("Followed" . "you") ("Favourited" . "your status from") ("Boosted" . "your status from") + ("Mentioned" . "you") + ("Posted a poll" . "that has now ended") ("Requested to follow" . "you") - ("Posted" . "a post") - ("Posted a poll" . "that has now ended")) + ("Posted" . "a post")) "Alist of subjects for notification types.") (defvar mastodon-notifications--map @@ -78,6 +79,7 @@ (copy-keymap mastodon-mode-map))) (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) + (define-key map (kbd "c") #'mastodon-notifications--clear-current) (define-key map (kbd "g") #'mastodon-notifications--get) (keymap-canonicalize map)) "Keymap for viewing notifications.") @@ -139,7 +141,7 @@ Can be called in notifications view or in follow-requests view." "Reject a follow request. Can be called in notifications view or in follow-requests view." (interactive) - (mastodon-notifications--follow-request-process t)) + (mastodon-notifications--follow-request-process :reject)) (defun mastodon-notifications--mention (note) "Format for a `mention' NOTE." @@ -267,16 +269,29 @@ of the toot responded to." (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) -(defun mastodon-notifications--get () - "Display NOTIFICATIONS in buffer." +(defun mastodon-notifications--get (&optional type buffer-name) + "Display NOTIFICATIONS in buffer. +Optionally only print notifications of type TYPE, a string." (interactive) (message "Loading your notifications...") (mastodon-tl--init-sync + (or buffer-name "notifications") "notifications" - "notifications" - 'mastodon-notifications--timeline) + 'mastodon-notifications--timeline + type) (use-local-map mastodon-notifications--map)) +(defun mastodon-notifications--get-mentions () + "Display mention notifications in buffer." + (interactive) + (mastodon-notifications--get "mention" "mentions")) + +(defun mastodon-notifications--filter-types-list (type) + "Return a list of notification types with TYPE (and \"status\") removed." + (let ((types (remove "status" + (mapcar #'car mastodon-notifications--types-alist)))) + (remove type types))) + (defun mastodon-notifications--clear-all () "Clear all notifications." (interactive) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 63c062b..226da95 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -87,7 +87,7 @@ ;; maybe we can retire both of these awful bindings ;; (define-key map (kbd "s") #'mastodon-profile--open-followers) ;; (define-key map (kbd "g") #'mastodon-profile--open-following) - (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle) + (define-key map (kbd "C-c C-c") #'mastodon-profile--account-view-cycle) map) "Keymap for `mastodon-profile-mode'.") @@ -156,7 +156,7 @@ contains") account "statuses" #'mastodon-tl--timeline)) ;; TODO: we shd just load all views' data then switch coz this is slow af: -(defun mastodon-profile-account-view-cycle () +(defun mastodon-profile--account-view-cycle () "Cycle through profile view: toots, followers, and following." (interactive) (let ((endpoint (plist-get mastodon-tl--buffer-spec 'endpoint))) @@ -295,25 +295,25 @@ SOURCE means that the preference is in the 'source' part of the account JSON." (response (mastodon-http--patch url `((,pref-formatted . ,val))))) (mastodon-http--triage response (lambda () - (mastodon-profile-fetch-server-account-settings) + (mastodon-profile--fetch-server-account-settings) (message "Account setting %s updated to %s!" pref val))))) (defun mastodon-profile--get-pref (pref) "Return PREF from `mastodon-profile-account-settings'." (plist-get mastodon-profile-account-settings pref)) -(defun mastodon-profile-update-preference-plist (pref val) +(defun mastodon-profile--update-preference-plist (pref val) "Set local account preference plist preference PREF to VAL. This is done after changing the setting on the server." (setq mastodon-profile-account-settings (plist-put mastodon-profile-account-settings pref val))) -(defun mastodon-profile-fetch-server-account-settings-maybe () +(defun mastodon-profile--fetch-server-account-settings-maybe () "Fetch account settings from the server. Only do so if `mastodon-profile-account-settings' is nil." - (mastodon-profile-fetch-server-account-settings :no-force)) + (mastodon-profile--fetch-server-account-settings :no-force)) -(defun mastodon-profile-fetch-server-account-settings (&optional no-force) +(defun mastodon-profile--fetch-server-account-settings (&optional no-force) "Fetch basic account settings from the server. Store the values in `mastodon-profile-account-settings'. Run in `mastodon-mode-hook'. @@ -324,42 +324,42 @@ If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil." (let ((keys '(locked discoverable display_name bot)) (source-keys '(privacy sensitive language))) (mapc (lambda (k) - (mastodon-profile-update-preference-plist + (mastodon-profile--update-preference-plist k (mastodon-profile--get-json-value k))) keys) (mapc (lambda (sk) - (mastodon-profile-update-preference-plist + (mastodon-profile--update-preference-plist sk (mastodon-profile--get-source-value sk))) source-keys) ;; hack for max toot chars: (mastodon-toot--get-max-toot-chars :no-toot) - (mastodon-profile-update-preference-plist 'max_toot_chars - mastodon-toot--max-toot-chars) + (mastodon-profile--update-preference-plist 'max_toot_chars + mastodon-toot--max-toot-chars) ;; TODO: remove now redundant vars, replace with fetchers from the plist (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) mastodon-profile-account-settings))) -(defun mastodon-profile-account-locked-toggle () +(defun mastodon-profile--account-locked-toggle () "Toggle the locked status of your account. Locked means follow requests have to be approved." (interactive) (mastodon-profile--toggle-account-key 'locked)) -(defun mastodon-profile-account-discoverable-toggle () +(defun mastodon-profile--account-discoverable-toggle () "Toggle the discoverable status of your account. Discoverable means the account is listed in the server directory." (interactive) (mastodon-profile--toggle-account-key 'discoverable)) -(defun mastodon-profile-account-bot-toggle () +(defun mastodon-profile--account-bot-toggle () "Toggle the bot status of your account." (interactive) (mastodon-profile--toggle-account-key 'bot)) -(defun mastodon-profile-account-sensitive-toggle () +(defun mastodon-profile--account-sensitive-toggle () "Toggle the sensitive status of your account. When enabled, statuses are marked as sensitive by default." (interactive) @@ -387,7 +387,7 @@ Current settings are fetched from the server." val))) (mastodon-profile--update-preference (symbol-name key) new-val))) -(defun mastodon-profile-update-display-name () +(defun mastodon-profile--update-display-name () "Update display name for your account." (interactive) (mastodon-profile--edit-string-value 'display_name)) @@ -396,8 +396,8 @@ Current settings are fetched from the server." "Construct a parameter query string from metadata alist FIELDS. Returns an alist." (let ((keys (cl-loop for count from 1 to 5 - collect (cons (format "fields_attributes[%s][name]" count) - (format "fields_attributes[%s][value]" count))))) + collect (cons (format "fields_attributes[%s][name]" count) + (format "fields_attributes[%s][value]" count))))) (cl-loop for a-pair in keys for b-pair in fields append (list (cons (car a-pair) @@ -405,7 +405,7 @@ Returns an alist." (cons (cdr a-pair) (cdr b-pair)))))) -(defun mastodon-profile-update-meta-fields () +(defun mastodon-profile--update-meta-fields () "Prompt for new metadata fields information and PATCH the server." (interactive) (let* ((url (mastodon-http--api "accounts/update_credentials")) @@ -414,7 +414,7 @@ Returns an alist." (response (mastodon-http--patch url params))) (mastodon-http--triage response (lambda () - (mastodon-profile-fetch-server-account-settings) + (mastodon-profile--fetch-server-account-settings) (message "Account setting %s updated to %s!" "metadata fields" fields-updated))))) @@ -458,7 +458,7 @@ This endpoint only holds a few preferences. For others, see (mastodon-http--get-json (mastodon-http--api "preferences")))) -(defun mastodon-profile-view-preferences () +(defun mastodon-profile--view-preferences () "View user preferences in another window." (interactive) (let* ((url (mastodon-http--api "preferences")) @@ -707,7 +707,8 @@ Used to view a user's followers and those they're following." (let ((start-pos (point))) (insert "\n" (propertize - (mastodon-tl--byline-author `((account . ,toot))) + (mastodon-tl--byline-author `((account . ,toot)) + :avatar) 'byline 't 'toot-id (alist-get 'id toot) 'base-toot-id (mastodon-tl--toot-id toot) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 542072f..9481fdc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -73,6 +73,10 @@ (autoload 'mastodon-auth--get-account-id "mastodon-auth") (autoload 'mastodon-http--put "mastodon-http") (autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--build-array-args-alist "mastodon-http") +(autoload 'mastodon-http--build-query-string "mastodon-http") +(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") + (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) (defvar mastodon-instance-url) @@ -372,17 +376,29 @@ Used on initializing a timeline or thread." (t2 (replace-regexp-in-string "<\/?span>" "" t1))) (replace-regexp-in-string "<span class=\"h-card\">" "" t2))) -(defun mastodon-tl--byline-author (toot) - "Propertize author of TOOT." +(defun mastodon-tl--byline-author (toot &optional avatar) + "Propertize author of TOOT. +With arg AVATAR, include the account's avatar image." (let* ((account (alist-get 'account toot)) (handle (alist-get 'acct account)) (name (if (not (string-empty-p (alist-get 'display_name account))) (alist-get 'display_name account) (alist-get 'username account))) - (profile-url (alist-get 'url account))) + (profile-url (alist-get 'url account)) + (avatar-url (alist-get 'avatar account))) + ;; TODO: Once we have a view for a user (e.g. their posts + ;; timeline) make this a tab-stop and attach an action (concat - ;; avatar insertion moved up to `mastodon-tl--byline' in order to be - ;; outside of text prop 'byline t. + ;; avatar insertion moved up to `mastodon-tl--byline' by default in order + ;; to be outside of text prop 'byline t. arg avatar is used by + ;; `mastodon-profile--add-author-bylines' + (when (and avatar + mastodon-tl--show-avatars + mastodon-tl--display-media-p + (if (version< emacs-version "27.1") + (image-type-available-p 'imagemagick) + (image-transforms-p))) + (mastodon-media--get-avatar-rendering avatar-url)) (propertize name 'face 'mastodon-display-name-face ;; enable playing of videos when point is on byline: @@ -1023,7 +1039,8 @@ 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)) + (voters-count (mastodon-tl--field 'voters_count poll)) + (vote-count (mastodon-tl--field 'votes_count poll)) (options (mastodon-tl--field 'options poll)) (option-titles (mapcar (lambda (x) (alist-get 'title x)) @@ -1052,10 +1069,16 @@ this just means displaying toot client." options "\n") "\n" - (propertize (if (= vote-count 1) - (format "%s person | " vote-count) - (format "%s people | " vote-count)) - 'face 'font-lock-comment-face) + (propertize + (cond (voters-count ; sometimes it is nil + (if (= voters-count 1) + (format "%s person | " voters-count) + (format "%s people | " voters-count))) + (vote-count + (format "%s votes | " vote-count)) + (t + "")) + 'face 'font-lock-comment-face) (let ((str (if expired-p "Poll expired." (mastodon-tl--format-poll-expiry expiry)))) @@ -1762,23 +1785,23 @@ RESPONSE is the JSON returned by the server." ;;;; INSTANCES -(defun mastodon-tl-view-own-instance (&optional brief) +(defun mastodon-tl--view-own-instance (&optional brief) "View details of your own instance. BRIEF means show fewer details." (interactive) - (mastodon-tl-view-instance-description :user brief)) + (mastodon-tl--view-instance-description :user brief)) -(defun mastodon-tl-view-own-instance-brief () +(defun mastodon-tl--view-own-instance-brief () "View brief details of your own instance." (interactive) - (mastodon-tl-view-instance-description :user :brief)) + (mastodon-tl--view-instance-description :user :brief)) -(defun mastodon-tl-view-instance-description-brief () +(defun mastodon-tl--view-instance-description-brief () "View brief details of the instance the current post's author is on." (interactive) - (mastodon-tl-view-instance-description nil :brief)) + (mastodon-tl--view-instance-description nil :brief)) -(defun mastodon-tl-view-instance-description (&optional user brief instance) +(defun mastodon-tl--view-instance-description (&optional user brief instance) "View the details of the instance the current post's author is on. USER means to show the instance details for the logged in user. BRIEF means to show fewer details. @@ -2327,10 +2350,11 @@ from the start if it is nil." (update-function (mastodon-tl--get-update-function)) (id (mastodon-tl--newest-id)) (json (mastodon-tl--updated-json endpoint id))) - (when json - (let ((inhibit-read-only t)) - (goto-char (or mastodon-tl--update-point (point-min))) - (funcall update-function json))))) + (if json + (let ((inhibit-read-only t)) + (goto-char (or mastodon-tl--update-point (point-min))) + (funcall update-function json)) + (message "nothing to update")))) (defun mastodon-tl--get-link-header-from-response (headers) "Get http Link header from list of http HEADERS." @@ -2394,12 +2418,22 @@ headers." ;; for everything save profiles (mastodon-tl--goto-first-item))))) -(defun mastodon-tl--init-sync (buffer-name endpoint update-function) +(defun mastodon-tl--init-sync (buffer-name endpoint update-function &optional note-type) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to receive more toots. -Runs synchronously." - (let* ((url (mastodon-http--api endpoint)) +Runs synchronously. +Optional arg NOTE-TYPE means only get that type of note." + (let* ((exclude-types (when note-type + (mastodon-notifications--filter-types-list note-type))) + (args (when note-type (mastodon-http--build-array-args-alist + "exclude_types[]" exclude-types))) + (query-string (when note-type + (mastodon-http--build-query-string args))) + ;; add note-type exclusions to endpoint so it works in `mastodon-tl--buffer-spec' + ;; that way `mastodon-tl--more' works seamlessly too: + (endpoint (if note-type (concat endpoint "?" query-string) endpoint)) + (url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*")) (json (mastodon-http--get-json url))) (with-output-to-temp-buffer buffer diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 438e887..b45a84f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -76,9 +76,11 @@ (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-profile--get-source-pref "mastodon-profile") (autoload 'mastodon-profile--update-preference "mastodon-profile") -(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") -(autoload 'mastodon-profile-fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-http--build-array-args-alist "mastodon-http") +(autoload 'mastodon-tl--get-endpoint "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -155,7 +157,7 @@ Valid values are \"direct\", \"private\" (followers-only), This is determined by the account setting on the server. To change the setting on the server, see -`mastodon-toot-set-default-visibility'.") +`mastodon-toot--set-default-visibility'.") (defvar-local mastodon-toot--media-attachments nil "A list of the media attachments of the toot being composed.") @@ -201,7 +203,7 @@ send.") map) "Keymap for `mastodon-toot'.") -(defun mastodon-toot-set-default-visibility () +(defun mastodon-toot--set-default-visibility () "Set the default visibility for toots on the server." (interactive) (let ((vis (completing-read "Set default visibility to:" @@ -458,7 +460,7 @@ NO-REDRAFT means delete toot only." toot-visibility toot-cw))))))))) -(defun mastodon-toot-set-cw (&optional cw) +(defun mastodon-toot--set-cw (&optional cw) "Set content warning to CW if it is non-nil." (unless (string-empty-p cw) (setq mastodon-toot--content-warning t) @@ -477,7 +479,7 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." (when reply-id (setq mastodon-toot--reply-to-id reply-id)) (setq mastodon-toot--visibility toot-visibility) - (mastodon-toot-set-cw toot-cw) + (mastodon-toot--set-cw toot-cw) (mastodon-toot--update-status-fields)))) (defun mastodon-toot--kill (&optional cancel) @@ -497,13 +499,13 @@ CANCEL means the toot was not sent, so we save the toot text as a draft." "Kill new-toot buffer/window. Does not POST content to Mastodon. If toot is not empty, prompt to save text as a draft." (interactive) - (if (mastodon-toot-empty-p) + (if (mastodon-toot--empty-p) (mastodon-toot--kill) (when (y-or-n-p "Save draft toot?") - (mastodon-toot-save-draft)) + (mastodon-toot--save-draft)) (mastodon-toot--kill))) -(defun mastodon-toot-save-draft () +(defun mastodon-toot--save-draft () "Save the current compose toot text as a draft. Pushes `mastodon-toot-current-toot-text' to `mastodon-toot-draft-toots-list'." @@ -513,9 +515,9 @@ Pushes `mastodon-toot-current-toot-text' to mastodon-toot-draft-toots-list :test 'equal) (message "Draft saved!"))) -(defun mastodon-toot-empty-p (&optional text-only) - "Return t if no text, attachments, or polls have been added to the compose buffer. -TEXT-ONLY means don't check for attachments." +(defun mastodon-toot--empty-p (&optional text-only) + "Return t if toot has no text, attachments, or polls. +TEXT-ONLY means don't check for attachments or polls." (and (if text-only t (not mastodon-toot--media-attachments) @@ -615,7 +617,8 @@ 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-options-params + (mastodon-http--build-array-args-alist + "poll[options][]" (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)))) @@ -628,7 +631,7 @@ If media items have been attached and uploaded with (interactive) (let* ((toot (mastodon-toot--remove-docs)) (endpoint (mastodon-http--api "statuses")) - (spoiler (when (and (not (mastodon-toot-empty-p)) + (spoiler (when (and (not (mastodon-toot--empty-p)) mastodon-toot--content-warning) (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft))) (args-no-media `(("status" . ,toot) @@ -638,9 +641,9 @@ If media items have been attached and uploaded with (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mapcar (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids))) + (mastodon-http--build-array-args-alist + "media_ids[]" + mastodon-toot--media-attachment-ids))) (args-poll (when mastodon-toot-poll (mastodon-toot--build-poll-params))) ;; media || polls: @@ -660,7 +663,7 @@ If media items have been attached and uploaded with ((and mastodon-toot--max-toot-chars (> (length toot) mastodon-toot--max-toot-chars)) (message "Looks like your toot is longer than that maximum allowed length.")) - ((mastodon-toot-empty-p) + ((mastodon-toot--empty-p) (message "Empty toot. Cowardly refusing to post this.")) (t (let ((response (mastodon-http--post endpoint args nil))) @@ -960,12 +963,6 @@ which is used to attach it to a toot when posting." mastodon-toot--media-attachments)) (list "None"))) -(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 - collect `(,key . ,o)))) - (defun mastodon-toot--fetch-max-poll-options () "Return the maximum number of poll options." (mastodon-toot--fetch-poll-field 'max_options)) @@ -976,7 +973,7 @@ which is used to attach it to a toot when posting." 50)) ; masto default (defun mastodon-toot--fetch-poll-field (field) - "Return FIELD from the poll settings from the user's instance. " + "Return FIELD from the poll settings from the user's instance." (let* ((instance (mastodon-http--get-json (mastodon-http--api "instance")))) (alist-get field (alist-get 'polls @@ -1008,7 +1005,8 @@ MAX is the maximum number set by their instance." (message "poll created!"))) (defun mastodon-toot--read-poll-options (count length) - "Read a list of options for poll of LENGTH options." + "Read a list of options for poll with COUNT options. +LENGTH is the maximum character length allowed for a poll option." (cl-loop for x from 1 to count collect (read-string (format "Poll option [%s/%s] [max %s chars]: " x count length)))) @@ -1162,7 +1160,7 @@ REPLY-JSON is the full JSON of the toot being replied to." (setq mastodon-toot--reply-to-id reply-to-id) (unless (equal mastodon-toot--visibility reply-visibility) (setq mastodon-toot--visibility reply-visibility)) - (mastodon-toot-set-cw reply-cw)))) + (mastodon-toot--set-cw reply-cw)))) (defun mastodon-toot--update-status-fields (&rest _args) "Update the status fields in the header based on the current state." @@ -1208,15 +1206,15 @@ Added to `after-change-functions' in new toot buffers." (unless (string-empty-p text) (setq mastodon-toot-current-toot-text text)))) -(defun mastodon-toot-open-draft-toot () +(defun mastodon-toot--open-draft-toot () "Prompt for a draft and compose a toot with it." (interactive) (if mastodon-toot-draft-toots-list (let ((text (completing-read "Select draft toot: " mastodon-toot-draft-toots-list nil t))) - (if (mastodon-toot-compose-buffer-p) - (when (and (not (mastodon-toot-empty-p :text-only)) + (if (mastodon-toot--compose-buffer-p) + (when (and (not (mastodon-toot--empty-p :text-only)) (y-or-n-p "Replace current text with draft?")) (cl-pushnew mastodon-toot-current-toot-text mastodon-toot-draft-toots-list) @@ -1228,11 +1226,11 @@ Added to `after-change-functions' in new toot buffers." ;; (delete-region (point) (point-max)) (insert text)) (mastodon-toot--compose-buffer nil nil nil text))) - (unless (mastodon-toot-compose-buffer-p) + (unless (mastodon-toot--compose-buffer-p) (mastodon-toot--compose-buffer)) (message "No drafts available."))) -(defun mastodon-toot-delete-draft-toot () +(defun mastodon-toot--delete-draft-toot () "Prompt for a draft toot and delete it." (interactive) (if mastodon-toot-draft-toots-list @@ -1245,7 +1243,7 @@ Added to `after-change-functions' in new toot buffers." (message "Draft deleted!")) (message "No drafts to delete."))) -(defun mastodon-toot-delete-all-drafts () +(defun mastodon-toot--delete-all-drafts () "Delete all drafts." (interactive) (setq mastodon-toot-draft-toots-list nil) @@ -1254,7 +1252,7 @@ Added to `after-change-functions' in new toot buffers." (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) + (when (mastodon-toot--compose-buffer-p) (let ((header-region (mastodon-tl--find-property-range 'toot-post-header (point-min)))) @@ -1262,12 +1260,16 @@ 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 "[\n\t ]\\(?2:#[1-9a-zA-Z_]+\\)[\n\t ]" + (mastodon-toot--propertize-item "\\([\n\t ]\\|^\\)\\(?2:#[1-9a-zA-Z_]+\\)\\b" 'success (cdr header-region)) - (mastodon-toot--propertize-item "[\n\t ]\\(?2:@[1-9a-zA-Z._-]+\\)[\n\t ]" - 'mastodon-display-name-face - (cdr header-region))))) + (mastodon-toot--propertize-item + (concat "\\([\n\t ]\\|^\\)" ; preceding space or bol + "\\(?2:@[1-9a-zA-Z._-]+" ; a handle + "\\(@[1-9a-zA-Z._-]+\\)?\\)" ; with poss domain + "\\b") ; boundary + 'mastodon-display-name-face + (cdr header-region))))) (defun mastodon-toot--propertize-item (regex face start) "Propertize item matching REGEX with FACE starting from START." @@ -1278,7 +1280,7 @@ Added to `after-change-functions'." (match-end 2) `(face ,face))))) -(defun mastodon-toot-compose-buffer-p () +(defun mastodon-toot--compose-buffer-p () "Return t if compose buffer is current." (equal (buffer-name (current-buffer)) "*new toot*")) @@ -1336,7 +1338,7 @@ a draft into the buffer." (insert initial-text)))) ;;;###autoload -(add-hook 'mastodon-toot-mode-hook #'mastodon-profile-fetch-server-account-settings-maybe) +(add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe) (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index e49a121..6b56341 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -91,7 +91,7 @@ (when (require 'lingva nil :no-error) (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) (autoload 'mastodon-search--trending-tags "mastodon-search") -(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (defgroup mastodon nil "Interface with Mastodon." @@ -193,7 +193,11 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) (define-key map (kbd "I") #'mastodon-tl--view-filters) (define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions) +<<<<<<< HEAD (define-key map (kbd "X") #'mastodon-tl--view-lists) +======= + (define-key map (kbd "@") #'mastodon-notifications--get-mentions) +>>>>>>> develop (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) @@ -324,7 +328,7 @@ not, just browse the URL in the normal fashion." (mastodon-toot--enable-custom-emoji))))) ;;;###autoload -(add-hook 'mastodon-mode-hook #'mastodon-profile-fetch-server-account-settings) +(add-hook 'mastodon-mode-hook #'mastodon-profile--fetch-server-account-settings) (define-derived-mode mastodon-mode special-mode "Mastodon" "Major mode for Mastodon, the federated microblogging network." diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el index 7c87933..bc70e49 100644 --- a/test/mastodon-notifications-tests.el +++ b/test/mastodon-notifications-tests.el @@ -187,11 +187,11 @@ "Ensure get request format for notifictions is accurate." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications")) - (mock (mastodon-profile-fetch-server-account-settings) - => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications")) + (mock (mastodon-profile--fetch-server-account-settings) + => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) - (mastodon-notifications--get)))) + (mastodon-notifications--get)))) (defun mastodon-notifications--test-type (fun sample) "Test notification draw functions. diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 267e48b..9d1ec72 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -227,64 +227,64 @@ help identify when things change unexpectedly. TODO: Consider separating the data retrieval and the actual content generation in the function under test." (with-mock - ;; Don't start any image loading: - (mock (mastodon-media--inline-images * *) => nil) - (if (version< emacs-version "27.1") - (mock (image-type-available-p 'imagemagick) => t) - (mock (image-transforms-p) => t)) - (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses") - => - gargon-statuses-json) - (mock (mastodon-profile--get-statuses-pinned *) - => - []) - (mock (mastodon-profile--relationships-get "1") - => - '(((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . "")))) - ;; Let's not do formatting as that makes it hard to not rely on - ;; window width and reflowing the text. - (mock (shr-render-region * *) => nil) - ;; Don't perform the actual update call at the end. - ;;(mock (mastodon-tl--timeline *)) - (mock (mastodon-profile-fetch-server-account-settings) - => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) + ;; Don't start any image loading: + (mock (mastodon-media--inline-images * *) => nil) + (if (version< emacs-version "27.1") + (mock (image-type-available-p 'imagemagick) => t) + (mock (image-transforms-p) => t)) + (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses") + => + gargon-statuses-json) + (mock (mastodon-profile--get-statuses-pinned *) + => + []) + (mock (mastodon-profile--relationships-get "1") + => + '(((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . "")))) + ;; Let's not do formatting as that makes it hard to not rely on + ;; window width and reflowing the text. + (mock (shr-render-region * *) => nil) + ;; Don't perform the actual update call at the end. + ;;(mock (mastodon-tl--timeline *)) + (mock (mastodon-profile--fetch-server-account-settings) + => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) - (let ((mastodon-tl--show-avatars t) - (mastodon-tl--display-media-p t) - (mastodon-instance-url "https://instance.url")) - (mastodon-profile--make-author-buffer gargron-profile-json) + (let ((mastodon-tl--show-avatars t) + (mastodon-tl--display-media-p t) + (mastodon-instance-url "https://instance.url")) + (mastodon-profile--make-author-buffer gargron-profile-json) - (should - (equal - (buffer-substring-no-properties (point-min) (point-max)) - (concat - "\n" - "[img] [img] \n" - "Eugen\n" - "@Gargron\n" - " ------------\n" - "<p>Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.</p>\n" - "_ Patreon __ :: <a href=\"https://www.patreon.com/mastodon\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://www.</span><span class=\"\">patreon.com/mastodon</span><span class=\"invisible\"></span></a>_ Homepage _ :: <a href=\"https://zeonfederated.com\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">zeonfederated.com</span><span class=\"invisible\"></span></a>\n" - " ------------\n" - " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" - " ------------\n" - "\n" - " ------------\n" - " TOOTS \n" - " ------------\n" - "\n" - "<p>Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.</p> \n" - " Eugen (@Gargron) 2021-11-11 11:11:11\n" - " ------------\n" - "\n" - "\n" - "<p><span class=\"h-card\"><a href=\"https://social.bau-ha.us/@CCC\" class=\"u-url mention\">@<span>CCC</span></a></span> At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.</p> \n" - " Eugen (@Gargron) 2021-11-11 00:00:00\n" - " ------------\n" - "\n" - ))) + (should + (equal + (buffer-substring-no-properties (point-min) (point-max)) + (concat + "\n" + "[img] [img] \n" + "Eugen\n" + "@Gargron\n" + " ------------\n" + "<p>Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.</p>\n" + "_ Patreon __ :: <a href=\"https://www.patreon.com/mastodon\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://www.</span><span class=\"\">patreon.com/mastodon</span><span class=\"invisible\"></span></a>_ Homepage _ :: <a href=\"https://zeonfederated.com\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">zeonfederated.com</span><span class=\"invisible\"></span></a>\n" + " ------------\n" + " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" + " ------------\n" + "\n" + " ------------\n" + " TOOTS \n" + " ------------\n" + "\n" + "<p>Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.</p> \n" + " Eugen (@Gargron) 2021-11-11 11:11:11\n" + " ------------\n" + "\n" + "\n" + "<p><span class=\"h-card\"><a href=\"https://social.bau-ha.us/@CCC\" class=\"u-url mention\">@<span>CCC</span></a></span> At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.</p> \n" + " Eugen (@Gargron) 2021-11-11 00:00:00\n" + " ------------\n" + "\n" + ))) - ;; Until the function gets refactored this creates a non-temp - ;; buffer with Gargron's statuses which we want to delete (if - ;; the tests succeed). - (kill-buffer)))) + ;; Until the function gets refactored this creates a non-temp + ;; buffer with Gargron's statuses which we want to delete (if + ;; the tests succeed). + (kill-buffer)))) |