From 788577427993c97302d29ee8e6fbfc841f550138 Mon Sep 17 00:00:00 2001 From: "Nicolas P. Rougier" Date: Sun, 20 Nov 2022 15:29:33 +0100 Subject: Added a user customizable symbol list --- lisp/mastodon-tl.el | 40 +++++++++++++++++++++++++++++++--------- 1 file changed, 31 insertions(+), 9 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 86a7b56..0cdb421 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -106,6 +106,21 @@ width fonts when rendering HTML text")) :group 'mastodon-tl :type '(boolean :tag "Whether to display user avatars in timelines")) +;; Various symbols using throughout timeline +;; Default comes from nerd-font (www.nerdfonts.com) +(defcustom mastodon-tl-symbols '((reply . ("" . "R")) + (boost . ("" . "B")) + (favourite . ("" . "F")) + (bookmark . ("" . "K")) + (media . ("" . "M")) + (verified . ("" . "V")) + (private . ("" . "P")) + (direct . ("" . "D"))) + "Set of symbols (or 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. @@ -200,6 +215,19 @@ types of mastodon links and not just shr.el-generated ones.") "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)) + "?")) + + (defun mastodon-tl--next-tab-item () "Move to the next interesting item. @@ -551,9 +579,7 @@ this just means displaying toot client." (faved (equal 't (mastodon-tl--field 'favourited toot))) (boosted (equal 't (mastodon-tl--field 'reblogged toot))) (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot))) - (bookmark-str (if (fontp (char-displayable-p #10r128278)) - "🔖" - "K")) + (bookmark-str (mastodon-tl--symbol 'bookmark)) (visibility (mastodon-tl--field 'visibility toot))) (concat ;; Boosted/favourited markers are not technically part of the byline, so @@ -575,13 +601,9 @@ this just means displaying toot client." ;; in `mastodon-tl--byline-author' (funcall author-byline toot) (cond ((equal visibility "direct") - (if (fontp (char-displayable-p #10r9993)) - " ✉" - " [direct]")) + (mastodon-tl--symbol 'direct)) ((equal visibility "private") - (if (fontp (char-displayable-p #10r128274)) - " 🔒" - " [followers]"))) + (mastodon-tl--symbol 'private)) (funcall action-byline toot) " " ;; TODO: Once we have a view for toot (responses etc.) make -- cgit v1.2.3 From 25bb8619e215bdc8715aeb3f53724ad1f9af35b1 Mon Sep 17 00:00:00 2001 From: "Nicolas P. Rougier" Date: Sun, 20 Nov 2022 15:59:49 +0100 Subject: Fix a missing parenthesis & added links to default icons --- lisp/mastodon-tl.el | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0cdb421..1a26a54 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -108,14 +108,23 @@ width fonts when rendering HTML text")) ;; Various symbols using throughout timeline ;; Default comes from nerd-font (www.nerdfonts.com) -(defcustom mastodon-tl-symbols '((reply . ("" . "R")) - (boost . ("" . "B")) - (favourite . ("" . "F")) - (bookmark . ("" . "K")) - (media . ("" . "M")) - (verified . ("" . "V")) - (private . ("" . "P")) - (direct . ("" . "D"))) +(defcustom mastodon-tl-symbols + '(;; See https://icon-sets.iconify.design/octicon/comment-24/ + (reply . ("" . "R")) + ;; See https://icon-sets.iconify.design/octicon/reply-24/ + (boost . ("" . "B")) + ;; See https://icon-sets.iconify.design/octicon/star-fill-24/ + (favourite . ("" . "F")) + ;; See https://icon-sets.iconify.design/octicon/bookmark-24/ + (bookmark . ("" . "K")) + ;; See https://icon-sets.iconify.design/octicon/file-media-24/ + (media . ("" . "M")) + ;; See https://icon-sets.iconify.design/octicon/verified-24/ + (verified . ("" . "V")) + ;; See https://icon-sets.iconify.design/octicon/person-fill-24/ + (private . ("" . "P")) + ;; See https://icon-sets.iconify.design/octicon/location-24/ + (direct . ("" . "D"))) "Set of symbols (or 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) @@ -603,7 +612,7 @@ this just means displaying toot client." (cond ((equal visibility "direct") (mastodon-tl--symbol 'direct)) ((equal visibility "private") - (mastodon-tl--symbol 'private)) + (mastodon-tl--symbol 'private))) (funcall action-byline toot) " " ;; TODO: Once we have a view for toot (responses etc.) make -- cgit v1.2.3 From cc5b8b36588d2c7caa6bc013580aaf01ef0a880d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 10:27:13 +0100 Subject: fix toot del/pin tests --- test/mastodon-toot-tests.el | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index 9741964..b88510c 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -120,11 +120,12 @@ mention string." "Should refuse to delete toot." (let ((toot mastodon-toot-test-base-toot)) (with-mock - (mock (mastodon-auth--user-acct) => "joebogus") - ;; (mock (mastodon-toot--own-toot-p toot) => nil) - (mock (mastodon-tl--property 'toot-json) => mastodon-toot-test-base-toot) - (should (equal (mastodon-toot--delete-toot) - "You can only delete (and redraft) your own toots."))))) + (mock (mastodon-auth--user-acct) => "joebogus") + ;; (mock (mastodon-toot--own-toot-p toot) => nil) + (mock (mastodon-tl--property 'toot-json) => mastodon-toot-test-base-toot) + (mock (mastodon-tl--property 'base-toot) => toot) + (should (equal (mastodon-toot--delete-toot) + "You can only delete (and redraft) your own toots."))))) (ert-deftest mastodon-toot--delete-toot () "Should return correct triaged response to a legitimate DELETE request." @@ -133,16 +134,17 @@ mention string." (let ((delete-response (current-buffer)) (toot mastodon-toot-test-base-toot)) (with-mock - (mock (mastodon-tl--property 'toot-json) => toot) - ;; (mock (mastodon-toot--own-toot-p toot) => t) - (mock (mastodon-auth--user-acct) => "acct42@example.space") - (mock (mastodon-http--api (format "statuses/61208")) - => "https://example.space/statuses/61208") - (mock (y-or-n-p "Delete this toot? ") => t) - (mock (mastodon-http--delete "https://example.space/statuses/61208") - => delete-response) - (should (equal (mastodon-toot--delete-toot) - "Toot deleted!")))))) + (mock (mastodon-tl--property 'toot-json) => toot) + (mock (mastodon-tl--property 'base-toot) => toot) + ;; (mock (mastodon-toot--own-toot-p toot) => t) + (mock (mastodon-auth--user-acct) => "acct42@example.space") + (mock (mastodon-http--api (format "statuses/61208")) + => "https://example.space/statuses/61208") + (mock (y-or-n-p "Delete this toot? ") => t) + (mock (mastodon-http--delete "https://example.space/statuses/61208") + => delete-response) + (should (equal (mastodon-toot--delete-toot) + "Toot deleted!")))))) (ert-deftest mastodon-toot-action-pin () "Should return callback provided by `mastodon-toot--pin-toot-toggle'." @@ -167,7 +169,8 @@ mention string." (let ((pin-response (current-buffer)) (toot mastodon-toot-test-base-toot)) (with-mock - (mock (mastodon-tl--property 'toot-json) => toot) - (mock (mastodon-auth--user-acct) => "joebogus@example.space") - (should (equal (mastodon-toot--pin-toot-toggle) - "You can only pin your own toots.")))))) + (mock (mastodon-tl--property 'toot-json) => toot) + (mock (mastodon-tl--property 'base-toot) => toot) + (mock (mastodon-auth--user-acct) => "joebogus@example.space") + (should (equal (mastodon-toot--pin-toot-toggle) + "You can only pin your own toots.")))))) -- cgit v1.2.3 From 51c2e36901fda077a438b311d7618e637bae3ee7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 11:31:39 +0100 Subject: autoload notifs--get, clean up buffer-name arg/handling in same --- lisp/mastodon-notifications.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 62cdfe7..ae82b60 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -50,6 +50,7 @@ (autoload 'mastodon-http--get-params-async-json "mastodon-http.el") (autoload 'mastodon-profile--view-follow-requests "mastodon-profile.el") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") +(autoload 'mastodon-tl--update "mastodon-tl") (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) (defvar mastodon-mode-map) @@ -276,11 +277,13 @@ of the toot responded to." (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) +;;;###autoload (defun mastodon-notifications--get (&optional type buffer-name) "Display NOTIFICATIONS in buffer. -Optionally only print notifications of type TYPE, a string." +Optionally only print notifications of type TYPE, a string. +BUFFER-NAME is added to \"*mastodon-\" to create the buffer name." (interactive) - (let ((buffer (or (concat "*mastodon-" buffer-name) + (let ((buffer (or (concat "*mastodon-" buffer-name "*") "*mastodon-notifications*"))) (if (get-buffer buffer) (progn (switch-to-buffer buffer) -- cgit v1.2.3 From de20da981c13fe29f5451f056d735a7b07ba156a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 11:38:41 +0100 Subject: readme bookmark emoji --- README.org | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/README.org b/README.org index c6df5ed..97e2f4f 100644 --- a/README.org +++ b/README.org @@ -169,13 +169,13 @@ take place if your =mastodon-token-file= does not contain =:client_id= and **** Toot byline legend -|----------------+------------------------| -| Marker | Meaning | -|----------------+------------------------| -| =(B)= | I boosted this toot | -| =(F)= | I favourited this toot | -| (=K=) (or emoji) | I bookmarked this toot | -|----------------+------------------------| +|---------------+------------------------| +| Marker | Meaning | +|---------------+------------------------| +| =(B)= | I boosted this toot | +| =(F)= | I favourited this toot | +| =(🔖)= (or (=K=)) | I bookmarked this toot | +|---------------+------------------------| *** Composing toots -- cgit v1.2.3 From c19cd695b3f40a9de508e066989cb23438c9c7f7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 11:46:20 +0100 Subject: make mastodon-notifications-get a global function so we can view notifs without first openin other masto buffers - move it to mastodon.el - autoload cookie - rename all instances - pray the keymap works --- README.org | 5 ++++- lisp/mastodon-discover.el | 2 +- lisp/mastodon-notifications.el | 34 ++++++++-------------------------- lisp/mastodon-tl.el | 4 ++-- lisp/mastodon.el | 26 ++++++++++++++++++++++++-- test/mastodon-notifications-tests.el | 2 +- 6 files changed, 40 insertions(+), 33 deletions(-) diff --git a/README.org b/README.org index 97e2f4f..8eb9242 100644 --- a/README.org +++ b/README.org @@ -222,7 +222,10 @@ You can download and use your instance's custom emoji *** 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. +In addition to =mastodon=, the following functions are autoloaded and should work without first loading =mastodon.el=: +- =mastodon-toot=: Compose new toot +- =mastodon-notifications-get=: View all notifications +- =mastodon-url-lookup=: Attempt to load a URL in =mastodon.el=. URL may be at point or provided in the minibuffer. - =mastodon-tl--view-instance-description=: View information about the instance that the author of the toot at point is on. diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 5d1a86e..dc8a924 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -76,7 +76,7 @@ ("F" "Federated" mastodon-tl--get-federated-timeline) ("H" "Home" mastodon-tl--get-home-timeline) ("L" "Local" mastodon-tl--get-local-timeline) - ("N" "Notifications" mastodon-notifications--get) + ("N" "Notifications" mastodon-notifications-get) ("u" "Update timeline" mastodon-tl--update) ("S" "Search" mastodon-search--search-query) ("O" "Jump to your profile" mastodon-profile--my-profile) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index ae82b60..a11513e 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -51,6 +51,7 @@ (autoload 'mastodon-profile--view-follow-requests "mastodon-profile.el") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") +(autoload 'mastodon-notifications-get "mastodon") (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) (defvar mastodon-mode-map) @@ -83,7 +84,7 @@ (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) + (define-key map (kbd "g") #'mastodon-notifications-get) (keymap-canonicalize map)) "Keymap for viewing notifications.") @@ -125,7 +126,7 @@ follow-requests view." (lambda () (if f-reqs-view-p (mastodon-profile--view-follow-requests) - (mastodon-notifications--get)) + (mastodon-notifications-get)) (message "Follow request of %s (@%s) %s!" name handle (if reject "rejected" @@ -277,51 +278,32 @@ of the toot responded to." (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) -;;;###autoload -(defun mastodon-notifications--get (&optional type buffer-name) - "Display NOTIFICATIONS in buffer. -Optionally only print notifications of type TYPE, a string. -BUFFER-NAME is added to \"*mastodon-\" to create the buffer name." - (interactive) - (let ((buffer (or (concat "*mastodon-" buffer-name "*") - "*mastodon-notifications*"))) - (if (get-buffer buffer) - (progn (switch-to-buffer buffer) - (mastodon-tl--update)) - (message "Loading your notifications...") - (mastodon-tl--init-sync - (or buffer-name "notifications") - "notifications" - '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")) + (mastodon-notifications-get "mention" "mentions")) (defun mastodon-notifications--get-favourites () "Display favourite notifications in buffer." (interactive) - (mastodon-notifications--get "favourite" "favourites")) + (mastodon-notifications-get "favourite" "favourites")) (defun mastodon-notifications--get-boosts () "Display boost notifications in buffer." (interactive) - (mastodon-notifications--get "reblog" "boosts")) + (mastodon-notifications-get "reblog" "boosts")) (defun mastodon-notifications--get-polls () "Display poll notifications in buffer." (interactive) - (mastodon-notifications--get "poll" "polls")) + (mastodon-notifications-get "poll" "polls")) (defun mastodon-notifications--get-statuses () "Display status notifications in buffer. Status notifications are created when you call `mastodon-tl--enable-notify-user-posts'." (interactive) - (mastodon-notifications--get "status" "statuses")) + (mastodon-notifications-get "status" "statuses")) (defun mastodon-notifications--filter-types-list (type) "Return a list of notification types with TYPE removed." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 34048e7..aa58771 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -61,7 +61,7 @@ (autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (autoload 'mastodon-profile-mode "mastodon-profile") ;; make notifications--get available via M-x and outside our keymap: -(autoload 'mastodon-notifications--get "mastodon-notifications" +(autoload 'mastodon-notifications-get "mastodon-notifications" "Display NOTIFICATIONS in buffer." t) ; interactive (autoload 'mastodon-search--propertize-user "mastodon-search") (autoload 'mastodon-search--insert-users-propertized "mastodon-search") @@ -2238,7 +2238,7 @@ For use after e.g. deleting a toot." ((equal (mastodon-tl--get-endpoint) "timelines/public?local=true") (mastodon-tl--get-local-timeline)) ((equal (mastodon-tl--get-endpoint) "notifications") - (mastodon-notifications--get)) + (mastodon-notifications-get)) ((equal (mastodon-tl--buffer-name) (concat "*mastodon-" (mastodon-auth--get-account-name) "-statuses*")) (mastodon-profile--my-profile)) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 5be168c..527de18 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -57,7 +57,6 @@ (autoload 'mastodon-tl--thread "mastodon-tl") (autoload 'mastodon-tl--toggle-spoiler-text-in-toot "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") -(autoload 'mastodon-notifications--get "mastodon-notifications") (autoload 'mastodon-profile--get-toot-author "mastodon-profile") (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") (autoload 'mastodon-profile--show-user "mastodon-profile") @@ -96,6 +95,10 @@ (autoload 'mastodon-tl--view-lists "mastodon-tl") (autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (autoload 'mastodon-toot--view-toot-history "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-notifications--timeline "mastodon-notifications") + +(defvar mastodon-notifications--map) (defgroup mastodon nil "Interface with Mastodon." @@ -160,7 +163,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "F") #'mastodon-tl--get-federated-timeline) (define-key map (kbd "H") #'mastodon-tl--get-home-timeline) (define-key map (kbd "L") #'mastodon-tl--get-local-timeline) - (define-key map (kbd "N") #'mastodon-notifications--get) + (define-key map (kbd "N") #'mastodon-notifications-get) (define-key map (kbd "P") #'mastodon-profile--show-user) (define-key map (kbd "T") #'mastodon-tl--thread) ;; navigation out of mastodon @@ -267,6 +270,25 @@ If REPLY-JSON is the json of the toot being replied to." (interactive) (mastodon-toot--compose-buffer user reply-to-id reply-json)) +;;;###autoload +(defun mastodon-notifications-get (&optional type buffer-name) + "Display NOTIFICATIONS in buffer. +Optionally only print notifications of type TYPE, a string. +BUFFER-NAME is added to \"*mastodon-\" to create the buffer name." + (interactive) + (let ((buffer (or (concat "*mastodon-" buffer-name "*") + "*mastodon-notifications*"))) + (if (get-buffer buffer) + (progn (switch-to-buffer buffer) + (mastodon-tl--update)) + (message "Loading your notifications...") + (mastodon-tl--init-sync + (or buffer-name "notifications") + "notifications" + 'mastodon-notifications--timeline + type) + (use-local-map mastodon-notifications--map)))) + ;; URL lookup: should be available even if `mastodon.el' not loaded: ;;;###autoload diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el index bc70e49..1275c72 100644 --- a/test/mastodon-notifications-tests.el +++ b/test/mastodon-notifications-tests.el @@ -191,7 +191,7 @@ (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. -- cgit v1.2.3 From 50d77f205861cb5cdd4a4c97d5f320073303b81b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 16:48:05 +0100 Subject: masto mode map: 'g' calls --update --- lisp/mastodon.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 5be168c..225565a 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -171,11 +171,13 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "c") #'mastodon-tl--toggle-spoiler-text-in-toot) (define-key map (kbd "f") #'mastodon-toot--toggle-favourite) (define-key map (kbd "r") #'mastodon-toot--reply) + ;; this is now duplicated by 'g', cd remove/use for else: (define-key map (kbd "u") #'mastodon-tl--update) ;; new toot (define-key map (kbd "t") #'mastodon-toot) ;; override special mode binding (define-key map (kbd "g") #'undefined) + (define-key map (kbd "g") #'mastodon-tl--update) ;; mousebot additions (define-key map (kbd "W") #'mastodon-tl--follow-user) (define-key map (kbd "C-S-W") #'mastodon-tl--unfollow-user) -- cgit v1.2.3 From 01d44daa21cc24e99e61bba36e0dc2a111e46586 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 16:48:05 +0100 Subject: masto mode map: 'g' calls --update also remove notifs-get from same key in notifs map, for consistency --- lisp/mastodon-notifications.el | 1 - lisp/mastodon.el | 3 ++- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index a11513e..f5ddea3 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -84,7 +84,6 @@ (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.") diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 527de18..04330f6 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -174,11 +174,13 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "c") #'mastodon-tl--toggle-spoiler-text-in-toot) (define-key map (kbd "f") #'mastodon-toot--toggle-favourite) (define-key map (kbd "r") #'mastodon-toot--reply) + ;; this is now duplicated by 'g', cd remove/use for else: (define-key map (kbd "u") #'mastodon-tl--update) ;; new toot (define-key map (kbd "t") #'mastodon-toot) ;; override special mode binding (define-key map (kbd "g") #'undefined) + (define-key map (kbd "g") #'mastodon-tl--update) ;; mousebot additions (define-key map (kbd "W") #'mastodon-tl--follow-user) (define-key map (kbd "C-S-W") #'mastodon-tl--unfollow-user) @@ -207,7 +209,6 @@ Use. e.g. \"%c\" for your locale's date and time format." (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) - "Keymap for `mastodon-mode'.") (defcustom mastodon-mode-hook nil -- cgit v1.2.3 From 7d9453c72e94159b06b4059e3444cd65267805d8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 16:48:05 +0100 Subject: masto mode map: 'g' calls --update also remove notifs-get from same key in notifs map, for consistency --- lisp/mastodon-notifications.el | 1 - lisp/mastodon.el | 1 - 2 files changed, 2 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index ae82b60..f9e2fe5 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -83,7 +83,6 @@ (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.") diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 225565a..d8591e1 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -206,7 +206,6 @@ Use. e.g. \"%c\" for your locale's date and time format." (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) - "Keymap for `mastodon-mode'.") (defcustom mastodon-mode-hook nil -- cgit v1.2.3 From bf7cc6fd0cde8b3caba850bad7c9b217bef481a7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 17:49:12 +0100 Subject: hack separator and propertizing for lists properties mean that the list-at-point functions also work on accounts/whitespace within the particular list. --- lisp/mastodon-tl.el | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 34048e7..b1cbce1 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1594,7 +1594,9 @@ If ID is provided, delete that list." \n E - edit a list\n n/p - go to next/prev item]\n\n" 'font-lock-comment-face)) (mapc (lambda (x) - (mastodon-tl--print-list-accounts x)) + (mastodon-tl--print-list-accounts x) + (insert (propertize " ------------\n\n" + 'face 'success))) lists-names) (goto-char (point-min)))) ;; (mastodon-tl--goto-next-item))) ; causes another request! @@ -1609,8 +1611,17 @@ If ID is provided, delete that list." 'toot-id "0" ; so we nav here 'help-echo "RET: view list timeline, d: delete this list, \ a: add account to this list, r: remove account from this list" - 'face 'link) ; '((:underline t :inherit success))) - "\n\n" + 'list t + 'face 'link + 'keymap mastodon-tl--list-name-keymap + 'list-name list-name + 'list-id id) + (propertize + "\n\n" + 'list t + 'keymap mastodon-tl--list-name-keymap + 'list-name list-name + 'list-id id) (propertize (mapconcat #'mastodon-search--propertize-user accounts " ") -- cgit v1.2.3 From 62e18cd138f322b0e1b8ce1139b4d129f6929b9a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 18:25:35 +0100 Subject: no switch to response buffer on non-200 http response --- lisp/mastodon-http.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 6e7bfb3..37770ef 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -88,11 +88,13 @@ Message status and JSON error from RESPONSE if unsuccessful." (mastodon-http--status)))) (if (string-prefix-p "2" status) (funcall success) - (switch-to-buffer response) - ;; 404 returns http response not JSON: + ;; don't switch to buffer, just with-current-buffer the response: + ;; (switch-to-buffer response) + ;; 404 sometimes returns http response so --process-json fails: (if (string-prefix-p "404" status) (message "Error %s: page not found" status) - (let ((json-response (mastodon-http--process-json))) + (let ((json-response (with-current-buffer response + (mastodon-http--process-json)))) (message "Error %s: %s" status (alist-get 'error json-response))))))) (defun mastodon-http--read-file-as-string (filename) -- cgit v1.2.3 From 4f022007b8b1000c78881c5633c35f3f09afd955 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 20:36:20 +0100 Subject: add joined date to profile pages --- lisp/mastodon-profile.el | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index f81441e..e0b8279 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -555,7 +555,9 @@ FIELDS means provide a fields vector fetched by other means." (alist-get 'followed_by relationships))) (followsp (or (equal follows-you 't) (equal followed-by-you 't))) (fields (mastodon-profile--fields-get account)) - (pinned (mastodon-profile--get-statuses-pinned account))) + (pinned (mastodon-profile--get-statuses-pinned account)) + (joined-ts (ts-parse + (mastodon-profile--account-field account 'created_at)))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) @@ -600,7 +602,15 @@ FIELDS means provide a fields vector fetched by other means." (mastodon-profile--fields-insert fields) 'success) "\n") - "")) + "") + (propertize + (format "Joined %s" + (format "%s" (concat (ts-month-name joined-ts) + " " + (number-to-string + (ts-year joined-ts))))) + 'face 'success) + "\n\n") 'profile-json account) ;; insert counts (mastodon-tl--set-face -- cgit v1.2.3 From bd2ac7aa1b896717a8455776936b9f5ca0dd6000 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 20:52:29 +0100 Subject: add fun to display profile statuses without boosts --- lisp/mastodon-profile.el | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index e0b8279..512aae4 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -150,10 +150,10 @@ contains") ;; or handle --property failing (mastodon-tl--property 'toot-json)) -(defun mastodon-profile--make-author-buffer (account) +(defun mastodon-profile--make-author-buffer (account &optional no-reblogs) "Take an ACCOUNT json and insert a user account into a new buffer." (mastodon-profile--make-profile-buffer-for - account "statuses" #'mastodon-tl--timeline)) + account "statuses" #'mastodon-tl--timeline no-reblogs)) ;; TODO: we shd just load all views' data then switch coz this is slow af: (defun mastodon-profile--account-view-cycle () @@ -164,9 +164,17 @@ contains") (mastodon-profile--open-followers)) ((string-suffix-p "followers" endpoint) (mastodon-profile--open-following)) + ((string-suffix-p "following" endpoint) + (mastodon-profile--open-statuses-no-reblogs)) (t - (mastodon-profile--make-profile-buffer-for - mastodon-profile--account "statuses" #'mastodon-tl--timeline))))) + (mastodon-profile--make-author-buffer mastodon-profile--account))))) + +(defun mastodon-profile--open-statuses-no-reblogs () + "Open a profile buffer showing statuses without reblogs." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-author-buffer mastodon-profile--account :no-reblogs) + (error "Not in a mastodon profile"))) (defun mastodon-profile--open-following () "Open a profile buffer showing the accounts that current profile follows." @@ -530,10 +538,14 @@ FIELDS means provide a fields vector fetched by other means." (mastodon-tl--toot pinned-status)) pinned-statuses)) -(defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function) +(defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function &optional no-reblogs) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION." (let* ((id (mastodon-profile--account-field account 'id)) - (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) + (args (when no-reblogs '(("exclude_reblogs" . "t")))) + (base-url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) + (url (if no-reblogs + (concat base-url "?" (mastodon-http--build-query-string args)) + base-url)) (acct (mastodon-profile--account-field account 'acct)) (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) (note (mastodon-profile--account-field account 'note)) -- cgit v1.2.3 From cba97969ea0c21acd8ddf5d5c531aaf252092e97 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 20:56:19 +0100 Subject: fix joined date in profile-tests --- test/mastodon-profile-tests.el | 118 +++++++++++++++++++++-------------------- 1 file changed, 60 insertions(+), 58 deletions(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 9d1ec72..3e238f1 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -227,64 +227,66 @@ 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" - "

Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.

\n" - "_ Patreon __ :: https://www.patreon.com/mastodon_ Homepage _ :: https://zeonfederated.com\n" - " ------------\n" - " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" - " ------------\n" - "\n" - " ------------\n" - " TOOTS \n" - " ------------\n" - "\n" - "

Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.

\n" - " Eugen (@Gargron) 2021-11-11 11:11:11\n" - " ------------\n" - "\n" - "\n" - "

@CCC 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.

\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" + "

Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.

\n" + "_ Patreon __ :: https://www.patreon.com/mastodon_ Homepage _ :: https://zeonfederated.com\n" + " ------------\n" + " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" + " ------------\n" + "\n" + "Joined March 2016" + "\n" + " ------------\n" + " TOOTS \n" + " ------------\n" + "\n" + "

Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.

\n" + " Eugen (@Gargron) 2021-11-11 11:11:11\n" + " ------------\n" + "\n" + "\n" + "

@CCC 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.

\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)))) -- cgit v1.2.3 From 9b9431b130c1d8d1a03e445ae1f7803d2a511d70 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 22:01:07 +0100 Subject: params always in http.el, only ever send alists from elsewhere. probably incomplete but mostly done. --- lisp/mastodon-http.el | 85 +++++++++++++++++++++--------------- lisp/mastodon-profile.el | 28 ++++++------ lisp/mastodon-search.el | 4 +- lisp/mastodon-tl.el | 51 ++++++++-------------- lisp/mastodon-toot.el | 2 +- lisp/mastodon.el | 2 +- test/mastodon-notifications-tests.el | 8 ++-- 7 files changed, 91 insertions(+), 89 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 37770ef..259432e 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -151,27 +151,34 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. (mastodon-http--url-retrieve-synchronously url))) unauthenticated-p)) -(defun mastodon-http--get (url &optional silent) +(defun mastodon-http--get (url &optional params silent) "Make synchronous GET request to URL. -Pass response buffer to CALLBACK function. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." (mastodon-http--authorized-request "GET" - (mastodon-http--url-retrieve-synchronously url silent))) + ;; url-request-data doesn't seem to work with GET requests: + (let ((url (if params + (concat url "?" + (mastodon-http--build-query-string params)) + url))) + (mastodon-http--url-retrieve-synchronously url silent)))) -(defun mastodon-http--get-response (url &optional no-headers silent vector) +(defun mastodon-http--get-response (url &optional params no-headers silent vector) "Make synchronous GET request to URL. Return JSON and response headers. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message. NO-HEADERS means don't collect http response headers. VECTOR means return json arrays as vectors." - (with-current-buffer (mastodon-http--get url silent) + (with-current-buffer (mastodon-http--get url params silent) (mastodon-http--process-response no-headers vector))) -(defun mastodon-http--get-json (url &optional silent vector) +(defun mastodon-http--get-json (url &optional params silent vector) "Return only JSON data from URL request. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message. VECTOR means return json arrays as vectors." - (car (mastodon-http--get-response url :no-headers silent vector))) + (car (mastodon-http--get-response url params :no-headers silent vector))) (defun mastodon-http--process-json () "Return only JSON data from async URL request. @@ -214,35 +221,37 @@ Callback to `mastodon-http--get-response-async', usually (cons (car list) (cadr list)))) head-list))) -(defun mastodon-http--delete (url &optional args) - "Make DELETE request to URL." - (let ((url-request-data - (when args - (mastodon-http--build-query-string args)))) +(defun mastodon-http--delete (url &optional params) + "Make DELETE request to URL. +PARAMS is an alist of any extra parameters to send with the request." + ;; url-request-data only works with POST requests? + (let ((url + (if params + (concat url "?" + (mastodon-http--build-query-string params)) + url))) (mastodon-http--authorized-request "DELETE" (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) -(defun mastodon-http--put (url &optional args headers) - "Make PUT request to URL." +(defun mastodon-http--put (url &optional params headers) + "Make PUT request to URL. +PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--authorized-request "PUT" (let ((url-request-data - (when args - (mastodon-http--build-query-string args))) + (when args (mastodon-http--build-query-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: (unless (assoc "Content-Type" headers) '(("Content-Type" . "application/x-www-form-urlencoded"))) headers))) - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url))))) + (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) (defun mastodon-http--append-query-string (url params) "Append PARAMS to URL as query strings and return it. - PARAMS should be an alist as required by `url-build-query-string'." (let ((query-string (url-build-query-string params))) (concat url "?" query-string))) @@ -259,24 +268,25 @@ PARAMS should be an alist as required by `url-build-query-string'." (kill-buffer) (json-read-from-string json-string))) -(defun mastodon-http--get-search-json (url query &optional param silent) +(defun mastodon-http--get-search-json (url query &optional params silent) "Make GET request to URL, searching for QUERY and return JSON response. -PARAM is any extra parameters to send with the request. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." - (let ((buffer (mastodon-http--get-search url query param silent))) + (let ((buffer (mastodon-http--get-search url query params silent))) (with-current-buffer buffer (mastodon-http--process-json-search)))) -(defun mastodon-http--get-search (base-url query &optional param silent) +(defun mastodon-http--get-search (base-url query &optional params silent) "Make GET request to BASE-URL, searching for QUERY. Pass response buffer to CALLBACK function. -PARAM is a formatted request parameter, eg 'following=true'. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." (mastodon-http--authorized-request "GET" - (let ((url (if param - (concat base-url "?" param "&q=" (url-hexify-string query)) - (concat base-url "?q=" (url-hexify-string query))))) + (let* ((query-str (mastodon-http--build-query-string + `(("q" . ,(url-hexify-string query))))) + (params-str (mastodon-http--build-query-string params)) + (url (concat base-url "?" query-str params-str))) (mastodon-http--url-retrieve-synchronously url silent)))) ;; profile update functions @@ -299,12 +309,17 @@ Optionally specify the PARAMS to send." ;; Asynchronous functions -(defun mastodon-http--get-async (url &optional callback &rest cbargs) +(defun mastodon-http--get-async (url &optional params callback &rest cbargs) "Make GET request to URL. -Pass response buffer to CALLBACK function with args CBARGS." - (mastodon-http--authorized-request - "GET" - (url-retrieve url callback cbargs))) +Pass response buffer to CALLBACK function with args CBARGS. +PARAMS is an alist of any extra parameters to send with the request." + (let ((url (if params + (concat url "?" + (mastodon-http--build-query-string params)) + url))) + (mastodon-http--authorized-request + "GET" + (url-retrieve url callback cbargs)))) (defun mastodon-http--get-response-async (url callback &rest args) "Make GET request to URL. Call CALLBACK with http response and ARGS." @@ -314,9 +329,11 @@ Pass response buffer to CALLBACK function with args CBARGS." (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-response) args))))) -(defun mastodon-http--get-json-async (url callback &rest args) - "Make GET request to URL. Call CALLBACK with json-list and ARGS." +(defun mastodon-http--get-json-async (url &optional params callback &rest args) + "Make GET request to URL. Call CALLBACK with json-list and ARGS. +PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async + params url (lambda (status) (when status ;; only when we actually get sth? diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 512aae4..975f7b7 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -36,6 +36,7 @@ (require 'seq) (require 'cl-lib) (require 'persist) +(require 'ts) (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") @@ -492,11 +493,10 @@ This endpoint only holds a few preferences. For others, see (defun mastodon-profile--relationships-get (id) "Fetch info about logged-in user's relationship to user with id ID." (let* ((their-id id) - (url (mastodon-http--api (format - "accounts/relationships?id[]=%s" - their-id)))) + (args `(("id[]" . ,their-id))) + (url (mastodon-http--api "accounts/relationships"))) ;; FIXME: not sure why we need to do this for relationships only! - (car (mastodon-http--get-json url)))) + (car (mastodon-http--get-json url args)))) (defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. @@ -527,8 +527,9 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--get-statuses-pinned (account) "Fetch the pinned toots for ACCOUNT." (let* ((id (mastodon-profile--account-field account 'id)) - (url (mastodon-http--api (format "accounts/%s/statuses?pinned=true" id)))) - (mastodon-http--get-json url))) + (args `(("pinned" . "true"))) + (url (mastodon-http--api (format "accounts/%s/statuses" id)))) + (mastodon-http--get-json url args))) (defun mastodon-profile--insert-statuses-pinned (pinned-statuses) "Insert each of the PINNED-STATUSES for a given account." @@ -538,18 +539,17 @@ FIELDS means provide a fields vector fetched by other means." (mastodon-tl--toot pinned-status)) pinned-statuses)) -(defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function &optional no-reblogs) +(defun mastodon-profile--make-profile-buffer-for (account endpoint-type + update-function + &optional no-reblogs) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION." (let* ((id (mastodon-profile--account-field account 'id)) (args (when no-reblogs '(("exclude_reblogs" . "t")))) - (base-url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) - (url (if no-reblogs - (concat base-url "?" (mastodon-http--build-query-string args)) - base-url)) + (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) (acct (mastodon-profile--account-field account 'acct)) (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) (note (mastodon-profile--account-field account 'note)) - (json (mastodon-http--get-json url)) + (json (mastodon-http--get-json url args)) (locked (mastodon-profile--account-field account 'locked)) (followers-count (mastodon-tl--as-string (mastodon-profile--account-field @@ -751,12 +751,14 @@ If the handle does not match a search return then retun NIL." (let* ((handle (if (string= "@" (substring handle 0 1)) (substring handle 1 (length handle)) handle)) + (args `(("q" . ,handle))) (matching-account (seq-remove (lambda (x) (not (string= (alist-get 'acct x) handle))) (mastodon-http--get-json - (mastodon-http--api (format "accounts/search?q=%s" handle)))))) + (mastodon-http--api "accounts/search") + args)))) (when (equal 1 (length matching-account)) (elt matching-account 0)))) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 31fcae3..fee79c4 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -61,7 +61,7 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api "accounts/search")) (response (if (equal mastodon-toot--completion-style-for-mentions "following") - (mastodon-http--get-search-json url query "following=true") + (mastodon-http--get-search-json url query '(("following" . "true"))) (mastodon-http--get-search-json url query)))) (mapcar #'mastodon-search--get-user-info-@ response))) @@ -72,7 +72,7 @@ Returns a nested list containing user handle, display name, and URL." QUERY is the string to search." (interactive "sSearch for hashtag: ") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (type-param (concat "type=hashtags")) + (type-param '(("type" . "hashtags"))) (response (mastodon-http--get-search-json url query type-param)) (tags (alist-get 'hashtags response))) (mapcar #'mastodon-search--get-hashtag-info tags))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b1cbce1..fd74ed5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -77,6 +77,7 @@ (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") +(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -1305,38 +1306,23 @@ LINK-HEADER is the http Link header if present." (defun mastodon-tl--more-json (endpoint id) "Return JSON for timeline ENDPOINT before ID." - (let* ((url (mastodon-http--api (concat - endpoint - (if (string-match-p "?" endpoint) - "&" - "?") - "max_id=" - (mastodon-tl--as-string id))))) - (mastodon-http--get-json url))) + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url args))) (defun mastodon-tl--more-json-async (endpoint id callback &rest cbargs) "Return JSON for timeline ENDPOINT before ID. Then run CALLBACK with arguments CBARGS." - (let* ((url (mastodon-http--api (concat - endpoint - (if (string-match-p "?" endpoint) - "&" - "?") - "max_id=" - (mastodon-tl--as-string id))))) - (apply 'mastodon-http--get-json-async url callback cbargs))) + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) + (apply 'mastodon-http--get-json-async url params callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local (defun mastodon-tl--updated-json (endpoint id) "Return JSON for timeline ENDPOINT since ID." - (let ((url (mastodon-http--api (concat - endpoint - (if (string-match-p "?" endpoint) - "&" - "?") - "since_id=" - (mastodon-tl--as-string id))))) + (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) (mastodon-http--get-json url))) (defun mastodon-tl--property (prop &optional backward) @@ -1417,8 +1403,9 @@ ID is that of the toot to view." ;; refetch current toot in case we just faved/boosted: (mastodon-http--get-json (mastodon-http--api (concat "statuses/" id)) + nil :silent)) - (context (mastodon-http--get-json url :silent)) + (context (mastodon-http--get-json url nil :silent)) (marker (make-marker))) (if (equal (caar toot) 'error) (message "Error: %s" (cdar toot)) @@ -1690,13 +1677,9 @@ If ID is provided, use that list." (account (completing-read "Account to remove: " handles nil t)) (account-id (alist-get account handles nil nil 'equal)) - ;; letting --delete handle the params doesn't work - ;; so we do it here for now: - (base-url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) (args (mastodon-http--build-array-args-alist "account_ids[]" `(,account-id))) - (query-str (mastodon-http--build-query-string args)) - (url (concat base-url "?" query-str)) - (response (mastodon-http--delete url))) + (response (mastodon-http--delete url args))) (mastodon-tl--list-action-triage response (message "%s removed from list %s!" account list-name)))) @@ -2535,14 +2518,14 @@ Optional arg NOTE-TYPE means only get that type of note." (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))) + ;; (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)) + ;; (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))) + (json (mastodon-http--get-json url args))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5a735dc..24c6c75 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -728,7 +728,7 @@ instance to edit a toot." (defun mastodon-toot--get-toot-source (id) "Fetch the source JSON of toot with ID." (let ((url (mastodon-http--api (format "/statuses/%s/source" id)))) - (mastodon-http--get-json url :silent))) + (mastodon-http--get-json url nil :silent))) (defun mastodon-toot--get-toot-edits (id) "Return the edit history of toot with ID." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index d8591e1..cfe6681 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -291,7 +291,7 @@ not, just browse the URL in the normal fashion." (browse-url query) (message "Performing lookup...") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (param (concat "resolve=t")) ; webfinger + (param '(("resolve" . "t"))) ; webfinger (response (mastodon-http--get-search-json url query param :silent))) (cond ((not (seq-empty-p (alist-get 'statuses response))) diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el index bc70e49..18fc757 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" nil)) + (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. -- cgit v1.2.3 From d47a5ebab961be106d1745cbb36037787edcbbba Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 20:56:19 +0100 Subject: fix joined date in profile-tests fix profile test joined date --- test/mastodon-profile-tests.el | 118 +++++++++++++++++++++-------------------- 1 file changed, 60 insertions(+), 58 deletions(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 9d1ec72..bf0bc3f 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -227,64 +227,66 @@ 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" - "

Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.

\n" - "_ Patreon __ :: https://www.patreon.com/mastodon_ Homepage _ :: https://zeonfederated.com\n" - " ------------\n" - " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" - " ------------\n" - "\n" - " ------------\n" - " TOOTS \n" - " ------------\n" - "\n" - "

Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.

\n" - " Eugen (@Gargron) 2021-11-11 11:11:11\n" - " ------------\n" - "\n" - "\n" - "

@CCC 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.

\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" + "

Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.

\n" + "_ Patreon __ :: https://www.patreon.com/mastodon_ Homepage _ :: https://zeonfederated.com\n" + " ------------\n" + " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" + " ------------\n" + "\n" + "Joined March 2016" + "\n\n" + " ------------\n" + " TOOTS \n" + " ------------\n" + "\n" + "

Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.

\n" + " Eugen (@Gargron) 2021-11-11 11:11:11\n" + " ------------\n" + "\n" + "\n" + "

@CCC 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.

\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)))) -- cgit v1.2.3 From 8b45a7a83de0747029b6cd1d1cf7628afef0ad6c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 23:33:28 +0100 Subject: fix some tests due to params --- lisp/mastodon-http.el | 2 +- lisp/mastodon-tl.el | 9 ++++----- lisp/mastodon-toot.el | 1 + test/mastodon-profile-tests.el | 11 ++++++++--- test/mastodon-tl-tests.el | 45 ++++++++++++++++++++++-------------------- 5 files changed, 38 insertions(+), 30 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 259432e..d56f3ad 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -333,8 +333,8 @@ PARAMS is an alist of any extra parameters to send with the request." "Make GET request to URL. Call CALLBACK with json-list and ARGS. PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async - params url + params (lambda (status) (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-json) args))))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index fd74ed5..d0c2b0b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1315,7 +1315,7 @@ LINK-HEADER is the http Link header if present." Then run CALLBACK with arguments CBARGS." (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) (url (mastodon-http--api endpoint))) - (apply 'mastodon-http--get-json-async url params callback cbargs))) + (apply 'mastodon-http--get-json-async url args callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local @@ -1323,7 +1323,7 @@ Then run CALLBACK with arguments CBARGS." "Return JSON for timeline ENDPOINT since ID." (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url))) + (mastodon-http--get-json url args))) (defun mastodon-tl--property (prop &optional backward) "Get property PROP for toot at point. @@ -1873,8 +1873,7 @@ INSTANCE is an instance domain name." (response (mastodon-http--get-json (if user (mastodon-http--api "instance") - (concat instance - "/api/v1/instance")) + (concat instance "/api/v1/instance")) nil :vector))) (when response @@ -2462,7 +2461,7 @@ favourites." (mastodon-http--get-response-async url 'mastodon-tl--init* buffer endpoint update-function headers) (mastodon-http--get-json-async - url 'mastodon-tl--init* buffer endpoint update-function)))) + url nil 'mastodon-tl--init* buffer endpoint update-function)))) (defun mastodon-tl--init* (response buffer endpoint update-function &optional headers) "Initialize BUFFER with timeline targeted by ENDPOINT. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 24c6c75..8ac75f9 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -227,6 +227,7 @@ send.") NO-TOOT means we are not calling from a toot buffer." (mastodon-http--get-json-async (mastodon-http--api "instance") + nil 'mastodon-toot--get-max-toot-chars-callback no-toot)) (defun mastodon-toot--get-max-toot-chars-callback (json-response diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 3e238f1..f65661e 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -172,7 +172,8 @@ The search will happen as if called without the \"@\"." (with-mock (mock (mastodon-http--get-json - "https://instance.url/api/v1/accounts/search?q=gargron")) + "https://instance.url/api/v1/accounts/search" + '(("q" . "gargron")))) (let ((mastodon-instance-url "https://instance.url")) ;; We don't check anything from the return value. We only care @@ -182,7 +183,9 @@ The search will happen as if called without the \"@\"." (ert-deftest mastodon-profile--search-account-by-handle--filters-out-false-results () "Should ignore results that don't match the searched handle." (with-mock - (mock (mastodon-http--get-json *) + (mock (mastodon-http--get-json + "https://instance.url/api/v1/accounts/search" + '(("q" . "Gargron"))) => (vector ccc-profile-json gargron-profile-json)) @@ -197,7 +200,9 @@ The search will happen as if called without the \"@\"." TODO: We need to decide if this is actually desired or not." (with-mock - (mock (mastodon-http--get-json *) => (vector gargron-profile-json)) + (mock (mastodon-http--get-json * + '(("q" . "gargron"))) + => (vector gargron-profile-json)) (let ((mastodon-instance-url "https://instance.url")) (should diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 19934dd..0ac5caf 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -175,27 +175,30 @@ Strict-Transport-Security: max-age=31536000 "Should request toots older than max_id." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) - (mastodon-tl--more-json "timelines/foo" 12345)))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo" + '(("max_id" . "12345")))) + (mastodon-tl--more-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--more-json-id-string () "Should request toots older than max_id. -`mastodon-tl--more-json' should accept and id that is either -a string or a numeric." + `mastodon-tl--more-json' should accept and id that is either + a string or a numeric." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo" + '(("max_id" . "12345")))) (mastodon-tl--more-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--update-json-id-string () "Should request toots more recent than since_id. -`mastodon-tl--updated-json' should accept and id that is either -a string or a numeric." + `mastodon-tl--updated-json' should accept and id that is either + a string or a numeric." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?since_id=12345")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo" + '(("since_id" . "12345")))) (mastodon-tl--updated-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--relative-time-description () @@ -314,7 +317,7 @@ a string or a numeric." byline) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -")) + ")) (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) 'user-handle)) (should (string= (get-text-property handle-location 'mastodon-handle byline) @@ -337,7 +340,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-boosted () "Should format the boosted toot correctly." @@ -354,7 +357,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-favorited () "Should format the favourited toot correctly." @@ -371,7 +374,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-boosted/favorited () @@ -389,7 +392,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-reblogged () "Should format the reblogged toot correctly." @@ -413,9 +416,9 @@ a string or a numeric." (handle2-location 65)) (should (string= (substring-no-properties byline) "Account 42 (@acct42@example.space) - Boosted Account 43 (@acct43@example.space) original time + Boosted Account 43 (@acct43@example.space) original time ------------ -")) + ")) (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle1-location 'help-echo byline) @@ -446,9 +449,9 @@ a string or a numeric." 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) "Account 42 (@acct42@example.space) - Boosted Account 43 (@acct43@example.space) original time + Boosted Account 43 (@acct43@example.space) original time ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-reblogged-boosted/favorited () "Should format the reblogged toot that was also boosted & favoritedcorrectly." @@ -470,9 +473,9 @@ a string or a numeric." 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) "(B) (F) Account 42 (@acct42@example.space) - Boosted Account 43 (@acct43@example.space) original time + Boosted Account 43 (@acct43@example.space) original time ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-timestamp-has-relative-display () "Should display the timestamp with a relative time." @@ -808,8 +811,8 @@ a string or a numeric." (defun tl-tests--property-values-at (property ranges) "Returns a list with property values at the given ranges. -The property value for PROPERTY within a region is assumed to be -constant." + The property value for PROPERTY within a region is assumed to be + constant." (let (result) (dolist (range ranges (nreverse result)) (push (get-text-property (car range) property) result)))) -- cgit v1.2.3 From 2b07cf720d4766b39584bff0d82125335f73f824 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 10:01:26 +0100 Subject: fix --get-response-async re params --- lisp/mastodon-http.el | 3 ++- lisp/mastodon-tl.el | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index d56f3ad..d1bf573 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -321,10 +321,11 @@ PARAMS is an alist of any extra parameters to send with the request." "GET" (url-retrieve url callback cbargs)))) -(defun mastodon-http--get-response-async (url callback &rest args) +(defun mastodon-http--get-response-async (url &optional params callback &rest args) "Make GET request to URL. Call CALLBACK with http response and ARGS." (mastodon-http--get-async url + params (lambda (status) (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-response) args))))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d0c2b0b..8d4bba4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2459,7 +2459,7 @@ favourites." (buffer (concat "*mastodon-" buffer-name "*"))) (if headers (mastodon-http--get-response-async - url 'mastodon-tl--init* buffer endpoint update-function headers) + url nil 'mastodon-tl--init* buffer endpoint update-function headers) (mastodon-http--get-json-async url nil 'mastodon-tl--init* buffer endpoint update-function)))) -- cgit v1.2.3 From 4e483bd8862282991793409ca49fb6fa66bb8109 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 10:08:46 +0100 Subject: fix list-name grabbing in list add/delete/edit --- lisp/mastodon-tl.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b1cbce1..f75398f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1493,7 +1493,7 @@ If ID is provided, use that list." (interactive) (let* ((list-names (unless id (mastodon-tl--get-lists-names))) (name-old (if id - (get-text-property (point) 'list-id) + (get-text-property (point) 'list-name) (completing-read "Edit list: " list-names))) (id (or id (mastodon-tl--get-list-id name-old))) @@ -1648,7 +1648,7 @@ a: add account to this list, r: remove account from this list" If ID is provided, use that list." (interactive) (let* ((list-name (if id - (get-text-property (point) 'list-id) + (get-text-property (point) 'list-name) (completing-read "Add account to list: " (mastodon-tl--get-lists-names) nil t))) (list-id (or id (mastodon-tl--get-list-id list-name))) @@ -1678,7 +1678,7 @@ If ID is provided, use that list." If ID is provided, use that list." (interactive) (let* ((list-name (if id - (get-text-property (point) 'list-id) + (get-text-property (point) 'list-name) (completing-read "Remove account from list: " (mastodon-tl--get-lists-names) nil t))) (list-id (or id (mastodon-tl--get-list-id list-name))) -- cgit v1.2.3 From 348a917b8bafb2b6dafbdfa0a6945c6803b0d806 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:04:46 +0100 Subject: try setting mastodon-mode in view-instance buffers --- lisp/mastodon-tl.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f75398f..027b7e8 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1914,6 +1914,7 @@ INSTANCE is an instance domain name." (assoc 'rules response) (assoc 'stats response)))) (mastodon-tl--print-json-keys response) + (mastodon-mode) (goto-char (point-min))))))))) (defun mastodon-tl--format-key (el pad) -- cgit v1.2.3 From e069ff64f62d7324a7c65a9701657fe1c873b80d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:09:59 +0100 Subject: fix joined date in profile tests 2 --- test/mastodon-profile-tests.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index bf0bc3f..edfecce 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -265,12 +265,12 @@ content generation in the function under test." " ------------\n" "

Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.

\n" "_ Patreon __ :: https://www.patreon.com/mastodon_ Homepage _ :: https://zeonfederated.com\n" + "Joined March 2016" + "\n\n" " ------------\n" " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" " ------------\n" "\n" - "Joined March 2016" - "\n\n" " ------------\n" " TOOTS \n" " ------------\n" -- cgit v1.2.3 From d84f6f5ef17320ef2312b4bb29e383014f36ee91 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:46:03 +0100 Subject: refactor mastodon-profile--format-joined-date-string --- lisp/mastodon-profile.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 512aae4..3a869ed 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -568,8 +568,7 @@ FIELDS means provide a fields vector fetched by other means." (followsp (or (equal follows-you 't) (equal followed-by-you 't))) (fields (mastodon-profile--fields-get account)) (pinned (mastodon-profile--get-statuses-pinned account)) - (joined-ts (ts-parse - (mastodon-profile--account-field account 'created_at)))) + (joined (mastodon-profile--account-field account 'created_at))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) @@ -616,11 +615,7 @@ FIELDS means provide a fields vector fetched by other means." "\n") "") (propertize - (format "Joined %s" - (format "%s" (concat (ts-month-name joined-ts) - " " - (number-to-string - (ts-year joined-ts))))) + (mastodon-profile--format-joined-date-string joined) 'face 'success) "\n\n") 'profile-json account) @@ -657,6 +652,14 @@ FIELDS means provide a fields vector fetched by other means." (funcall update-function json))) (goto-char (point-min)))) +(defun mastodon-profile--format-joined-date-string (joined) + "Format a Joined timestamp." + (let ((joined-ts (ts-parse joined))) + (format "Joined %s" (concat (ts-month-name joined-ts) + " " + (number-to-string + (ts-year joined-ts)))))) + (defun mastodon-profile--get-toot-author () "Open profile of author of toot under point. -- cgit v1.2.3 From 9d1d2fc3746a87cf9e841da58a5c7641599650a0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:46:15 +0100 Subject: mock mastodon-profile--format-joined-date-string in profie test --- test/mastodon-profile-tests.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index edfecce..704f2ce 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -249,6 +249,8 @@ content generation in the function under test." (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-profile--format-joined-date-string *) => "Joined March 2016") + (let ((mastodon-tl--show-avatars t) (mastodon-tl--display-media-p t) (mastodon-instance-url "https://instance.url")) -- cgit v1.2.3 From 6d11b36f890be413c0126aa09566646d6a74d571 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 12:29:29 +0100 Subject: tl fix a -get-json call that :vector arg --- lisp/mastodon-tl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8d4bba4..0de925f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1874,7 +1874,8 @@ INSTANCE is an instance domain name." (if user (mastodon-http--api "instance") (concat instance "/api/v1/instance")) - nil + nil ; params + nil ; silent :vector))) (when response (let ((buf (get-buffer-create "*mastodon-instance*"))) -- cgit v1.2.3 From 09e38ba8b61c9a50e50453535d1e1f409a61a7ab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:04:46 +0100 Subject: try setting mastodon-mode in view-instance buffers --- lisp/mastodon-tl.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0de925f..15943ba 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1897,6 +1897,7 @@ INSTANCE is an instance domain name." (assoc 'rules response) (assoc 'stats response)))) (mastodon-tl--print-json-keys response) + (mastodon-mode) (goto-char (point-min))))))))) (defun mastodon-tl--format-key (el pad) -- cgit v1.2.3 From 2256d29650521deac96dad531c5e7384cb0304ff Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:05:47 +0100 Subject: add mastodon-iso.el containing ISO language lists iso.el typo and provide --- lisp/mastodon-iso.el | 246 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 246 insertions(+) create mode 100644 lisp/mastodon-iso.el diff --git a/lisp/mastodon-iso.el b/lisp/mastodon-iso.el new file mode 100644 index 0000000..8baff3c --- /dev/null +++ b/lisp/mastodon-iso.el @@ -0,0 +1,246 @@ +;;; mastodon-iso.el --- ISO language code lists for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Marty Hiatt +;; Author: Marty Hiatt +;; Version: 1.0.0 +;; Package-Requires: ((emacs "27.1") (request "0.3.0")) +;; Homepage: https://codeberg.org/martianh/mastodon.el + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see . + +;;; Commentary: + +;;; Code: + +;; via +;; https://github.com/VyrCossont/mastodon/blob/0836f4a656d5486784cadfd7d0cd717bb67ede4c/app/helpers/languages_helper.rb +;; and +;; https://github.com/Shinmera/language-codes/blob/master/data/iso-639-3.lisp + +(defvar mastodon-iso-639-1 + '(("ab" "Abkhazian") + ("aa" "Afar") + ("af" "Afrikaans") + ("ak" "Akan") + ("sq" "Albanian") + ("am" "Amharic") + ("ar" "Arabic") + ("an" "Aragonese") + ("hy" "Armenian") + ("as" "Assamese") + ("av" "Avaric") + ("ae" "Avestan") + ("ay" "Aymara") + ("az" "Azerbaijani") + ("bm" "Bambara") + ("ba" "Bashkir") + ("eu" "Basque") + ("be" "Belarusian") + ("bn" "Bengali") + ("bh" "Bihari languages") + ("bi" "Bislama") + ("bs" "Bosnian") + ("br" "Breton") + ("bg" "Bulgarian") + ("my" "Burmese") + ("km" "Central Khmer") + ("ch" "Chamorro") + ("ce" "Chechen") + ("zh" "Chinese") + ("cv" "Chuvash") + ("kw" "Cornish") + ("co" "Corsican") + ("cr" "Cree") + ("hr" "Croatian") + ("cs" "Czech") + ("da" "Danish") + ("dz" "Dzongkha") + ("en" "English") + ("eo" "Esperanto") + ("et" "Estonian") + ("ee" "Ewe") + ("fo" "Faroese") + ("fj" "Fijian") + ("fi" "Finnish") + ("nl" "Dutch" "Flemish") + ("fr" "French") + ("ff" "Fulah") + ("gl" "Galician") + ("lg" "Ganda") + ("ka" "Georgian") + ("de" "German") + ("el" "Greek") + ("gn" "Guarani") + ("gu" "Gujarati") + ("ht" "Haitian" "Haitian Creole") + ("ha" "Hausa") + ("he" "Hebrew") + ("hz" "Herero") + ("hi" "Hindi") + ("ho" "Hiri Motu") + ("hu" "Hungarian") + ("is" "Icelandic") + ("io" "Ido") + ("ig" "Igbo") + ("id" "Indonesian") + ("ia" "Interlingua" "Interlingua (International Auxiliary Language Association)") + ("iu" "Inuktitut") + ("ik" "Inupiaq") + ("ga" "Irish") + ("it" "Italian") + ("ja" "Japanese") + ("jp" "Japanese") + ("jv" "Javanese") + ("kl" "Kalaallisut" "Greenlandic") + ("kn" "Kannada") + ("kr" "Kanuri") + ("ks" "Kashmiri") + ("kk" "Kazakh") + ("ki" "Kikuyu" "Gikuyu") + ("rw" "Kinyarwanda") + ("kv" "Komi") + ("kg" "Kongo") + ("ko" "Korean") + ("ku" "Kurdish") + ("kj" "Kuanyama" "Kwanyama") + ("ky" "Kirghiz" "Kyrgyz") + ("lo" "Lao") + ("la" "Latin") + ("lv" "Latvian") + ("li" "Limburgan" "Limburger" "Limburgish") + ("ln" "Lingala") + ("lt" "Lithuanian") + ("lu" "Luba-Katanga") + ("lb" "Luxembourgish" "Letzeburgesch") + ("mk" "Macedonian") + ("mg" "Malagasy") + ("ms" "Malay") + ("ml" "Malayalam") + ("dv" "Divehi" "Dhivehi" "Maldivian") + ("mt" "Maltese") + ("gv" "Manx") + ("mi" "Maori") + ("mr" "Marathi") + ("mh" "Marshallese") + ("mn" "Mongolian") + ("na" "Nauru") + ("nv" "Navajo" "Navaho") + ("ng" "Ndonga") + ("ne" "Nepali") + ("nd" "Ndebele, North" "North Ndebele") + ("se" "Northern Sami") + ("no" "Norwegian") + ("nb" "Bokmål, Norwegian" "Norwegian Bokmål") + ("ny" "Chichewa" "Chewa" "Nyanja") + ("nn" "Norwegian Nynorsk" "Nynorsk, Norwegian") + ("ie" "Interlingue" "Occidental") + ("oc" "Occitan") + ("oj" "Ojibwa") + ("cu" "Church Slavic" "Old Slavonic" "Church Slavonic" "Old Bulgarian" "Old Church Slavonic") + ("or" "Oriya") + ("om" "Oromo") + ("os" "Ossetian" "Ossetic") + ("pi" "Pali") + ("fa" "Persian") + ("pl" "Polish") + ("pt" "Portuguese") + ("pa" "Panjabi" "Punjabi") + ("ps" "Pushto" "Pashto") + ("qu" "Quechua") + ("ro" "Romanian" "Moldavian" "Moldovan") + ("rm" "Romansh") + ("rn" "Rundi") + ("ru" "Russian") + ("sm" "Samoan") + ("sg" "Sango") + ("sa" "Sanskrit") + ("sc" "Sardinian") + ("gd" "Gaelic" "Scottish Gaelic") + ("sr" "Serbian") + ("sn" "Shona") + ("ii" "Sichuan Yi" "Nuosu") + ("sd" "Sindhi") + ("si" "Sinhala" "Sinhalese") + ("sk" "Slovak") + ("sl" "Slovenian") + ("so" "Somali") + ("st" "Sotho, Southern") + ("nr" "Ndebele, South" "South Ndebele") + ("es" "Spanish" "Castilian") + ("su" "Sundanese") + ("sw" "Swahili") + ("ss" "Swati") + ("sv" "Swedish") + ("tl" "Tagalog") + ("ty" "Tahitian") + ("tg" "Tajik") + ("ta" "Tamil") + ("tt" "Tatar") + ("te" "Telugu") + ("th" "Thai") + ("bo" "Tibetan") + ("ti" "Tigrinya") + ("to" "Tonga (Tonga Islands)") + ("ts" "Tsonga") + ("tn" "Tswana") + ("tr" "Turkish") + ("tk" "Turkmen") + ("tw" "Twi") + ("uk" "Ukrainian") + ("ur" "Urdu") + ("ug" "Uighur" "Uyghur") + ("uz" "Uzbek") + ("ca" "Catalan" "Valencian") + ("ve" "Venda") + ("vi" "Vietnamese") + ("vo" "Volapük") + ("wa" "Walloon") + ("cy" "Welsh") + ("fy" "Western Frisian") + ("wo" "Wolof") + ("xh" "Xhosa") + ("yi" "Yiddish") + ("yo" "Yoruba") + ("za" "Zhuang" "Chuang") + ("zu" "Zulu"))) + +;; web UI doesn't respect these for now +(defvar mastodon-iso-639-regional + '(("es-AR" "Español (Argentina)") + ("es-MX" "Español (México)") + ("pt-BR" "Português (Brasil)") + ("pt-PT" "Português (Portugal)") + ("sr-Latn" "Srpski (latinica)") + ("zh-CN" "简体中文") + ("zh-HK" "繁體中文（香港）") + ("zh-TW" "繁體中文（臺灣）"))) + +(defvar mastodon-iso-639-3 + '(("ast" "Asturian" "Asturianu") + ("ckb" "Sorani (Kurdish)" "سۆرانی") + ("jbo" "Lojban" "la .lojban.") + ("kab" "Kabyle" "Taqbaylit") + ("kmr" "Kurmanji (Kurdish)" "Kurmancî") + ("ldn" "Láadan" "Láadan") + ("lfn" "Lingua Franca Nova" "lingua franca nova") + ("tok" "Toki Pona" "toki pona") + ("zba" "Balaibalan" "باليبلن") + ("zgh" "Standard Moroccan Tamazight" "ⵜⴰⵎⴰⵣⵉⵖⵜ"))) + +(provide 'mastodon-iso) +;;; mastodon-iso.el ends here -- cgit v1.2.3 From 523efc5bc6630cdcd455513aa3640492c41ab6ef Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:09:59 +0100 Subject: fix joined date in profile tests 2 --- test/mastodon-profile-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index bf0bc3f..f603203 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -268,7 +268,7 @@ content generation in the function under test." " ------------\n" " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" " ------------\n" - "\n" + "\n\n" "Joined March 2016" "\n\n" " ------------\n" -- cgit v1.2.3 From 12cc327e7361065fa2b280e670496250e5163834 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 13:27:16 +0100 Subject: choose language, return ISO code --- lisp/mastodon-toot.el | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5a735dc..b3d8860 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -47,6 +47,8 @@ (declare-function company-grab-symbol "company") (defvar company-backends)) +(require 'mastodon-iso) + (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--enable-proportional-fonts) @@ -1141,6 +1143,16 @@ LENGTH is the maximum character length allowed for a poll option." ("14 days" . ,(number-to-string (* 60 60 24 14))) ("30 days" . ,(number-to-string (* 60 60 24 30))))) +(defun mastodon-toot--prompt-toot-lang () + "Prompt for a language and return its two letter ISO 639 1 code." + (let* ((langs (mapcar (lambda (x) + (cons (cadr x) + (car x))) + mastodon-iso-639-1)) + (choice (completing-read "Language for this toot: " + langs))) + (alist-get choice langs nil nil 'equal))) + ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () @@ -1329,7 +1341,6 @@ This is how mastodon does it." (replace-match (match-string 2))) ; replace with handle only (length (buffer-substring (point-min) (point-max))))) - (defun mastodon-toot--save-toot-text (&rest _args) "Save the current toot text in `mastodon-toot-current-toot-text'. Added to `after-change-functions' in new toot buffers." -- cgit v1.2.3 From ee65d8afcbd113c7a1104cf84b214fb87722b474 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:06:13 +0100 Subject: attempt to fix --get-search params --- lisp/mastodon-http.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index d1bf573..c94ea7a 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -286,7 +286,8 @@ SILENT means don't message." (let* ((query-str (mastodon-http--build-query-string `(("q" . ,(url-hexify-string query))))) (params-str (mastodon-http--build-query-string params)) - (url (concat base-url "?" query-str params-str))) + (url (concat base-url "?" query-str (when params-str + (concat "&" params-str))))) (mastodon-http--url-retrieve-synchronously url silent)))) ;; profile update functions -- cgit v1.2.3 From 19051d7ada81e5abc56b42de838ab7b26c31bd9b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:34:59 +0100 Subject: remove redundant --get-search(-json) funs, use new params --get-json --- lisp/mastodon-http.el | 34 ---------------------------------- lisp/mastodon-search.el | 12 +++++++----- lisp/mastodon.el | 5 +++-- 3 files changed, 10 insertions(+), 41 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index c94ea7a..c1ab3fb 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -256,40 +256,6 @@ PARAMS should be an alist as required by `url-build-query-string'." (let ((query-string (url-build-query-string params))) (concat url "?" query-string))) -;; search functions: -(defun mastodon-http--process-json-search () - "Process JSON returned by a search query to the server." - (goto-char (point-min)) - (re-search-forward "^$" nil 'move) - (let ((json-string - (decode-coding-string - (buffer-substring-no-properties (point) (point-max)) - 'utf-8))) - (kill-buffer) - (json-read-from-string json-string))) - -(defun mastodon-http--get-search-json (url query &optional params silent) - "Make GET request to URL, searching for QUERY and return JSON response. -PARAMS is an alist of any extra parameters to send with the request. -SILENT means don't message." - (let ((buffer (mastodon-http--get-search url query params silent))) - (with-current-buffer buffer - (mastodon-http--process-json-search)))) - -(defun mastodon-http--get-search (base-url query &optional params silent) - "Make GET request to BASE-URL, searching for QUERY. -Pass response buffer to CALLBACK function. -PARAMS is an alist of any extra parameters to send with the request. -SILENT means don't message." - (mastodon-http--authorized-request - "GET" - (let* ((query-str (mastodon-http--build-query-string - `(("q" . ,(url-hexify-string query))))) - (params-str (mastodon-http--build-query-string params)) - (url (concat base-url "?" query-str (when params-str - (concat "&" params-str))))) - (mastodon-http--url-retrieve-synchronously url silent)))) - ;; profile update functions (defun mastodon-http--patch-json (url &optional params) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index fee79c4..f83cccb 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -61,8 +61,8 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api "accounts/search")) (response (if (equal mastodon-toot--completion-style-for-mentions "following") - (mastodon-http--get-search-json url query '(("following" . "true"))) - (mastodon-http--get-search-json url query)))) + (mastodon-http--get-json url `(("q" . ,query) ("following" . "true"))) + (mastodon-http--get-json url `(("q" . ,query)))))) (mapcar #'mastodon-search--get-user-info-@ response))) ;; functions for tags completion: @@ -72,8 +72,10 @@ Returns a nested list containing user handle, display name, and URL." QUERY is the string to search." (interactive "sSearch for hashtag: ") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (type-param '(("type" . "hashtags"))) - (response (mastodon-http--get-search-json url query type-param)) + ;; (type-param '(("type" . "hashtags"))) + (params `(("q" . ,query) + ("type" . "hashtags"))) + (response (mastodon-http--get-json url params)) (tags (alist-get 'hashtags response))) (mapcar #'mastodon-search--get-hashtag-info tags))) @@ -112,7 +114,7 @@ QUERY is the string to search." (interactive "sSearch mastodon for: ") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) (buffer (format "*mastodon-search-%s*" query)) - (response (mastodon-http--get-search-json url query)) + (response (mastodon-http--get-json url `(("q" . ,query)))) (accts (alist-get 'accounts response)) (tags (alist-get 'hashtags response)) (statuses (alist-get 'statuses response)) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index cfe6681..4097b27 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -291,8 +291,9 @@ not, just browse the URL in the normal fashion." (browse-url query) (message "Performing lookup...") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (param '(("resolve" . "t"))) ; webfinger - (response (mastodon-http--get-search-json url query param :silent))) + (params `(("q" . ,query) + ("resolve" . "t"))) ; webfinger + (response (mastodon-http--get-json url params :silent))) (cond ((not (seq-empty-p (alist-get 'statuses response))) (let* ((statuses (assoc 'statuses response)) -- cgit v1.2.3 From d0c7a2f330bb5ef22eb9956255e2fb4c171e7e59 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:36:24 +0100 Subject: rename build-query-string to -params-str, + build-array-params-alist --- lisp/mastodon-http.el | 28 ++++++++++++++-------------- lisp/mastodon-tl.el | 10 +++++----- lisp/mastodon-toot.el | 6 +++--- 3 files changed, 22 insertions(+), 22 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index c1ab3fb..69a571d 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -114,19 +114,19 @@ Unless UNAUTHENTICATED-P is non-nil." (concat "Bearer " (mastodon-auth--access-token))))))) ,body)) -(defun mastodon-http--build-query-string (args) - "Build a request query string from ARGS." +(defun mastodon-http--build-params-string (params) + "Build a request parameters string from parameters alist PARAMS." ;; (url-build-query-string args nil)) ;; url-build-query-string adds 'nil' to empty params so lets stay with our ;; own: - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) + (mapconcat (lambda (p) + (concat (url-hexify-string (car p)) "=" - (url-hexify-string (cdr arg)))) - args + (url-hexify-string (cdr p)))) + params "&")) -(defun mastodon-http--build-array-args-alist (param-str array) +(defun mastodon-http--build-array-params-alist (param-str array) "Return parameters alist using PARAM-STR and ARRAY param values. Used for API form data parameters that take an array." (cl-loop for x in array @@ -140,7 +140,7 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. "POST" (let ((url-request-data (when args - (mastodon-http--build-query-string args))) + (mastodon-http--build-params-string args))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -160,7 +160,7 @@ SILENT means don't message." ;; url-request-data doesn't seem to work with GET requests: (let ((url (if params (concat url "?" - (mastodon-http--build-query-string params)) + (mastodon-http--build-params-string params)) url))) (mastodon-http--url-retrieve-synchronously url silent)))) @@ -228,7 +228,7 @@ PARAMS is an alist of any extra parameters to send with the request." (let ((url (if params (concat url "?" - (mastodon-http--build-query-string params)) + (mastodon-http--build-params-string params)) url))) (mastodon-http--authorized-request "DELETE" @@ -241,7 +241,7 @@ PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--authorized-request "PUT" (let ((url-request-data - (when args (mastodon-http--build-query-string params))) + (when args (mastodon-http--build-params-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -271,7 +271,7 @@ Optionally specify the PARAMS to send." "PATCH" (let ((url (concat base-url "?" - (mastodon-http--build-query-string params)))) + (mastodon-http--build-params-string params)))) (mastodon-http--url-retrieve-synchronously url)))) ;; Asynchronous functions @@ -282,7 +282,7 @@ Pass response buffer to CALLBACK function with args CBARGS. PARAMS is an alist of any extra parameters to send with the request." (let ((url (if params (concat url "?" - (mastodon-http--build-query-string params)) + (mastodon-http--build-params-string params)) url))) (mastodon-http--authorized-request "GET" @@ -316,7 +316,7 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (let ((request-timeout 5) (url-request-data (when args - (mastodon-http--build-query-string args)))) + (mastodon-http--build-params-string args)))) (with-temp-buffer (url-retrieve url callback cbargs))))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 15943ba..efb6612 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -74,8 +74,8 @@ (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-http--build-array-params-alist "mastodon-http") +(autoload 'mastodon-http--build-params-string "mastodon-http") (autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") (autoload 'mastodon-toot--get-toot-edits "mastodon-toot") @@ -1678,7 +1678,7 @@ If ID is provided, use that list." handles nil t)) (account-id (alist-get account handles nil nil 'equal)) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) - (args (mastodon-http--build-array-args-alist "account_ids[]" `(,account-id))) + (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) (response (mastodon-http--delete url args))) (mastodon-tl--list-action-triage response @@ -2517,10 +2517,10 @@ 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 + (args (when note-type (mastodon-http--build-array-params-alist "exclude_types[]" exclude-types))) ;; (query-string (when note-type - ;; (mastodon-http--build-query-string args))) + ;; (mastodon-http--build-params-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)) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8ac75f9..c870092 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -79,7 +79,7 @@ (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-http--build-array-args-alist "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") (autoload 'mastodon-tl--get-endpoint "mastodon-tl") (autoload 'mastodon-http--put "mastodon-http") @@ -631,7 +631,7 @@ 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-http--build-array-args-alist + (mastodon-http--build-array-params-alist "poll[options][]" (plist-get mastodon-toot-poll :options)) `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) @@ -664,7 +664,7 @@ instance to edit a toot." (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mastodon-http--build-array-args-alist + (mastodon-http--build-array-params-alist "media_ids[]" mastodon-toot--media-attachment-ids))) (args-poll (when mastodon-toot-poll -- cgit v1.2.3 From feaa4d34a30da292e9a7f61187449252b4932171 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:49:11 +0100 Subject: speculatively fix byline tests --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index efb6612..0abf996 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -499,7 +499,7 @@ The result is added as an attachments property to author-byline." (let ((reblog (alist-get 'reblog toot))) (when reblog (concat - "\n " + "\n " (propertize "Boosted" 'face 'mastodon-boosted-face) " " (mastodon-tl--byline-author reblog))))) -- cgit v1.2.3 From 70aaeaebed48d07b6966c3633bea955f6b047828 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:49:59 +0100 Subject: if not when for edited-time in byline (for tests) --- lisp/mastodon-tl.el | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0abf996..35a9dfa 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -666,24 +666,25 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) - (when edited-time - (concat - (if (fontp (char-displayable-p #10r128274)) - " ✍ " - " [edited] ") - (propertize - (format-time-string mastodon-toot-timestamp-format - edited-parsed) - 'face 'font-lock-comment-face - 'timestamp edited-parsed - 'display (if mastodon-tl--enable-relative-timestamps - (mastodon-tl--relative-time-description edited-parsed) - edited-parsed)))) - (propertize "\n ------------\n" 'face 'default)) + 'keymap mastodon-tl--shr-map-replacement))))) + (if edited-time + (concat + (if (fontp (char-displayable-p #10r128274)) + " ✍ " + " [edited] ") + (propertize + (format-time-string mastodon-toot-timestamp-format + edited-parsed) + 'face 'font-lock-comment-face + 'timestamp edited-parsed + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description edited-parsed) + edited-parsed))) + "") + (propertize "\n ------------\n " 'face 'default)) 'favourited-p faved 'boosted-p boosted 'bookmarked-p bookmarked -- cgit v1.2.3 From 54bf253a26c899a21dec819033b51831684a6eb5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 16:12:00 +0100 Subject: add missing nil params arg to tl--more --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 35a9dfa..e4f2dc9 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2259,9 +2259,9 @@ For use after e.g. deleting a toot." (if (member (buffer-name (current-buffer)) mastodon-tl--link-header-buffers) ;; 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))) + ;;(prev (cadr (mastodon-tl--link-header))) (url (mastodon-tl--build-link-header-url next))) - (mastodon-http--get-response-async url 'mastodon-tl--more* (current-buffer) + (mastodon-http--get-response-async url nil 'mastodon-tl--more* (current-buffer) (point) :headers)) (mastodon-tl--more-json-async (mastodon-tl--get-endpoint) (mastodon-tl--oldest-id) 'mastodon-tl--more* (current-buffer) (point)))) -- cgit v1.2.3 From 77b8a2ea379e10ed8df316c116a72c476bb9af50 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 16:47:21 +0100 Subject: set toot language in compose buffer like the other settings, we just save to a buffer local variable then fetch it to send manual testing shows that delete and redraft preserves and repeats the setting. --- lisp/mastodon-toot.el | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b3d8860..18dba06 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -171,6 +171,9 @@ change the setting on the server, see (defvar-local mastodon-toot-poll nil "A list of poll options for the toot being composed.") +(defvar-local mastodon-toot--language nil + "The language of the toot being composed, in ISO 639 (two-letter).") + (defvar-local mastodon-toot--reply-to-id nil "Buffer-local variable to hold the id of the toot being replied to.") @@ -213,6 +216,7 @@ send.") (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) (define-key map (kbd "C-c C-p") #'mastodon-toot--create-poll) + (define-key map (kbd "C-c C-l") #'mastodon-toot--set-toot-lang) map) "Keymap for `mastodon-toot'.") @@ -663,7 +667,8 @@ instance to edit a toot." ("visibility" . ,mastodon-toot--visibility) ("sensitive" . ,(when mastodon-toot--content-nsfw (symbol-name t))) - ("spoiler_text" . ,spoiler))) + ("spoiler_text" . ,spoiler) + ("language" . ,mastodon-toot--language))) (args-media (when mastodon-toot--media-attachments (mastodon-http--build-array-args-alist "media_ids[]" @@ -1143,15 +1148,17 @@ LENGTH is the maximum character length allowed for a poll option." ("14 days" . ,(number-to-string (* 60 60 24 14))) ("30 days" . ,(number-to-string (* 60 60 24 30))))) -(defun mastodon-toot--prompt-toot-lang () +(defun mastodon-toot--set-toot-lang () "Prompt for a language and return its two letter ISO 639 1 code." + (interactive) (let* ((langs (mapcar (lambda (x) (cons (cadr x) (car x))) mastodon-iso-639-1)) (choice (completing-read "Language for this toot: " langs))) - (alist-get choice langs nil nil 'equal))) + (setq mastodon-toot--language + (alist-get choice langs nil nil 'equal)))) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings -- cgit v1.2.3 From 5df90da80741714a7b5b49c054564dcc6c221c8b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 16:54:42 +0100 Subject: copy-toot-url/text - handle fave/boost notifs --- lisp/mastodon-toot.el | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 18dba06..38f86b3 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -385,9 +385,12 @@ TYPE is a symbol, either 'favourite or 'boost." (message (format "Nothing to %s here?!?" action))))) (defun mastodon-toot--copy-toot-url () - "Copy URL of toot at point." + "Copy URL of toot at point. +If the toot is a fave/boost notification, copy the URLof the +base toot." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) + (let* ((toot (or (mastodon-tl--property 'base-toot) + (mastodon-tl--property 'toot-json))) (url (if (mastodon-tl--field 'reblog toot) (alist-get 'url (alist-get 'reblog toot)) (alist-get 'url toot)))) @@ -395,9 +398,12 @@ TYPE is a symbol, either 'favourite or 'boost." (message "Toot URL copied to the clipboard."))) (defun mastodon-toot--copy-toot-text () - "Copy text of toot at point." + "Copy text of toot at point. +If the toot is a fave/boost notification, copy the text of the +base toot." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json))) + (let* ((toot (or (mastodon-tl--property 'base-toot) + (mastodon-tl--property 'toot-json)))) (kill-new (mastodon-tl--content toot)) (message "Toot content copied to the clipboard."))) -- cgit v1.2.3 From 0d94aba8baadcfa6337ed6b6a6a54caa3a0540a3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 17:24:52 +0100 Subject: only enable company-mode if corfu-mode is off they conflict and hang the buffer. see #314 --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 38f86b3..6162f52 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1475,7 +1475,8 @@ a draft into the buffer." (set (make-local-variable 'company-backends) (add-to-list 'company-backends 'mastodon-toot-mentions)) (add-to-list 'company-backends 'mastodon-toot-tags)) - (company-mode-on)) + (unless (bound-and-true-p corfu-mode) ; don't clash w corfu mode + (company-mode-on))) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--refresh-attachments-display) -- cgit v1.2.3 From d3cda98308f5bdf604d3d69800454d827fe814e9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 18:57:50 +0100 Subject: a rough crack at handling company to capf conversion if cape/corfu --- lisp/mastodon-toot.el | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6162f52..92cbc53 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1469,14 +1469,24 @@ a draft into the buffer." ;; no need to fetch from `mastodon-profile-account-settings' as ;; `mastodon-toot--max-toot-chars' is set when we set it (mastodon-toot--get-max-toot-chars)) - ;; set up company backends: + ;; set up completion backends: (when (require 'company nil :noerror) (when mastodon-toot--enable-completion - (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot-mentions)) - (add-to-list 'company-backends 'mastodon-toot-tags)) - (unless (bound-and-true-p corfu-mode) ; don't clash w corfu mode - (company-mode-on))) + ;; convert our company backends into capfs for use with corfu: + ;; FIXME replace this with a customize + (if (and (require 'cape nil :noerror) + (bound-and-true-p corfu-mode)) + (dolist (company-backend (list #'mastodon-toot-tags #'mastodon-toot-mentions)) + (add-hook 'completion-at-point-functions + (cape-company-to-capf company-backend) + nil + 'local)) + ;; else stick with company: + (set (make-local-variable 'company-backends) + (add-to-list 'company-backends 'mastodon-toot-mentions)) + (add-to-list 'company-backends 'mastodon-toot-tags)) + (unless (bound-and-true-p corfu-mode) ; don't clash w corfu mode + (company-mode-on)))) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--refresh-attachments-display) -- cgit v1.2.3 From b3269374ada3255e7bf4a0e7ff0cfa4084083773 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 20:47:28 +0100 Subject: defvar mastodon-toot-tag-regex --- lisp/mastodon-toot.el | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 92cbc53..f195a87 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -204,6 +204,13 @@ send.") "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ "\\b")) +(defvar mastodon-toot-tag-regex + (concat + ;; preceding space or bol [boundary doesn't work with #] + "\\([\n\t ]\\|^\\)" + "\\(?2:#[1-9a-zA-Z_]+\\)" ; tag + "\\b")) ; boundary + (defvar mastodon-toot-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -1415,13 +1422,12 @@ 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_]+\\)\\b" + (mastodon-toot--propertize-item mastodon-toot-tag-regex 'success (cdr header-region)) - (mastodon-toot--propertize-item - mastodon-toot-handle-regex - 'mastodon-display-name-face - (cdr header-region))))) + (mastodon-toot--propertize-item mastodon-toot-handle-regex + 'mastodon-display-name-face + (cdr header-region))))) (defun mastodon-toot--propertize-item (regex face start) "Propertize item matching REGEX with FACE starting from START." -- cgit v1.2.3 From 04221419595887ad2ac84e4531310235986075e3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 20:48:21 +0100 Subject: a first go at capf completion backends for mentions and tags the regex searches still fail sometimes, and completions don't show urls or usernames like the old company backends. --- lisp/mastodon-search.el | 12 +++++-- lisp/mastodon-toot.el | 87 +++++++++++++++++++++++++++++++++++++------------ 2 files changed, 77 insertions(+), 22 deletions(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 31fcae3..fc7bd8e 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -49,13 +49,19 @@ ;; functions for company completion of mentions in mastodon-toot +(defun mastodon-search--get-user-info-@-capf (account) + "Get user handle, display name and account URL from ACCOUNT." + (list (concat "@" (cdr (assoc 'acct account))) + (cdr (assoc 'url account)) + (cdr (assoc 'display_name account)))) + (defun mastodon-search--get-user-info-@ (account) "Get user handle, display name and account URL from ACCOUNT." (list (cdr (assoc 'display_name account)) (concat "@" (cdr (assoc 'acct account))) (cdr (assoc 'url account)))) -(defun mastodon-search--search-accounts-query (query) +(defun mastodon-search--search-accounts-query (query &optional capf) "Prompt for a search QUERY and return accounts synchronously. Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") @@ -63,7 +69,9 @@ Returns a nested list containing user handle, display name, and URL." (response (if (equal mastodon-toot--completion-style-for-mentions "following") (mastodon-http--get-search-json url query "following=true") (mastodon-http--get-search-json url query)))) - (mapcar #'mastodon-search--get-user-info-@ response))) + (if capf + (mapcar #'mastodon-search--get-user-info-@-capf response) + (mapcar #'mastodon-search--get-user-info-@ response)))) ;; functions for tags completion: diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index f195a87..6ba3a75 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -108,13 +108,14 @@ (defcustom mastodon-toot--enable-completion (if (require 'company nil :noerror) t nil) "Whether to enable completion of mentions and hashtags. - Used for completion in toot compose buffer. - This is only used if company mode is installed." :group 'mastodon-toot :type 'boolean) +(defcustom mastodon-toot--use-company-for-completion t + "Whether to use company for completion.") + (defcustom mastodon-toot--completion-style-for-mentions (if (require 'company nil :noerror) "following" "off") "The company completion style to use for mentions." @@ -913,6 +914,56 @@ meta fields respectively." (annotation (funcall annot-fun arg)) (meta (funcall meta-fun arg))))) +(defun mastodon-toot-mentions-capf () + "Build a mentions completion backend for `completion-at-point-functions'." + (let* ((handle-bounds + ;; hack for @handles@with.domains, as "@" is not inc in any thing at pt! + (save-match-data + (save-excursion + ;; match full handle inc. domain (see the regex for subexp 2) + (when (re-search-backward mastodon-toot-handle-regex nil :no-error) + ;; (when (match-string-no-properties 2) + (cons (match-beginning 2) + (match-end 2)))))) + (start (car handle-bounds)) + (end (cdr handle-bounds))) + (when handle-bounds + (list start + end + ;; only search when necessary: + (completion-table-dynamic + (lambda (_) + (mastodon-search--search-accounts-query + (buffer-substring-no-properties start end) + :capf))) + :exclusive 'no)))) + +(defun mastodon-toot-tags-capf () + "Build a tags completion backend for `completion-at-point-functions'." + (let* ((tag-bounds + (save-match-data + (save-excursion + ;; match full tag with # (see regex for subexp) + (re-search-backward mastodon-toot-tag-regex nil :no-error) + (when (match-string-no-properties 2) + (cons (match-beginning 2) + (match-end 2)))))) + (start (car tag-bounds)) + (end (cdr tag-bounds))) + (when tag-bounds + (list start + end + ;; only search when necessary: + (completion-table-dynamic + (lambda (_) + (let ((tags (mastodon-search--search-tags-query + (buffer-substring-no-properties start end)))) + (mapcar (lambda (x) + (list (concat "#" (car x)) + (cdr x))) + tags)))) + :exclusive 'no)))) + (defun mastodon-toot-mentions (command &optional arg &rest ignored) "A company completion backend for toot mentions. COMMAND is either prefix, to fetch a prefix query, candidates, to @@ -1475,24 +1526,20 @@ a draft into the buffer." ;; no need to fetch from `mastodon-profile-account-settings' as ;; `mastodon-toot--max-toot-chars' is set when we set it (mastodon-toot--get-max-toot-chars)) - ;; set up completion backends: - (when (require 'company nil :noerror) - (when mastodon-toot--enable-completion - ;; convert our company backends into capfs for use with corfu: - ;; FIXME replace this with a customize - (if (and (require 'cape nil :noerror) - (bound-and-true-p corfu-mode)) - (dolist (company-backend (list #'mastodon-toot-tags #'mastodon-toot-mentions)) - (add-hook 'completion-at-point-functions - (cape-company-to-capf company-backend) - nil - 'local)) - ;; else stick with company: - (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot-mentions)) - (add-to-list 'company-backends 'mastodon-toot-tags)) - (unless (bound-and-true-p corfu-mode) ; don't clash w corfu mode - (company-mode-on)))) + ;; set up completion: + (when mastodon-toot--enable-completion + ;; (setq-local + (set + (make-local-variable 'completion-at-point-functions) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot-mentions-capf)) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot-tags-capf) + (when mastodon-toot--use-company-for-completion + (company-mode-on))) + ;; after-change: (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--refresh-attachments-display) -- cgit v1.2.3 From 468add918b8e1e790294cdc7ff5e34cf1bf862f6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 21:44:43 +0100 Subject: silence the tags/handles searche queries --- lisp/mastodon-search.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index fc7bd8e..8530b5c 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -67,8 +67,8 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api "accounts/search")) (response (if (equal mastodon-toot--completion-style-for-mentions "following") - (mastodon-http--get-search-json url query "following=true") - (mastodon-http--get-search-json url query)))) + (mastodon-http--get-search-json url query "following=true" :silent) + (mastodon-http--get-search-json url query nil :silent)))) (if capf (mapcar #'mastodon-search--get-user-info-@-capf response) (mapcar #'mastodon-search--get-user-info-@ response)))) @@ -81,7 +81,7 @@ QUERY is the string to search." (interactive "sSearch for hashtag: ") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) (type-param (concat "type=hashtags")) - (response (mastodon-http--get-search-json url query type-param)) + (response (mastodon-http--get-search-json url query type-param :silent)) (tags (alist-get 'hashtags response))) (mapcar #'mastodon-search--get-hashtag-info tags))) -- cgit v1.2.3 From 264230f58acd1dea38eae29c57b555a5b48d5b35 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 10:46:07 +0100 Subject: working capf completion --- lisp/mastodon-toot.el | 52 +++++++++++++++++++++++++-------------------------- 1 file changed, 25 insertions(+), 27 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6ba3a75..5abe362 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -914,20 +914,24 @@ meta fields respectively." (annotation (funcall annot-fun arg)) (meta (funcall meta-fun arg))))) -(defun mastodon-toot-mentions-capf () +(defun mastodon-toot--get-bounds (regex) + "Get bounds of tag or handle before point." + ;; needed because # and @ are not part of any existing thing at point + (save-match-data + (save-excursion + ;; match full handle inc. domain, or tag including # + ;; (see the regexes for subexp 2) + (when (re-search-backward regex nil :no-error) + (cons (match-beginning 2) + (match-end 2)))))) + +(defun mastodon-toot--mentions-capf () "Build a mentions completion backend for `completion-at-point-functions'." - (let* ((handle-bounds - ;; hack for @handles@with.domains, as "@" is not inc in any thing at pt! - (save-match-data - (save-excursion - ;; match full handle inc. domain (see the regex for subexp 2) - (when (re-search-backward mastodon-toot-handle-regex nil :no-error) - ;; (when (match-string-no-properties 2) - (cons (match-beginning 2) - (match-end 2)))))) - (start (car handle-bounds)) - (end (cdr handle-bounds))) - (when handle-bounds + (let* ((bounds + (mastodon-toot--get-bounds mastodon-toot-handle-regex)) + (start (car bounds)) + (end (cdr bounds))) + (when bounds (list start end ;; only search when necessary: @@ -938,19 +942,13 @@ meta fields respectively." :capf))) :exclusive 'no)))) -(defun mastodon-toot-tags-capf () +(defun mastodon-toot--tags-capf () "Build a tags completion backend for `completion-at-point-functions'." - (let* ((tag-bounds - (save-match-data - (save-excursion - ;; match full tag with # (see regex for subexp) - (re-search-backward mastodon-toot-tag-regex nil :no-error) - (when (match-string-no-properties 2) - (cons (match-beginning 2) - (match-end 2)))))) - (start (car tag-bounds)) - (end (cdr tag-bounds))) - (when tag-bounds + (let* ((bounds + (mastodon-toot--get-bounds mastodon-toot-tag-regex)) + (start (car bounds)) + (end (cdr bounds))) + (when bounds (list start end ;; only search when necessary: @@ -1533,10 +1531,10 @@ a draft into the buffer." (make-local-variable 'completion-at-point-functions) (add-to-list 'completion-at-point-functions - #'mastodon-toot-mentions-capf)) + #'mastodon-toot--mentions-capf)) (add-to-list 'completion-at-point-functions - #'mastodon-toot-tags-capf) + #'mastodon-toot--tags-capf) (when mastodon-toot--use-company-for-completion (company-mode-on))) ;; after-change: -- cgit v1.2.3 From 2249680459ad9c46bfddb2c28c277b73ee9c4aa5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 10:49:16 +0100 Subject: disable company completion by default --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5abe362..96ff8fc 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -113,7 +113,7 @@ This is only used if company mode is installed." :group 'mastodon-toot :type 'boolean) -(defcustom mastodon-toot--use-company-for-completion t +(defcustom mastodon-toot--use-company-for-completion nil "Whether to use company for completion.") (defcustom mastodon-toot--completion-style-for-mentions -- cgit v1.2.3 From 9dd3db84b9164517239121188e58e188fe13b393 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 11:03:12 +0100 Subject: clean up compose-buffer capf control flow --- lisp/mastodon-toot.el | 39 ++++++++++++++++++++++++++++----------- 1 file changed, 28 insertions(+), 11 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 96ff8fc..c13d43b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -114,7 +114,19 @@ This is only used if company mode is installed." :type 'boolean) (defcustom mastodon-toot--use-company-for-completion nil - "Whether to use company for completion.") + "Whether to use company completion backends directly. +When non-nil, company backends `mastodon-toot-mentions' and +`mastodon-toot-tags' are used for completion. + +A nil setting will use `completion-at-point-functions' for +completion, which also work with company, provided that the +backend `company-capf' is enabled. + +If setting this to non-nil, ensure `corfu-mode' is disabled as the +two are incompatible. + +When the `completion-at-point-functions' backends are more +complete, direct company backends will be removed.") (defcustom mastodon-toot--completion-style-for-mentions (if (require 'company nil :noerror) "following" "off") @@ -1526,16 +1538,21 @@ a draft into the buffer." (mastodon-toot--get-max-toot-chars)) ;; set up completion: (when mastodon-toot--enable-completion - ;; (setq-local - (set - (make-local-variable 'completion-at-point-functions) - (add-to-list - 'completion-at-point-functions - #'mastodon-toot--mentions-capf)) - (add-to-list - 'completion-at-point-functions - #'mastodon-toot--tags-capf) - (when mastodon-toot--use-company-for-completion + (if (not mastodon-toot--use-company-for-completion) + ;; capf + (progn + (set ; (setq-local + (make-local-variable 'completion-at-point-functions) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot--mentions-capf)) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot--tags-capf)) + ;; company + (set (make-local-variable 'company-backends) + (add-to-list 'company-backends 'mastodon-toot-mentions)) + (add-to-list 'company-backends 'mastodon-toot-tags) (company-mode-on))) ;; after-change: (make-local-variable 'after-change-functions) -- cgit v1.2.3 From 6aa934389c6644c84196f75ee51f294b5264ef6d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 12:21:40 +0100 Subject: add account to list from profile buffer --- lisp/mastodon-tl.el | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d8a5417..0928b1b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1643,9 +1643,10 @@ a: add account to this list, r: remove account from this list" (let ((id (get-text-property (point) 'list-id))) (mastodon-tl--add-account-to-list id))) -(defun mastodon-tl--add-account-to-list (&optional id) +(defun mastodon-tl--add-account-to-list (&optional id account-id handle) "Prompt for a list and for an account, add account to list. -If ID is provided, use that list." +If ID is provided, use that list. +If ACCOUNT-ID and HANDLE are provided use them rather than prompting." (interactive) (let* ((list-name (if id (get-text-property (point) 'list-name) @@ -1657,9 +1658,9 @@ If ID is provided, use that list." (cons (alist-get 'acct x) (alist-get 'id x))) followings)) - (account (completing-read "Account to add: " - handles nil t)) - (account-id (alist-get account handles nil nil 'equal)) + (account (or handle (completing-read "Account to add: " + handles nil t))) + (account-id (or account-id (alist-get account handles nil nil 'equal))) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) (response (mastodon-http--post url `(("account_ids[]" . ,account-id))))) @@ -1715,6 +1716,15 @@ If ID is provided, use that list." (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) (mastodon-http--get-json url))) +(defun mastodon-tl--add-profile-account-to-list () + "Add account of current profile buffer to a list." + (interactive) + (when mastodon-profile--account + (let* ((profile mastodon-profile--account) + (id (alist-get 'id profile)) + (handle (alist-get 'acct profile))) + (mastodon-tl--add-account-to-list nil id handle)))) + ;;; FILTERS (defun mastodon-tl--create-filter () -- cgit v1.2.3 From ebefa1141e0ebd2a2d217e4b5b00720d8c60530a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 12:51:36 +0100 Subject: move add account to list profile to profile.el, + readme --- README.org | 120 ++++++++++++++++++++++++----------------------- lisp/mastodon-profile.el | 11 +++++ lisp/mastodon-tl.el | 16 ++----- 3 files changed, 77 insertions(+), 70 deletions(-) diff --git a/README.org b/README.org index 8eb9242..a757706 100644 --- a/README.org +++ b/README.org @@ -107,65 +107,69 @@ take place if your =mastodon-token-file= does not contain =:client_id= and **** Keybindings -|---------------+-----------------------------------------------------------------------| -| Key | Action | -|---------------+-----------------------------------------------------------------------| -| | *Help* | -| =?= | Open context menu if =discover= is available | -|---------------+-----------------------------------------------------------------------| -| | *Timeline actions* | -| =n= | Go to next item (toot, notification) | -| =p= | Go to previous item (toot, notification) | -| =M-n=/== | Go to the next interesting thing that has an action | -| =M-p=/== | Go to the previous interesting thing that has an action | -| =F= | Open federated timeline | -| =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 | -| =A= | Open author profile of toot under =point= | -| =P= | Open profile of user attached to toot under =point= | -| =O= | View own profile | -| =U= | update your profile bio note | -|---------------+-----------------------------------------------------------------------| -| | *Other views* | -| =S= | search (posts, users, tags) (NB: only posts you have interacted with) | -| =I=, =c=, =d= | view, create, and delete filters | -| =R=, =a=, =j= | view/accept/reject follow requests | -| =G= | view follow suggestions | -| =V= | view your favourited toots | -| =K= | view bookmarked toots | -| =X= | view/edit/create/delete lists | -|---------------+-----------------------------------------------------------------------| -| | *Toot actions* | -| =t= | Compose a new toot | -| =c= | Toggle content warning content | -| =b= | Boost toot under =point= | -| =f= | Favourite toot under =point= | -| =k= | toggle bookmark of toot at point | -| =r= | Reply to toot under =point= | -| =v= | Vote on poll at point | -| =C= | copy url of toot at point | -| =C-RET= | play video/gif at point (requires =mpv=) | -| =e= | edit your toot at point | -| =E= | view edits of toot at point | -| =i= | (un)pin your toot at point | -| =d= | delete your toot at point, and reload current timeline | -| =D= | delete and redraft toot at point, preserving reply/CW/visibility | +|----------------+-----------------------------------------------------------------------| +| Key | Action | +|----------------+-----------------------------------------------------------------------| +| | *Help* | +| =?= | Open context menu if =discover= is available | +|----------------+-----------------------------------------------------------------------| +| | *Timeline actions* | +| =n= | Go to next item (toot, notification) | +| =p= | Go to previous item (toot, notification) | +| =M-n=/== | Go to the next interesting thing that has an action | +| =M-p=/== | Go to the previous interesting thing that has an action | +| =F= | Open federated timeline | +| =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 | +| =A= | Open author profile of toot under =point= | +| =P= | Open profile of user attached to toot under =point= | +| =O= | View own profile | +| =U= | update your profile bio note | +|----------------+-----------------------------------------------------------------------| +| | *Other views* | +| =S= | search (posts, users, tags) (NB: only posts you have interacted with) | +| =I=, =c=, =d= | view, create, and delete filters | +| =R=, =a=, =j= | view/accept/reject follow requests | +| =G= | view follow suggestions | +| =V= | view your favourited toots | +| =K= | view bookmarked toots | +| =X= | view/edit/create/delete lists | +|----------------+-----------------------------------------------------------------------| +| | *Toot actions* | +| =t= | Compose a new toot | +| =c= | Toggle content warning content | +| =b= | Boost toot under =point= | +| =f= | Favourite toot under =point= | +| =k= | toggle bookmark of toot at point | +| =r= | Reply to toot under =point= | +| =v= | Vote on poll at point | +| =C= | copy url of toot at point | +| =C-RET= | play video/gif at point (requires =mpv=) | +| =e= | edit your toot at point | +| =E= | view edits of toot at point | +| =i= | (un)pin your toot at point | +| =d= | delete your toot at point, and reload current timeline | +| =D= | delete and redraft toot at point, preserving reply/CW/visibility | | (=S-C-=) =W=, =M=, =B= | (un)follow, (un)mute, (un)block author of toot at point | -|---------------+-----------------------------------------------------------------------| -| | Notifications view | -| =a=, =j= | accept/reject follow request | -| =c= | clear notification at point | -| | see =mastodon-notifications--get-*= functions for filtered views | -|---------------+-----------------------------------------------------------------------| -| | *Quitting* | -| =q= | Quit mastodon buffer, leave window open | -| =Q= | Quit mastodon buffer and kill window | -|---------------+-----------------------------------------------------------------------| +|----------------+-----------------------------------------------------------------------| +| | *Profile view* | +| =C-c C-c= | cycle between statuses, followers, following, and statuses without boosts | +| | =mastodon-profile--account-account-to-list= (see lists view) | +|----------------+-----------------------------------------------------------------------| +| | *Notifications view* | +| =a=, =j= | accept/reject follow request | +| =c= | clear notification at point | +| | see =mastodon-notifications--get-*= functions for filtered views | +|----------------+-----------------------------------------------------------------------| +| | *Quitting* | +| =q= | Quit mastodon buffer, leave window open | +| =Q= | Quit mastodon buffer and kill window | +|----------------+-----------------------------------------------------------------------| **** Toot byline legend diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 3a869ed..c604bcd 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -69,6 +69,8 @@ (autoload 'mastodon-search--insert-users-propertized "mastodon-search") (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") + (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--update-point) @@ -243,6 +245,15 @@ JSON is the data returned by the server." (mastodon-search--insert-users-propertized json :note))) ;; (mastodon-profile--add-author-bylines json))) +(defun mastodon-profile--add-account-to-list () + "Add account of current profile buffer to a list." + (interactive) + (when mastodon-profile--account + (let* ((profile mastodon-profile--account) + (id (alist-get 'id profile)) + (handle (alist-get 'acct profile))) + (mastodon-tl--add-account-to-list nil id handle)))) + ;;; ACCOUNT PREFERENCES (defun mastodon-profile--get-json-value (val) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0928b1b..e3a2665 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -77,6 +77,7 @@ (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") +(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -665,10 +666,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (when edited-time (concat (if (fontp (char-displayable-p #10r128274)) @@ -1716,15 +1717,6 @@ If ID is provided, use that list." (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) (mastodon-http--get-json url))) -(defun mastodon-tl--add-profile-account-to-list () - "Add account of current profile buffer to a list." - (interactive) - (when mastodon-profile--account - (let* ((profile mastodon-profile--account) - (id (alist-get 'id profile)) - (handle (alist-get 'acct profile))) - (mastodon-tl--add-account-to-list nil id handle)))) - ;;; FILTERS (defun mastodon-tl--create-filter () -- cgit v1.2.3 From 81ecff802190fc1040e331630f6648765ea7320a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 15:27:23 +0100 Subject: use unicode star if poss for faves. --return-fave-char --- lisp/mastodon-tl.el | 13 ++++++++++++- lisp/mastodon-toot.el | 4 +++- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e3a2665..d829015 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -619,7 +619,8 @@ this just means displaying toot client." (concat (when boosted (mastodon-tl--format-faved-or-boosted-byline "B")) (when faved - (mastodon-tl--format-faved-or-boosted-byline "F")) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-fave-char))) (when bookmarked (mastodon-tl--format-faved-or-boosted-byline bookmark-str))) ;; we remove avatars from the byline also, so that they also do not mess @@ -692,6 +693,16 @@ this just means displaying toot client." (mastodon-toot--get-toot-edits (alist-get 'id toot))) 'byline t)))) +(defun mastodon-tl--return-fave-char () + "" + (cond + ((fontp (char-displayable-p #10r11088)) + "⭐") + ((fontp (char-displayable-p #10r9733)) + "★") + (t + "F"))) + (defun mastodon-tl--format-edit-timestamp (timestamp) "Convert edit TIMESTAMP into a descriptive string." (let ((parsed (ts-human-duration diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6162f52..36d08fd 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -332,7 +332,9 @@ TYPE is a symbol, either 'favourite or 'boost." (list 'boosted-p (not boosted)) (list 'favourited-p (not faved)))) (mastodon-toot--action-success - (if boost-p "B" "F") + (if boost-p + "B" + (mastodon-tl--return-fave-char)) byline-region remove)) (message (format "%s #%s" (if boost-p msg action) id)))))) (message (format "Nothing to %s here?!?" action-string))))) -- cgit v1.2.3 From f5420dd98a335d434f3cdc2c8456504f25c6ac9d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 11:42:13 +0100 Subject: add annotation to completions (URL for tag, username for mention) this is still rough, uses a defvar-local which may be avoidable. --- lisp/mastodon-toot.el | 47 ++++++++++++++++++++++++++++++++++++----------- 1 file changed, 36 insertions(+), 11 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c13d43b..6855280 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -949,10 +949,17 @@ meta fields respectively." ;; only search when necessary: (completion-table-dynamic (lambda (_) - (mastodon-search--search-accounts-query - (buffer-substring-no-properties start end) - :capf))) - :exclusive 'no)))) + ;; TODO: do we really need to set a local var here + ;; just for the annotation-function? + (setq mastodon-toot-completions + (mastodon-search--search-accounts-query + (buffer-substring-no-properties start end) + :capf)))) + :exclusive 'no + :annotation-function + (lambda (candidate) + (concat " " + (mastodon-toot--mentions-annotation-fun candidate))))))) (defun mastodon-toot--tags-capf () "Build a tags completion backend for `completion-at-point-functions'." @@ -966,13 +973,31 @@ meta fields respectively." ;; only search when necessary: (completion-table-dynamic (lambda (_) - (let ((tags (mastodon-search--search-tags-query - (buffer-substring-no-properties start end)))) - (mapcar (lambda (x) - (list (concat "#" (car x)) - (cdr x))) - tags)))) - :exclusive 'no)))) + (setq mastodon-toot-completions + (let ((tags (mastodon-search--search-tags-query + (buffer-substring-no-properties start end)))) + (mapcar (lambda (x) + (list (concat "#" (car x)) + (cdr x))) + tags))))) + :exclusive 'no + :annotation-function + (lambda (candidate) + (concat " " + (mastodon-toot--tags-annotation-fun candidate))))))) + +(defvar-local mastodon-toot-completions nil + "The data of completion candidates for the current completion at point.") + +(defun mastodon-toot--mentions-annotation-fun (candidate) + "Given a handle completion CANDIDATE, return its annotation string, a username." + (caddr (assoc candidate mastodon-toot-completions))) + +(defun mastodon-toot--tags-annotation-fun (candidate) + "Given a tag string CANDIDATE, return an annotation, the tag's URL." + ;; FIXME check the list returned here? should be cadr + ;;or make it an alist and use cdr + (caadr (assoc candidate mastodon-toot-completions))) (defun mastodon-toot-mentions (command &optional arg &rest ignored) "A company completion backend for toot mentions. -- cgit v1.2.3 From 1713abbe28c4a8ad684b651450b2c6e06a512c9a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 12:58:22 +0100 Subject: discover.el - remove (when (require and RET, both break it --- lisp/mastodon-discover.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 5d1a86e..5b8141b 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -57,8 +57,8 @@ ("p" "Prev" mastodon-tl--goto-prev-toot) ("TAB" "Next link item" mastodon-tl--next-tab-item) ("S-TAB" "Prev link item" mastodon-tl--previous-tab-item) - (when (require 'mpv nil :noerror) - ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point)) + ;; NB: (when (require 'mpv etc. calls don't work here + ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point) ("t" "New toot" mastodon-toot) ("r" "Reply" mastodon-toot--reply) ("C" "Copy toot URL" mastodon-toot--copy-toot-url) @@ -66,8 +66,7 @@ ("D" "Delete and redraft (your) toot" mastodon-toot--delete-toot) ("i" "Pin/Unpin (your) toot" mastodon-toot--pin-toot-toggle) ("P" "View user profile" mastodon-profile--show-user) - (when (require 'lingva nil :noerror) - "s" "Translate toot at point" mastodon-toot--translate-toot-text) + ("s" "Translate toot at point" mastodon-toot--translate-toot-text) ("T" "View thread" mastodon-tl--thread) ("v" "Vote on poll" mastodon-tl--poll-vote)) ("Views" @@ -94,7 +93,8 @@ ("B" "Block" mastodon-tl--block-user) ("C-S-B" "Unblock" mastodon-tl--unblock-user)) ("Images" - ("RET/i" "Load full image in browser" 'shr-browse-image) + ;; RET errors here also :/ + ("/i" "Load full image in browser" 'shr-browse-image) ("r" "rotate" 'image-rotate) ("+" "zoom in" 'image-increase-size) ("-" "zoom out" 'image-decrease-size) -- cgit v1.2.3 From dd54eccecd6c5360fc1d24828323d2e84e3a2e74 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 12:58:22 +0100 Subject: discover.el - remove (when (require and RET, both break it --- lisp/mastodon-discover.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index dc8a924..08df46e 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -57,8 +57,8 @@ ("p" "Prev" mastodon-tl--goto-prev-toot) ("TAB" "Next link item" mastodon-tl--next-tab-item) ("S-TAB" "Prev link item" mastodon-tl--previous-tab-item) - (when (require 'mpv nil :noerror) - ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point)) + ;; NB: (when (require 'mpv etc. calls don't work here + ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point) ("t" "New toot" mastodon-toot) ("r" "Reply" mastodon-toot--reply) ("C" "Copy toot URL" mastodon-toot--copy-toot-url) @@ -66,8 +66,7 @@ ("D" "Delete and redraft (your) toot" mastodon-toot--delete-toot) ("i" "Pin/Unpin (your) toot" mastodon-toot--pin-toot-toggle) ("P" "View user profile" mastodon-profile--show-user) - (when (require 'lingva nil :noerror) - "s" "Translate toot at point" mastodon-toot--translate-toot-text) + ("s" "Translate toot at point" mastodon-toot--translate-toot-text) ("T" "View thread" mastodon-tl--thread) ("v" "Vote on poll" mastodon-tl--poll-vote)) ("Views" @@ -94,7 +93,8 @@ ("B" "Block" mastodon-tl--block-user) ("C-S-B" "Unblock" mastodon-tl--unblock-user)) ("Images" - ("RET/i" "Load full image in browser" 'shr-browse-image) + ;; RET errors here also :/ + ("/i" "Load full image in browser" 'shr-browse-image) ("r" "rotate" 'image-rotate) ("+" "zoom in" 'image-increase-size) ("-" "zoom out" 'image-decrease-size) -- cgit v1.2.3 From 69c817d1a901f0aaa871f2679659f64fc438c40b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 13:34:08 +0100 Subject: readme read compatability --- README.org | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/README.org b/README.org index a757706..bacab59 100644 --- a/README.org +++ b/README.org @@ -6,7 +6,7 @@ * README -=mastodon.el= is an Emacs client for the Mastodon and Pleroma social networks. For info see https://joinmastodon.org/. +=mastodon.el= is an Emacs client for the AcitivityPub social networks that implement the Mastodon API. For info see https://joinmastodon.org/. ** Installation @@ -317,6 +317,12 @@ Optional dependencies: - =mpv= and =mpv.el= for viewing videos and gifs - =lingva.el= for translating toots +** Network compatibility. + +=mastodon.el= should work with ActivityPub servers that implement the Mastodon API. + +Apart from Mastodon itself, it is currently known to work with Pleroma and Gotosocial. If you attempt to use =mastodon.el= with another server that implements the Mastodon API and run into problems, feel free to open an issue. + ** Contributing PRs, issues, feature requests, and general feedback are very welcome! -- cgit v1.2.3 From b2b8fe39b6863a1398bf7d50e9ee9bc3143d2fe2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 15:03:20 +0100 Subject: display icon for boosts will later follow rougier's lead on this, but just wanted to see how it looked --- lisp/mastodon-tl.el | 29 +++++++++++++++++++++-------- lisp/mastodon-toot.el | 2 +- 2 files changed, 22 insertions(+), 9 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 46ec8fe..e65d3a5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -600,9 +600,6 @@ this just means displaying toot client." (faved (equal 't (mastodon-tl--field 'favourited toot))) (boosted (equal 't (mastodon-tl--field 'reblogged toot))) (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot))) - (bookmark-str (if (fontp (char-displayable-p #10r128278)) - "🔖" - "K")) (visibility (mastodon-tl--field 'visibility toot)) (account (alist-get 'account toot)) (avatar-url (alist-get 'avatar account)) @@ -617,12 +614,14 @@ this just means displaying toot client." ;; displayed for an already boosted/favourited toot or as the result of ;; the toot having just been favourited/boosted. (concat (when boosted - (mastodon-tl--format-faved-or-boosted-byline "B")) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-boost-char))) (when faved (mastodon-tl--format-faved-or-boosted-byline (mastodon-tl--return-fave-char))) (when bookmarked - (mastodon-tl--format-faved-or-boosted-byline bookmark-str))) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-bookmark-char)))) ;; 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 @@ -667,10 +666,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (if edited-time (concat (if (fontp (char-displayable-p #10r128274)) @@ -694,6 +693,14 @@ 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 @@ -704,6 +711,12 @@ this just means displaying toot client." (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 diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4f9fb1b..7211183 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -334,7 +334,7 @@ TYPE is a symbol, either 'favourite or 'boost." (list 'favourited-p (not faved)))) (mastodon-toot--action-success (if boost-p - "B" + (mastodon-tl--return-boost-char) (mastodon-tl--return-fave-char)) byline-region remove)) (message (format "%s #%s" (if boost-p msg action) id)))))) -- cgit v1.2.3 From 78f1100f5651e498468d42d9830daed924b1237b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 17:28:24 +0100 Subject: http: always use PARAMS or CBARGS, never ARGS anywhere --- lisp/mastodon-http.el | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 69a571d..d677e57 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -132,15 +132,15 @@ Used for API form data parameters that take an array." (cl-loop for x in array collect (cons param-str x))) -(defun mastodon-http--post (url &optional args headers unauthenticated-p) - "POST synchronously to URL, optionally with ARGS and HEADERS. +(defun mastodon-http--post (url &optional params headers unauthenticated-p) + "POST synchronously to URL, optionally with PARAMS and HEADERS. Authorization header is included by default unless UNAUTHENTICATED-P is non-nil." (mastodon-http--authorized-request "POST" (let ((url-request-data - (when args - (mastodon-http--build-params-string args))) + (when params + (mastodon-http--build-params-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -237,11 +237,12 @@ PARAMS is an alist of any extra parameters to send with the request." (defun mastodon-http--put (url &optional params headers) "Make PUT request to URL. -PARAMS is an alist of any extra parameters to send with the request." +PARAMS is an alist of any extra parameters to send with the request. +HEADERS is an alist of any extra headers to send with the request." (mastodon-http--authorized-request "PUT" (let ((url-request-data - (when args (mastodon-http--build-params-string params))) + (when params (mastodon-http--build-params-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -288,35 +289,36 @@ PARAMS is an alist of any extra parameters to send with the request." "GET" (url-retrieve url callback cbargs)))) -(defun mastodon-http--get-response-async (url &optional params callback &rest args) - "Make GET request to URL. Call CALLBACK with http response and ARGS." +(defun mastodon-http--get-response-async (url &optional params callback &rest cbargs) + "Make GET request to URL. Call CALLBACK with http response and CBARGS. +PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async url params (lambda (status) (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-response) args))))) + (apply callback (mastodon-http--process-response) cbargs))))) -(defun mastodon-http--get-json-async (url &optional params callback &rest args) - "Make GET request to URL. Call CALLBACK with json-list and ARGS. +(defun mastodon-http--get-json-async (url &optional params callback &rest cbargs) + "Make GET request to URL. Call CALLBACK with json-list and CBARGS. PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async url params (lambda (status) (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-json) args))))) + (apply callback (mastodon-http--process-json) cbargs))))) -(defun mastodon-http--post-async (url args headers &optional callback &rest cbargs) - "POST asynchronously to URL with ARGS and HEADERS. +(defun mastodon-http--post-async (url params headers &optional callback &rest cbargs) + "POST asynchronously to URL with PARAMS and HEADERS. Then run function CALLBACK with arguements CBARGS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (mastodon-http--authorized-request "POST" (let ((request-timeout 5) (url-request-data - (when args - (mastodon-http--build-params-string args)))) + (when params + (mastodon-http--build-params-string params)))) (with-temp-buffer (url-retrieve url callback cbargs))))) -- cgit v1.2.3 From e311d491977fb9012d30ed146231f95ea52008af Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 17:28:52 +0100 Subject: docstrings and autoloads --- lisp/mastodon-profile.el | 8 +++++--- lisp/mastodon-search.el | 3 +-- lisp/mastodon-toot.el | 1 + 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 69cd65d..d5ef7a8 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -154,7 +154,8 @@ contains") (mastodon-tl--property 'toot-json)) (defun mastodon-profile--make-author-buffer (account &optional no-reblogs) - "Take an ACCOUNT json and insert a user account into a new buffer." + "Take an ACCOUNT json and insert a user account into a new buffer. +NO-REBLOGS means do not display boosts in statuses." (mastodon-profile--make-profile-buffer-for account "statuses" #'mastodon-tl--timeline no-reblogs)) @@ -553,7 +554,8 @@ 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) - "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION." + "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. +NO-REBLOGS means do not display boosts in statuses." (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))) @@ -664,7 +666,7 @@ FIELDS means provide a fields vector fetched by other means." (goto-char (point-min)))) (defun mastodon-profile--format-joined-date-string (joined) - "Format a Joined timestamp." + "Format a human-readable Joined string from timestamp JOINED." (let ((joined-ts (ts-parse joined))) (format "Joined %s" (concat (ts-month-name joined-ts) " " diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index f83cccb..b037faa 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -173,8 +173,7 @@ user's profile note. This is also called by json)) (defun mastodon-search--propertize-user (acct &optional note) - "Propertize display string for ACCT, optionally including profile -NOTE." + "Propertize display string for ACCT, optionally including profile NOTE." (let ((user (mastodon-search--get-user-info acct))) (propertize (concat (propertize (car user) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4f9fb1b..0e21b0e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -84,6 +84,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") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") -- cgit v1.2.3 From a176e6b7668cbd93df6aaa9280da7145c80fcb86 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 17:42:12 +0100 Subject: no blank lines in docstrings in profile.el --- lisp/mastodon-profile.el | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index d5ef7a8..fa9642e 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -113,7 +113,6 @@ (define-minor-mode mastodon-profile-mode "Toggle mastodon profile minor mode. - This minor mode is used for mastodon profile pages and adds a couple of extra keybindings." :init-value nil @@ -675,7 +674,6 @@ NO-REBLOGS means do not display boosts in statuses." (defun mastodon-profile--get-toot-author () "Open profile of author of toot under point. - If toot is a boost, opens the profile of the booster." (interactive) (mastodon-profile--make-author-buffer @@ -731,7 +729,6 @@ IMG_TYPE is the JSON key from the account data." (defun mastodon-profile--account-field (account field) "Return FIELD from the ACCOUNT. - FIELD is used to identify regions under 'account" (cdr (assoc field account))) @@ -762,7 +759,6 @@ Used to view a user's followers and those they're following." (defun mastodon-profile--search-account-by-handle (handle) "Return an account based on a user's HANDLE. - If the handle does not match a search return then retun NIL." (let* ((handle (if (string= "@" (substring handle 0 1)) (substring handle 1 (length handle)) @@ -785,15 +781,14 @@ If the handle does not match a search return then retun NIL." (defun mastodon-profile--extract-users-handles (status) "Return all user handles found in STATUS. - These include the author, author of reblogged entries and any user mentioned." (when status (let ((this-account (or (alist-get 'account status) ; status is a toot status)) ; status is a user listing - (mentions (or (alist-get 'mentions (alist-get 'status status)) + (mentions (or (alist-get 'mentions (alist-get 'status status)) (alist-get 'mentions status))) - (reblog (or (alist-get 'reblog (alist-get 'status status)) + (reblog (or (alist-get 'reblog (alist-get 'status status)) (alist-get 'reblog status)))) (seq-filter 'stringp -- cgit v1.2.3 From c9d799a80486f3604a5eb2b877c1faa54bf4c87d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 11:54:29 +0100 Subject: tl-tests: fix stray double space after separator --- test/mastodon-tl-tests.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 0ac5caf..f9b315c 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -340,7 +340,7 @@ Strict-Transport-Security: max-age=31536000 'mastodon-tl--byline-boosted)) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-boosted () "Should format the boosted toot correctly." @@ -357,7 +357,7 @@ Strict-Transport-Security: max-age=31536000 'mastodon-tl--byline-boosted)) "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-favorited () "Should format the favourited toot correctly." @@ -374,7 +374,7 @@ Strict-Transport-Security: max-age=31536000 'mastodon-tl--byline-boosted)) "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-boosted/favorited () @@ -392,7 +392,7 @@ Strict-Transport-Security: max-age=31536000 'mastodon-tl--byline-boosted)) "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-reblogged () "Should format the reblogged toot correctly." @@ -451,7 +451,7 @@ Strict-Transport-Security: max-age=31536000 "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-reblogged-boosted/favorited () "Should format the reblogged toot that was also boosted & favoritedcorrectly." @@ -475,7 +475,7 @@ Strict-Transport-Security: max-age=31536000 "(B) (F) Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-timestamp-has-relative-display () "Should display the timestamp with a relative time." -- cgit v1.2.3 From 143232e53d05bd42560d5ee9265bcb74245a29e2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 12:02:01 +0100 Subject: remove trailing double space from sparator tl-tests: remove trailing double spaces from separator again --- lisp/mastodon-tl.el | 2 +- test/mastodon-tl-tests.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 46ec8fe..159c2cc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -685,7 +685,7 @@ this just means displaying toot client." (mastodon-tl--relative-time-description edited-parsed) edited-parsed))) "") - (propertize "\n ------------\n " 'face 'default)) + (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted 'bookmarked-p bookmarked diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index f9b315c..a80c3ee 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -317,7 +317,7 @@ Strict-Transport-Security: max-age=31536000 byline) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - ")) +")) (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) 'user-handle)) (should (string= (get-text-property handle-location 'mastodon-handle byline) @@ -418,7 +418,7 @@ Strict-Transport-Security: max-age=31536000 "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ - ")) +")) (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle1-location 'help-echo byline) -- cgit v1.2.3 From 83231a8e0dbce439e0d98a158291c7be9fb4525b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 12:03:03 +0100 Subject: tweak joined date newlines printing + test --- lisp/mastodon-profile.el | 9 ++++++--- test/mastodon-profile-tests.el | 3 ++- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index fa9642e..3ba00b9 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -617,15 +617,18 @@ NO-REBLOGS means do not display boosts in statuses." " [locked]") "") "\n ------------\n" - (mastodon-tl--render-text note account) + ;; profile note: ;; account here to enable tab-stops in profile note + (mastodon-tl--render-text note account) + ;; meta fields: (if fields (concat "\n" (mastodon-tl--set-face (mastodon-profile--fields-insert fields) - 'success) - "\n") + 'success)) "") + "\n" + ;; Joined date: (propertize (mastodon-profile--format-joined-date-string joined) 'face 'success) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 7478aaf..d53e1f4 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -271,7 +271,8 @@ content generation in the function under test." "@Gargron\n" " ------------\n" "

Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.

\n" - "_ Patreon __ :: https://www.patreon.com/mastodon_ Homepage _ :: https://zeonfederated.com\n" + "_ Patreon __ :: https://www.patreon.com/mastodon_ Homepage _ :: https://zeonfederated.com" + "\n" "Joined March 2016" "\n\n" " ------------\n" -- cgit v1.2.3 From 97f409cf600278900ebf439d4efb87cb22e17182 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 12:14:33 +0100 Subject: profile-tests add nil call to get-json --- test/mastodon-profile-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index d53e1f4..1ce9514 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -237,7 +237,7 @@ content generation in the function under test." (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") + (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses" nil) => gargon-statuses-json) (mock (mastodon-profile--get-statuses-pinned *) -- cgit v1.2.3 From 383f31d06cbf8327507aabfa71d6d6fd85618873 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 13:37:33 +0100 Subject: caption + props for media urls as well as actual media adds fun mastodon-tl--propertize-img-str-or-url, to prop both. --- lisp/mastodon-media.el | 35 +++++++++++------------------ lisp/mastodon-tl.el | 60 +++++++++++++++++++++++++++++++++++++------------- 2 files changed, 58 insertions(+), 37 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 9715a6c..c783130 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -35,6 +35,8 @@ ;;; Code: (require 'url-cache) +(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl") + (defvar url-show-status) (defvar mastodon-tl--shr-image-map-replacement) @@ -306,34 +308,23 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type caption) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url + type caption) "Return the string to be written that renders the image at MEDIA-URL. FULL-REMOTE-URL is used for `shr-browse-image'. TYPE is the attachment's type field on the server. CAPTION is the image caption if provided." (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview") - (help-echo (if caption - (concat help-echo-base - "\n\"" - caption "\"") - help-echo-base))) + (help-echo (if caption + (concat help-echo-base + "\n\"" + caption "\"") + help-echo-base))) (concat - (propertize "[img]" - 'media-url media-url - 'media-state 'needs-loading - 'media-type 'media-link - 'mastodon-media-type type - 'display (create-image mastodon-media--generic-broken-image-data nil t) - 'mouse-face 'highlight - 'mastodon-tab-stop 'image ; for do-link-action-at-point - 'image-url full-remote-url ; for shr-browse-image - 'keymap mastodon-tl--shr-image-map-replacement - 'help-echo (if (or (string= type "image") - (string= type nil) - (string= type "unknown")) ;handle borked images - help-echo - (concat help-echo "\nC-RET: play " type " with mpv"))) - " "))) + (mastodon-tl--propertize-img-str-or-url + "[img]" media-url full-remote-url type help-echo + (create-image mastodon-media--generic-broken-image-data nil t)) + " "))) (provide 'mastodon-media) ;;; mastodon-media.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 159c2cc..b74ac84 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1019,26 +1019,56 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) - (media-string (mapconcat - (lambda (media-attachement) - (let ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement))) - (if mastodon-tl--display-media-p - (mastodon-media--get-media-link-rendering - preview-url remote-url type caption) ; 2nd arg for shr-browse-url - (concat "Media::" preview-url "\n")))) - media-attachements ""))) + (media-string + (mapconcat + (lambda (media-attachement) + (let ((preview-url + (alist-get 'preview_url media-attachement)) + (remote-url + (or (alist-get 'remote_url media-attachement) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement)) + (caption (alist-get 'description media-attachement))) + (if mastodon-tl--display-media-p + (mastodon-media--get-media-link-rendering + preview-url remote-url type caption) ; 2nd arg for shr-browse-url + (concat + (mastodon-tl--propertize-img-str-or-url + (concat "Media:: " preview-url) + preview-url remote-url type caption nil 'shr-link) + "\n")))) + media-attachements ""))) (if (not (and mastodon-tl--display-media-p (string-empty-p media-string))) (concat "\n" media-string) ""))) +(defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type + help-echo &optional display face) + "Propertize an media placeholder string \"[img]\" or media URL. + +STR is the string to propertize, MEDIA-URL is the preview link, +FULL-REMOTE-URL is the link to the full resolution image on the +server, TYPE is the media type. +HELP-ECHO, DISPLAY, and FACE are the text properties to add." + (propertize str + 'media-url media-url + 'media-state (when (string= str "[img]") 'needs-loading) + 'media-type 'media-link + 'mastodon-media-type type + 'display display + 'face face + 'mouse-face 'highlight + 'mastodon-tab-stop 'image ; for do-link-action-at-point + 'image-url full-remote-url ; for shr-browse-image + 'keymap mastodon-tl--shr-image-map-replacement + 'help-echo (if (or (string= type "image") + (string= type nil) + (string= type "unknown")) ;handle borked images + help-echo + (concat help-echo "\nC-RET: play " type " with mpv")))) + (defun mastodon-tl--content (toot) "Retrieve text content from TOOT. Runs `mastodon-tl--render-text' and fetches poll or media." -- cgit v1.2.3 From 021ae971f25a96428927cf5b3d82980b5464d820 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 13:50:51 +0100 Subject: set 'display to the image caption if we have one --- lisp/mastodon-tl.el | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b74ac84..aac5761 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1022,21 +1022,29 @@ message is a link which unhides/hides the main body." (media-string (mapconcat (lambda (media-attachement) - (let ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement))) + (let* ((preview-url + (alist-get 'preview_url media-attachement)) + (remote-url + (or (alist-get 'remote_url media-attachement) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement)) + (caption (alist-get 'description media-attachement)) + (display-str (if caption + (concat "Media:: " caption) + (concat "Media:: " preview-url)))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering preview-url remote-url type caption) ; 2nd arg for shr-browse-url (concat (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " preview-url) - preview-url remote-url type caption nil 'shr-link) + (concat "Media:: " preview-url) ;; string + preview-url remote-url type caption + display-str ;; display + ;; FIXME: shr-link underlining is awful for captions with + ;; newlines, as the underlining runs to the edge of the + ;; frame even if the text doesn' + 'shr-link) "\n")))) media-attachements ""))) (if (not (and mastodon-tl--display-media-p -- cgit v1.2.3 From 3717b6cb86c8d0037ca49d4f500a44560c9ac5ae Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 16:19:19 +0100 Subject: refactor tl--media-attachment + customize to display caption not URL --- lisp/mastodon-tl.el | 70 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 41 insertions(+), 29 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index aac5761..d907915 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -107,6 +107,13 @@ By default fixed width fonts are used." :type '(boolean :tag "Enable using proportional rather than fixed \ width fonts when rendering HTML text")) +(defcustom mastodon-tl--display-caption-not-url-when-no-media t + "Display an image's caption rather than URL. +Only has an effect when `mastodon-tl--display-media-p' is set to +nil." + :group 'mastodon-tl + :type 'boolean) + (defvar-local mastodon-tl--buffer-spec nil "A unique identifier and functions for each Mastodon buffer.") @@ -1018,40 +1025,45 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." - (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) - (media-string - (mapconcat - (lambda (media-attachement) - (let* ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement)) - (display-str (if caption - (concat "Media:: " caption) - (concat "Media:: " preview-url)))) - (if mastodon-tl--display-media-p - (mastodon-media--get-media-link-rendering - preview-url remote-url type caption) ; 2nd arg for shr-browse-url - (concat - (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " preview-url) ;; string - preview-url remote-url type caption - display-str ;; display - ;; FIXME: shr-link underlining is awful for captions with - ;; newlines, as the underlining runs to the edge of the - ;; frame even if the text doesn' - 'shr-link) - "\n")))) - media-attachements ""))) + (let* ((media-attachments (mastodon-tl--field 'media_attachments toot)) + (media-string (mapconcat #'mastodon-tl--media-attachment + media-attachments ""))) (if (not (and mastodon-tl--display-media-p (string-empty-p media-string))) (concat "\n" media-string) ""))) +(defun mastodon-tl--media-attachment (media-attachment) + "Return a propertized string for MEDIA-ATTACHMENT." + (let* ((preview-url + (alist-get 'preview_url media-attachment)) + (remote-url + (or (alist-get 'remote_url media-attachment) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachment))) + (type (alist-get 'type media-attachment)) + (caption (alist-get 'description media-attachment)) + (display-str + (if (and mastodon-tl--display-caption-not-url-when-no-media + caption) + (concat "Media:: " caption) + (concat "Media:: " preview-url)))) + (if mastodon-tl--display-media-p + ;; return placeholder [img]: + (mastodon-media--get-media-link-rendering + preview-url remote-url type caption) ; 2nd arg for shr-browse-url + ;; return URL/caption: + (concat + (mastodon-tl--propertize-img-str-or-url + (concat "Media:: " preview-url) ;; string + preview-url remote-url type caption + display-str ;; display + ;; FIXME: shr-link underlining is awful for captions with + ;; newlines, as the underlining runs to the edge of the + ;; frame even if the text doesn' + 'shr-link) + "\n")))) + (defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type help-echo &optional display face) "Propertize an media placeholder string \"[img]\" or media URL. -- cgit v1.2.3 From 9b0fdec55f6770d7c270e0a1e501ceb5e3ebcd95 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 16:33:43 +0100 Subject: remove all company backends, use company-capf + use-company custom --- lisp/mastodon-toot.el | 182 ++++++-------------------------------------------- 1 file changed, 21 insertions(+), 161 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8e6f4df..b12e7e1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -41,12 +41,6 @@ (require 'cl-lib) (require 'persist) -(when (require 'company nil :noerror) - (declare-function company-mode-on "company") - (declare-function company-begin-backend "company") - (declare-function company-grab-symbol "company") - (defvar company-backends)) - (require 'mastodon-iso) (defvar mastodon-instance-url) @@ -105,31 +99,24 @@ :group 'mastodon-toot :type 'integer) -(defcustom mastodon-toot--enable-completion - (if (require 'company nil :noerror) t nil) +(defcustom mastodon-toot--enable-completion t "Whether to enable completion of mentions and hashtags. -Used for completion in toot compose buffer. -This is only used if company mode is installed." +Used for completion in toot compose buffer." :group 'mastodon-toot :type 'boolean) (defcustom mastodon-toot--use-company-for-completion nil - "Whether to use company completion backends directly. -When non-nil, company backends `mastodon-toot-mentions' and -`mastodon-toot-tags' are used for completion. - -A nil setting will use `completion-at-point-functions' for -completion, which also work with company, provided that the -backend `company-capf' is enabled. + "Whether to enable company for completion. -If setting this to non-nil, ensure `corfu-mode' is disabled as the -two are incompatible. +When non-nil, `company-mode' is enabled in the toot compose +buffer, and mastodon completion backends are added to +`company-capf'. -When the `completion-at-point-functions' backends are more -complete, direct company backends will be removed.") +You need to install company yourself to use this." + :group 'mastodon-toot + :type 'boolean) -(defcustom mastodon-toot--completion-style-for-mentions - (if (require 'company nil :noerror) "following" "off") +(defcustom mastodon-toot--completion-style-for-mentions "all" "The company completion style to use for mentions." :group 'mastodon-toot :type '(choice @@ -837,98 +824,6 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (reverse (append mentions nil)) ""))) -(defun mastodon-toot--mentions-company-meta (candidate) - "Format company completion CANDIDATE's meta field." - (format " %s" - (get-text-property 0 'meta candidate))) - -(defun mastodon-toot--mentions-company-annotation (candidate) - "Format company completion CANDIDATE's annotation." - (format " %s" (get-text-property 0 'annot candidate))) - -(defun mastodon-toot--mentions-company-make-candidate (candidate) - "Construct a company completion CANDIDATE for display." - (let ((display-name (car candidate)) - (handle (cadr candidate)) - (url (caddr candidate))) - (propertize handle 'annot display-name 'meta url))) - -(defun mastodon-toot--tags-company-make-candidate (candidate) - "Construct a company completion CANDIDATE for display." - (let ((tag (concat "#" (car candidate))) - (url (cadr candidate))) - (propertize tag 'annot url 'meta url))) - -(defun mastodon-toot--company-build-candidates (query list-fun make-fun) - "Build a list of completion candidates for a company backend. -QUERY is the search prefix, LIST-FUN builds a list of items to -match against, and MAKE-FUN builds the actual cadidate list item -for display by company." - (let ((query (substring query 1)) ; remove @ or # for search - (res)) - (dolist (item (funcall list-fun query)) - (when (or (string-prefix-p query (substring (cadr item) 1) t) - (string-prefix-p query (car item) t)) - (push (funcall make-fun item) res))) - res)) - -(defun mastodon-toot--mentions-company-candidates (query) - "Given a company QUERY, build a list of candidates. -The query can match both user handles and display names." - (mastodon-toot--company-build-candidates - query - 'mastodon-search--search-accounts-query - 'mastodon-toot--mentions-company-make-candidate)) - -(defun mastodon-toot--tags-company-candidates (query) - "Given a company QUERY, build a list of candidates. -The query is matched against a tag search on the server." - (mastodon-toot--company-build-candidates - query - 'mastodon-search--search-tags-query - 'mastodon-toot--tags-company-make-candidate)) - -(defun mastodon-toot--make-company-backend - (command _backend-name str-prefix candidates-fun annot-fun meta-fun - &optional arg - &rest ignored) - "Make a company backend for `mastodon-toot-mode'. -COMMAND, ARG, IGNORED are all company backend args. -COMMAND is either prefix, to fetch a prefix query, candidates, to -build a list of candidates with query ARG, annotation, to format -an annotation for candidate ARG, or meta, to format meta info for -candidate ARG. IGNORED remains a mystery. - -BACKEND-NAME is the backend's name, STR-PREFIX is used to search -for matches, CANDIDATES-FUN, ANNOT-FUN, and META-FUN are -functions called on ARG to generate formatted candidates, annotation, and -meta fields respectively." - (interactive (list 'interactive)) - (let ((handle-before - ;; hack to handle @handles@with.domains, as "@" is a word/symbol boundary - (if (string= str-prefix "@") - (save-match-data - (save-excursion - (re-search-backward mastodon-toot-handle-regex nil :no-error) - (if (match-string-no-properties 2) - ;; match full handle inc. domain (see the regex for subexp 2) - (buffer-substring-no-properties (match-beginning 2) (match-end 2)) - "")))))) - (cl-case command - (interactive (company-begin-backend (quote backend-name))) - (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode - (save-excursion - (forward-whitespace -1) - (forward-whitespace 1) - (looking-at str-prefix))) - (if (and (string= str-prefix "@") - (> (length handle-before) 1)) ; more than just @ - (concat str-prefix (substring-no-properties handle-before 1)) ;handle - (concat str-prefix (company-grab-symbol))))) ; tag - (candidates (funcall candidates-fun arg)) - (annotation (funcall annot-fun arg)) - (meta (funcall meta-fun arg))))) - (defun mastodon-toot--get-bounds (regex) "Get bounds of tag or handle before point." ;; needed because # and @ are not part of any existing thing at point @@ -1002,38 +897,6 @@ meta fields respectively." ;;or make it an alist and use cdr (caadr (assoc candidate mastodon-toot-completions))) -(defun mastodon-toot-mentions (command &optional arg &rest ignored) - "A company completion backend for toot mentions. -COMMAND is either prefix, to fetch a prefix query, candidates, to -build a list of candidates with query ARG, annotation, to format -an annotation for candidate ARG, or meta, to format meta info for -candidate ARG. IGNORED remains a mystery." - (mastodon-toot--make-company-backend - command - 'mastodon-toot-mentions - "@" - 'mastodon-toot--mentions-company-candidates - 'mastodon-toot--mentions-company-annotation - 'mastodon-toot--mentions-company-meta - arg - ignored)) - -(defun mastodon-toot-tags (command &optional arg &rest ignored) - "A company completion backend for toot tags. -COMMAND is either prefix, to fetch a prefix query, candidates, to -build a list of candidates with query ARG, annotation, to format -an annotation for candidate ARG, or meta, to format meta info for -candidate ARG. IGNORED remains a mystery." - (mastodon-toot--make-company-backend - command - 'mastodon-toot-tags - "#" - 'mastodon-toot--tags-company-candidates - 'mastodon-toot--mentions-company-annotation - 'mastodon-toot--mentions-company-meta - arg - ignored)) - (defun mastodon-toot--reply () "Reply to toot at `point'. Customize `mastodon-toot-display-orig-in-reply-buffer' to display @@ -1566,21 +1429,18 @@ a draft into the buffer." (mastodon-toot--get-max-toot-chars)) ;; set up completion: (when mastodon-toot--enable-completion - (if (not mastodon-toot--use-company-for-completion) - ;; capf - (progn - (set ; (setq-local - (make-local-variable 'completion-at-point-functions) - (add-to-list - 'completion-at-point-functions - #'mastodon-toot--mentions-capf)) - (add-to-list - 'completion-at-point-functions - #'mastodon-toot--tags-capf)) - ;; company + (set ; (setq-local + (make-local-variable 'completion-at-point-functions) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot--mentions-capf)) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot--tags-capf) + ;; company + (when mastodon-toot--use-company-for-completion (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot-mentions)) - (add-to-list 'company-backends 'mastodon-toot-tags) + (add-to-list 'company-backends 'company-capf)) (company-mode-on))) ;; after-change: (make-local-variable 'after-change-functions) -- cgit v1.2.3 From d1242bec43a65a8e7f53a53c1a38cbb4816533f3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 17:06:54 +0100 Subject: capf readme --- README.org | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/README.org b/README.org index bacab59..06473f4 100644 --- a/README.org +++ b/README.org @@ -189,9 +189,7 @@ Pops a new buffer/window in =mastodon-toot= minor mode. Enter the contents of your toot here. =C-c C-c= sends the toot. =C-c C-k= cancels. Both actions kill the buffer and window. -Autocompletion of mentions and tags is provided by mastodon company backends -(requires =company-mode= and =mastodon-toot--enable-completion= must be set to =t=) -. Type =@= or =#= followed by two or more characters for candidates to appear. +Autocompletion of mentions and tags is provided by =completion-at-point-functions= (capf) backends. =mastodon-toot--enable-completion= is enabled by default. If you want to enable =company-mode= in the toot compose buffer, set =mastodon-toot--use-company-for-completion= to =t=. (=mastodon.el= used to run its own native company backends, but these have been removed in favour of capfs.) Replies preserve visibility status/content warnings, and include boosters by default. @@ -312,7 +310,6 @@ Hard dependencies (should all install with =mastodon.el=): - =ts= for poll relative expiry times Optional dependencies: -- =company= for autocompletion of mentions and tags when composing a toot - =emojify= for inserting and viewing emojis - =mpv= and =mpv.el= for viewing videos and gifs - =lingva.el= for translating toots -- cgit v1.2.3 From 0e06be9ffae90962aa18e7d6bfb40e7007028705 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 17:08:00 +0100 Subject: readme toot lang --- README.org | 1 + 1 file changed, 1 insertion(+) diff --git a/README.org b/README.org index bacab59..c15159b 100644 --- a/README.org +++ b/README.org @@ -214,6 +214,7 @@ You can download and use your instance's custom emoji | =C-c != | Remove all attachments | | =C-c C-e= | Add emoji (if =emojify= installed) | | =C-c C-p= | Create a poll | +| =C-c C-l= | Set toot language | |---------+----------------------------------| **** draft toots -- cgit v1.2.3 From 28b73ab054b15de2cdc4943dea125431c1866a5b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 17:12:18 +0100 Subject: move mastodon-toot-completions to top of file --- lisp/mastodon-toot.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1e364df..59a3813 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -188,6 +188,9 @@ Takes its form from `window-configuration-to-register'.") (defvar mastodon-toot--max-toot-chars nil "The maximum allowed characters count for a single toot.") +(defvar-local mastodon-toot-completions nil + "The data of completion candidates for the current completion at point.") + (defvar mastodon-toot-current-toot-text nil "The text of the toot being composed.") @@ -885,9 +888,6 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (concat " " (mastodon-toot--tags-annotation-fun candidate))))))) -(defvar-local mastodon-toot-completions nil - "The data of completion candidates for the current completion at point.") - (defun mastodon-toot--mentions-annotation-fun (candidate) "Given a handle completion CANDIDATE, return its annotation string, a username." (caddr (assoc candidate mastodon-toot-completions))) -- cgit v1.2.3 From b009c13325a57e53f6fcd8f71f9e88d492ea243d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 17:14:37 +0100 Subject: readme re completion style --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index b5c4a93..10627ff 100644 --- a/README.org +++ b/README.org @@ -263,7 +263,7 @@ See =M-x customize-group RET mastodon= to view all customize options. - Enable image caching - Compose options: - - Completion for mentions and tags + - Completion style for mentions and tags - Enable custom emoji - Display toot being replied to -- cgit v1.2.3 From eca8401b6ed04ed0f787efcd8517b022c55f9ed7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 17:25:03 +0100 Subject: comment remove company mention --- lisp/mastodon-search.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 9d8ee65..65c5aba 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -47,7 +47,7 @@ (defvar mastodon-toot--enable-completion-for-mentions) (defvar mastodon-tl--buffer-spec) -;; functions for company completion of mentions in mastodon-toot +;; functions for completion of mentions in mastodon-toot (defun mastodon-search--get-user-info-@-capf (account) "Get user handle, display name and account URL from ACCOUNT." -- cgit v1.2.3 From e3e3dc0227f8fd83c53a611bfb63c37595cd35cf Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 19:53:37 +0100 Subject: filter user posts by language. NB: we flip mastodon-iso-639-1! --- lisp/mastodon-iso.el | 370 +++++++++++++++++++++++++------------------------- lisp/mastodon-tl.el | 89 ++++++++---- lisp/mastodon-toot.el | 11 +- 3 files changed, 251 insertions(+), 219 deletions(-) diff --git a/lisp/mastodon-iso.el b/lisp/mastodon-iso.el index 8baff3c..341593c 100644 --- a/lisp/mastodon-iso.el +++ b/lisp/mastodon-iso.el @@ -33,191 +33,191 @@ ;; https://github.com/Shinmera/language-codes/blob/master/data/iso-639-3.lisp (defvar mastodon-iso-639-1 - '(("ab" "Abkhazian") - ("aa" "Afar") - ("af" "Afrikaans") - ("ak" "Akan") - ("sq" "Albanian") - ("am" "Amharic") - ("ar" "Arabic") - ("an" "Aragonese") - ("hy" "Armenian") - ("as" "Assamese") - ("av" "Avaric") - ("ae" "Avestan") - ("ay" "Aymara") - ("az" "Azerbaijani") - ("bm" "Bambara") - ("ba" "Bashkir") - ("eu" "Basque") - ("be" "Belarusian") - ("bn" "Bengali") - ("bh" "Bihari languages") - ("bi" "Bislama") - ("bs" "Bosnian") - ("br" "Breton") - ("bg" "Bulgarian") - ("my" "Burmese") - ("km" "Central Khmer") - ("ch" "Chamorro") - ("ce" "Chechen") - ("zh" "Chinese") - ("cv" "Chuvash") - ("kw" "Cornish") - ("co" "Corsican") - ("cr" "Cree") - ("hr" "Croatian") - ("cs" "Czech") - ("da" "Danish") - ("dz" "Dzongkha") - ("en" "English") - ("eo" "Esperanto") - ("et" "Estonian") - ("ee" "Ewe") - ("fo" "Faroese") - ("fj" "Fijian") - ("fi" "Finnish") - ("nl" "Dutch" "Flemish") - ("fr" "French") - ("ff" "Fulah") - ("gl" "Galician") - ("lg" "Ganda") - ("ka" "Georgian") - ("de" "German") - ("el" "Greek") - ("gn" "Guarani") - ("gu" "Gujarati") - ("ht" "Haitian" "Haitian Creole") - ("ha" "Hausa") - ("he" "Hebrew") - ("hz" "Herero") - ("hi" "Hindi") - ("ho" "Hiri Motu") - ("hu" "Hungarian") - ("is" "Icelandic") - ("io" "Ido") - ("ig" "Igbo") - ("id" "Indonesian") - ("ia" "Interlingua" "Interlingua (International Auxiliary Language Association)") - ("iu" "Inuktitut") - ("ik" "Inupiaq") - ("ga" "Irish") - ("it" "Italian") - ("ja" "Japanese") - ("jp" "Japanese") - ("jv" "Javanese") - ("kl" "Kalaallisut" "Greenlandic") - ("kn" "Kannada") - ("kr" "Kanuri") - ("ks" "Kashmiri") - ("kk" "Kazakh") - ("ki" "Kikuyu" "Gikuyu") - ("rw" "Kinyarwanda") - ("kv" "Komi") - ("kg" "Kongo") - ("ko" "Korean") - ("ku" "Kurdish") - ("kj" "Kuanyama" "Kwanyama") - ("ky" "Kirghiz" "Kyrgyz") - ("lo" "Lao") - ("la" "Latin") - ("lv" "Latvian") - ("li" "Limburgan" "Limburger" "Limburgish") - ("ln" "Lingala") - ("lt" "Lithuanian") - ("lu" "Luba-Katanga") - ("lb" "Luxembourgish" "Letzeburgesch") - ("mk" "Macedonian") - ("mg" "Malagasy") - ("ms" "Malay") - ("ml" "Malayalam") - ("dv" "Divehi" "Dhivehi" "Maldivian") - ("mt" "Maltese") - ("gv" "Manx") - ("mi" "Maori") - ("mr" "Marathi") - ("mh" "Marshallese") - ("mn" "Mongolian") - ("na" "Nauru") - ("nv" "Navajo" "Navaho") - ("ng" "Ndonga") - ("ne" "Nepali") - ("nd" "Ndebele, North" "North Ndebele") - ("se" "Northern Sami") - ("no" "Norwegian") - ("nb" "Bokmål, Norwegian" "Norwegian Bokmål") - ("ny" "Chichewa" "Chewa" "Nyanja") - ("nn" "Norwegian Nynorsk" "Nynorsk, Norwegian") - ("ie" "Interlingue" "Occidental") - ("oc" "Occitan") - ("oj" "Ojibwa") - ("cu" "Church Slavic" "Old Slavonic" "Church Slavonic" "Old Bulgarian" "Old Church Slavonic") - ("or" "Oriya") - ("om" "Oromo") - ("os" "Ossetian" "Ossetic") - ("pi" "Pali") - ("fa" "Persian") - ("pl" "Polish") - ("pt" "Portuguese") - ("pa" "Panjabi" "Punjabi") - ("ps" "Pushto" "Pashto") - ("qu" "Quechua") - ("ro" "Romanian" "Moldavian" "Moldovan") - ("rm" "Romansh") - ("rn" "Rundi") - ("ru" "Russian") - ("sm" "Samoan") - ("sg" "Sango") - ("sa" "Sanskrit") - ("sc" "Sardinian") - ("gd" "Gaelic" "Scottish Gaelic") - ("sr" "Serbian") - ("sn" "Shona") - ("ii" "Sichuan Yi" "Nuosu") - ("sd" "Sindhi") - ("si" "Sinhala" "Sinhalese") - ("sk" "Slovak") - ("sl" "Slovenian") - ("so" "Somali") - ("st" "Sotho, Southern") - ("nr" "Ndebele, South" "South Ndebele") - ("es" "Spanish" "Castilian") - ("su" "Sundanese") - ("sw" "Swahili") - ("ss" "Swati") - ("sv" "Swedish") - ("tl" "Tagalog") - ("ty" "Tahitian") - ("tg" "Tajik") - ("ta" "Tamil") - ("tt" "Tatar") - ("te" "Telugu") - ("th" "Thai") - ("bo" "Tibetan") - ("ti" "Tigrinya") - ("to" "Tonga (Tonga Islands)") - ("ts" "Tsonga") - ("tn" "Tswana") - ("tr" "Turkish") - ("tk" "Turkmen") - ("tw" "Twi") - ("uk" "Ukrainian") - ("ur" "Urdu") - ("ug" "Uighur" "Uyghur") - ("uz" "Uzbek") - ("ca" "Catalan" "Valencian") - ("ve" "Venda") - ("vi" "Vietnamese") - ("vo" "Volapük") - ("wa" "Walloon") - ("cy" "Welsh") - ("fy" "Western Frisian") - ("wo" "Wolof") - ("xh" "Xhosa") - ("yi" "Yiddish") - ("yo" "Yoruba") - ("za" "Zhuang" "Chuang") - ("zu" "Zulu"))) + '(("Abkhazian" . "ab") + ("Afar" . "aa") + ("Afrikaans" . "af") + ("Akan" . "ak") + ("Albanian" . "sq") + ("Amharic" . "am") + ("Arabic" . "ar") + ("Aragonese" . "an") + ("Armenian" . "hy") + ("Assamese" . "as") + ("Avaric" . "av") + ("Avestan" . "ae") + ("Aymara" . "ay") + ("Azerbaijani" . "az") + ("Bambara" . "bm") + ("Bashkir" . "ba") + ("Basque" . "eu") + ("Belarusian" . "be") + ("Bengali" . "bn") + ("Bihari languages" . "bh") + ("Bislama" . "bi") + ("Bosnian" . "bs") + ("Breton" . "br") + ("Bulgarian" . "bg") + ("Burmese" . "my") + ("Central Khmer" . "km") + ("Chamorro" . "ch") + ("Chechen" . "ce") + ("Chinese" . "zh") + ("Chuvash" . "cv") + ("Cornish" . "kw") + ("Corsican" . "co") + ("Cree" . "cr") + ("Croatian" . "hr") + ("Czech" . "cs") + ("Danish" . "da") + ("Dzongkha" . "dz") + ("English" . "en") + ("Esperanto" . "eo") + ("Estonian" . "et") + ("Ewe" . "ee") + ("Faroese" . "fo") + ("Fijian" . "fj") + ("Finnish" . "fi") + ("Dutch" . "nl") + ("French" . "fr") + ("Fulah" . "ff") + ("Galician" . "gl") + ("Ganda" . "lg") + ("Georgian" . "ka") + ("German" . "de") + ("Greek" . "el") + ("Guarani" . "gn") + ("Gujarati" . "gu") + ("Haitian" . "ht") + ("Hausa" . "ha") + ("Hebrew" . "he") + ("Herero" . "hz") + ("Hindi" . "hi") + ("Hiri Motu" . "ho") + ("Hungarian" . "hu") + ("Icelandic" . "is") + ("Ido" . "io") + ("Igbo" . "ig") + ("Indonesian" . "id") + ("Interlingua" . "ia") + ("Inuktitut" . "iu") + ("Inupiaq" . "ik") + ("Irish" . "ga") + ("Italian" . "it") + ("Japanese" . "ja") + ("Japanese" . "jp") + ("Javanese" . "jv") + ("Kalaallisut" . "kl") + ("Kannada" . "kn") + ("Kanuri" . "kr") + ("Kashmiri" . "ks") + ("Kazakh" . "kk") + ("Kikuyu" . "ki") + ("Kinyarwanda" . "rw") + ("Komi" . "kv") + ("Kongo" . "kg") + ("Korean" . "ko") + ("Kurdish" . "ku") + ("Kuanyama" . "kj") + ("Kirghiz" . "ky") + ("Lao" . "lo") + ("Latin" . "la") + ("Latvian" . "lv") + ("Limburgan" . "li") + ("Lingala" . "ln") + ("Lithuanian" . "lt") + ("Luba-Katanga" . "lu") + ("Luxembourgish" . "lb") + ("Macedonian" . "mk") + ("Malagasy" . "mg") + ("Malay" . "ms") + ("Malayalam" . "ml") + ("Divehi" . "dv") + ("Maltese" . "mt") + ("Manx" . "gv") + ("Maori" . "mi") + ("Marathi" . "mr") + ("Marshallese" . "mh") + ("Mongolian" . "mn") + ("Nauru" . "na") + ("Navajo" . "nv") + ("Ndonga" . "ng") + ("Nepali" . "ne") + ("Ndebele, North" . "nd") + ("Northern Sami" . "se") + ("Norwegian" . "no") + ("Bokmål, Norwegian" . "nb") + ("Chichewa" . "ny") + ("Norwegian Nynorsk" . "nn") + ("Interlingue" . "ie") + ("Occitan" . "oc") + ("Ojibwa" . "oj") + ("Church Slavic" . "cu") + ("Oriya" . "or") + ("Oromo" . "om") + ("Ossetian" . "os") + ("Pali" . "pi") + ("Persian" . "fa") + ("Polish" . "pl") + ("Portuguese" . "pt") + ("Panjabi" . "pa") + ("Pushto" . "ps") + ("Quechua" . "qu") + ("Romanian" . "ro") + ("Romansh" . "rm") + ("Rundi" . "rn") + ("Russian" . "ru") + ("Samoan" . "sm") + ("Sango" . "sg") + ("Sanskrit" . "sa") + ("Sardinian" . "sc") + ("Gaelic" . "gd") + ("Serbian" . "sr") + ("Shona" . "sn") + ("Sichuan Yi" . "ii") + ("Sindhi" . "sd") + ("Sinhala" . "si") + ("Slovak" . "sk") + ("Slovenian" . "sl") + ("Somali" . "so") + ("Sotho, Southern" . "st") + ("Ndebele, South" . "nr") + ("Spanish" . "es") + ("Sundanese" . "su") + ("Swahili" . "sw") + ("Swati" . "ss") + ("Swedish" . "sv") + ("Tagalog" . "tl") + ("Tahitian" . "ty") + ("Tajik" . "tg") + ("Tamil" . "ta") + ("Tatar" . "tt") + ("Telugu" . "te") + ("Thai" . "th") + ("Tibetan" . "bo") + ("Tigrinya" . "ti") + ("Tonga (Tonga Islands)" . "to") + ("Tsonga" . "ts") + ("Tswana" . "tn") + ("Turkish" . "tr") + ("Turkmen" . "tk") + ("Twi" . "tw") + ("Ukrainian" . "uk") + ("Urdu" . "ur") + ("Uighur" . "ug") + ("Uzbek" . "uz") + ("Catalan" . "ca") + ("Venda" . "ve") + ("Vietnamese" . "vi") + ("Volapük" . "vo") + ("Walloon" . "wa") + ("Welsh" . "cy") + ("Western Frisian" . "fy") + ("Wolof" . "wo") + ("Xhosa" . "xh") + ("Yiddish" . "yi") + ("Yoruba" . "yo") + ("Zhuang" . "za") + ("Zulu" . "zu"))) ;; web UI doesn't respect these for now (defvar mastodon-iso-639-regional diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1a726c4..dd3ce1b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -36,6 +36,7 @@ (require 'thingatpt) ; for word-at-point (require 'time-date) (require 'cl-lib) +(require 'mastodon-iso) (require 'mpv nil :no-error) @@ -2079,16 +2080,18 @@ IND is the optional indentation level to print at." ;;; FOLLOW/BLOCK/MUTE, ETC -(defun mastodon-tl--follow-user (user-handle &optional notify) +(defun mastodon-tl--follow-user (user-handle &optional notify langs) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. If NOTIFY is \"false\", disable notifications when that user posts. -Can be called to toggle NOTIFY on users already being followed." +Can be called to toggle NOTIFY on users already being followed. +LANGS is an array parameters alist of languages to filer user's posts by." (interactive (list (mastodon-tl--interactive-user-handles-get "follow"))) (mastodon-tl--do-if-toot - (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify))) + (mastodon-tl--do-user-action-and-response + user-handle "follow" nil notify langs))) (defun mastodon-tl--enable-notify-user-posts (user-handle) "Query for USER-HANDLE and enable notifications when they post." @@ -2105,6 +2108,31 @@ Can be called to toggle NOTIFY on users already being followed." (mastodon-tl--interactive-user-handles-get "disable"))) (mastodon-tl--follow-user user-handle "false")) +(defun mastodon-tl--filter-user-user-posts-by-language (user-handle) + "Query for USER-HANDLE and enable notifications when they post." + (interactive + (list + (mastodon-tl--interactive-user-handles-get "filter by language"))) + (let ((langs (mastodon-tl--read-filter-langs))) + (mastodon-tl--do-if-toot + (mastodon-tl--follow-user user-handle nil langs)))) + +(defun mastodon-tl--read-filter-langs (&optional langs) + "Read language choices and return an alist array parameter. +LANGS is the accumulated array param alist if we re-run recursively." + (let* ((langs-alist langs) + (choice (completing-read "Filter user's posts by language: " + mastodon-iso-639-1))) + (when choice + (setq langs-alist + (push `("languages[]" . ,(alist-get choice mastodon-iso-639-1 + nil nil + #'string=)) + langs-alist)) + (if (y-or-n-p "Filter by another language? ") + (mastodon-tl--read-filter-langs langs-alist) + langs-alist)))) + (defun mastodon-tl--unfollow-user (user-handle) "Query for USER-HANDLE from current status and unfollow that user." (interactive @@ -2197,12 +2225,13 @@ Action must be either \"unblock\" or \"unmute\"." nil ; predicate t)))) -(defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp notify) +(defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp notify langs) "Do ACTION on user USER-HANDLE. NEGP is whether the action involves un-doing something. If NOTIFY is \"true\", enable notifications when that user posts. If NOTIFY is \"false\", disable notifications when that user posts. -NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." +NOTIFY is only non-nil when called by `mastodon-tl--follow-user'. +LANGS is an array parameters alist of languages to filer user's posts by." (let* ((account (if negp ;; if unmuting/unblocking, we got handle from mute/block list (mastodon-profile--search-account-by-handle @@ -2218,35 +2247,41 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." (name (if (not (string-empty-p (mastodon-profile--account-field account 'display_name))) (mastodon-profile--account-field account 'display_name) (mastodon-profile--account-field account 'username))) - (url (mastodon-http--api - (if notify - (format "accounts/%s/%s?notify=%s" user-id action notify) - (format "accounts/%s/%s" user-id action))))) + (args (cond (notify + `(("notify" . ,notify))) + (langs langs) + (t nil))) + (url (mastodon-http--api (format "accounts/%s/%s" user-id action)))) (if account (if (equal action "follow") ; y-or-n for all but follow - (mastodon-tl--do-user-action-function url name user-handle action notify) + (mastodon-tl--do-user-action-function url name user-handle action notify args) (when (y-or-n-p (format "%s user %s? " action name)) - (mastodon-tl--do-user-action-function url name user-handle action))) + (mastodon-tl--do-user-action-function url name user-handle action args))) (message "Cannot find a user with handle %S" user-handle)))) -(defun mastodon-tl--do-user-action-function (url name user-handle action &optional notify) +(defun mastodon-tl--do-user-action-function (url name user-handle action &optional notify args) "Post ACTION on user NAME/USER-HANDLE to URL. NOTIFY is either \"true\" or \"false\", and used when we have been called -by `mastodon-tl--follow-user' to enable or disable notifications." - (let ((response (mastodon-http--post url))) - (mastodon-http--triage response - (lambda () - (cond ((string-equal notify "true") - (message "Receiving notifications for user %s (@%s)!" - name user-handle)) - ((string-equal notify "false") - (message "Not receiving notifications for user %s (@%s)!" - name user-handle)) - ((or (string-equal action "mute") - (string-equal action "unmute")) - (message "User %s (@%s) %sd!" name user-handle action)) - ((eq notify nil) - (message "User %s (@%s) %sed!" name user-handle action))))))) +by `mastodon-tl--follow-user' to enable or disable notifications. +ARGS is an alist of any parameters to send with the request." + (let ((response (mastodon-http--post url args))) + (mastodon-http--triage + response + (lambda () + (cond ((string-equal notify "true") + (message "Receiving notifications for user %s (@%s)!" + name user-handle)) + ((string-equal notify "false") + (message "Not receiving notifications for user %s (@%s)!" + name user-handle)) + ((or (string-equal action "mute") + (string-equal action "unmute")) + (message "User %s (@%s) %sd!" name user-handle action)) + ((assoc "languages[]" args #'equal) + (message "User %s filtered by language(s): %s" name + (mapconcat #'cdr args " "))) + ((eq notify nil) + (message "User %s (@%s) %sed!" name user-handle action))))))) ;; FOLLOW TAGS diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 59a3813..21bfe96 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1117,14 +1117,11 @@ LENGTH is the maximum character length allowed for a poll option." (defun mastodon-toot--set-toot-lang () "Prompt for a language and return its two letter ISO 639 1 code." (interactive) - (let* ((langs (mapcar (lambda (x) - (cons (cadr x) - (car x))) - mastodon-iso-639-1)) - (choice (completing-read "Language for this toot: " - langs))) + (let* ((choice (completing-read "Language for this toot: " + mastodon-iso-639-1))) (setq mastodon-toot--language - (alist-get choice langs nil nil 'equal)))) + (alist-get choice mastodon-iso-639-1 nil nil 'equal)) + (message "Language set to %s" choice))) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings -- cgit v1.2.3 From 91836e01b1598923c7a6a8e17fba74ff92d2587e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 23:48:01 +0100 Subject: toot--set-toot-lang docstring --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 59a3813..27e7ce5 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1115,7 +1115,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* ((langs (mapcar (lambda (x) (cons (cadr x) -- cgit v1.2.3 From 0c889fd275b8338aed5f173f0a7df78e23801b92 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 09:34:20 +0100 Subject: paginate profile view followers/following with link header --- lisp/mastodon-profile.el | 36 ++++++++++++++++++++++++++---------- lisp/mastodon-tl.el | 23 +++++++++++++++-------- 2 files changed, 41 insertions(+), 18 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 3ba00b9..658b1d4 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -71,6 +71,9 @@ (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") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) @@ -186,7 +189,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 +201,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 () @@ -552,16 +559,25 @@ 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 +601,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")) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1a726c4..a87cd73 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -136,10 +136,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 @@ -2327,11 +2323,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))) @@ -2532,7 +2539,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 @@ -2545,8 +2552,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))) -- cgit v1.2.3 From 55c91270734da9e6a11060b3bea7aad152d40680 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 10:09:39 +0100 Subject: readme fill paras --- README.org | 62 ++++++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 42 insertions(+), 20 deletions(-) diff --git a/README.org b/README.org index 10627ff..b02db2a 100644 --- a/README.org +++ b/README.org @@ -6,7 +6,8 @@ * README -=mastodon.el= is an Emacs client for the AcitivityPub social networks that implement the Mastodon API. For info see https://joinmastodon.org/. +=mastodon.el= is an Emacs client for the AcitivityPub social networks that +implement the Mastodon API. For info see https://joinmastodon.org/. ** Installation @@ -25,7 +26,8 @@ Or, with =use-package=: :ensure t) #+END_SRC -The minimum Emacs version is now 27.1. But if you are running an older version it shouldn't be very hard to get it working. +The minimum Emacs version is now 27.1. But if you are running an older version +it shouldn't be very hard to get it working. *** MELPA @@ -100,10 +102,10 @@ restart Emacs and follow the steps again. =M-x mastodon= -Opens a =*mastodon-home*= buffer in the major mode and displays toots. If your credentials are not yet saved, you -will be prompted for email and password. The app registration process will -take place if your =mastodon-token-file= does not contain =:client_id= and -=:client_secret=. +Opens a =*mastodon-home*= buffer in the major mode and displays toots. If your +credentials are not yet saved, you will be prompted for email and password. +The app registration process will take place if your =mastodon-token-file= does +not contain =:client_id= and =:client_secret=. **** Keybindings @@ -225,15 +227,19 @@ You can download and use your instance's custom emoji *** Other commands and account settings: -In addition to =mastodon=, the following functions are autoloaded and should work without first loading =mastodon.el=: +In addition to =mastodon=, the following functions are autoloaded and should +work without first loading =mastodon.el=: - =mastodon-toot=: Compose new toot - =mastodon-notifications-get=: View all notifications -- =mastodon-url-lookup=: Attempt to load a URL in =mastodon.el=. URL may be at point or provided in the minibuffer. +- =mastodon-url-lookup=: Attempt to load a URL in =mastodon.el=. URL may be at + point or provided in the minibuffer. -- =mastodon-tl--view-instance-description=: View information about the instance that the author of the toot at point is on. +- =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-search--trending-tags=: View a list of trending hashtags on your + instance. - =mastodon-tl--follow-tag=: Follow a tag (works like following a user) @@ -241,14 +247,21 @@ In addition to =mastodon=, the following functions are autoloaded and should wor - =mastodon-tl--list-followed-tags=: View a list of tags you're following. -- =mastodon-profile--update-display-name=: Update the display name for your account. +- =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--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 @@ -319,7 +332,9 @@ Optional dependencies: =mastodon.el= should work with ActivityPub servers that implement the Mastodon API. -Apart from Mastodon itself, it is currently known to work with Pleroma and Gotosocial. If you attempt to use =mastodon.el= with another server that implements the Mastodon API and run into problems, feel free to open an issue. +Apart from Mastodon itself, it is currently known to work with Pleroma and +Gotosocial. If you attempt to use =mastodon.el= with another server that +implements the Mastodon API and run into problems, feel free to open an issue. ** Contributing @@ -329,8 +344,12 @@ PRs, issues, feature requests, and general feedback are very welcome! 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. -3. If you run into something that seems broken, first try running =mastodon.el= in emacs with no init file (i.e. =emacs -q= (instructions and code for doing this are [[https://codeberg.org/martianh/mastodon.el/issues/300][here]]) to see if it also happens independently of your own config (it probably does). -4. Enable debug on error (=toggle-debug-on-error=), make the bug happen again, and copy the backtrace that appears. +3. If you run into something that seems broken, first try running =mastodon.el= + in emacs with no init file (i.e. =emacs -q= (instructions and code for doing + this are [[https://codeberg.org/martianh/mastodon.el/issues/300][here]]) to see if it also happens independently of your own config + (it probably does). +4. Enable debug on error (=toggle-debug-on-error=), make the bug happen again, + and copy the backtrace that appears. 5. Open an issue here and explain what is going on. *** Features @@ -349,7 +368,10 @@ PRs, issues, feature requests, and general feedback are very welcome! ** Supporting mastodon.el -If you'd like to support continued development of =mastodon.el=, I accept donations via paypal at martianhiatus [ at ] riseup [ dot ] net. If you would prefer a different payment method, write to me at that address and I can provide IBAN or other details. +If you'd like to support continued development of =mastodon.el=, I accept +donations via paypal at martianhiatus [ at ] riseup [ dot ] net. If you would +prefer a different payment method, write to me at that address and I can +provide IBAN or other details. I don't have a tech worker's income, so even a small tip would help out. -- cgit v1.2.3 From 14b7547c385648565eba8a4bac3dc8afa5ebf978 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 10:44:45 +0100 Subject: use homegrown icons in tl--symbols list --- lisp/mastodon-tl.el | 44 +++++++++++++++++--------------------------- 1 file changed, 17 insertions(+), 27 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1a26a54..7477b25 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -106,30 +106,22 @@ width fonts when rendering HTML text")) :group 'mastodon-tl :type '(boolean :tag "Whether to display user avatars in timelines")) -;; Various symbols using throughout timeline -;; Default comes from nerd-font (www.nerdfonts.com) -(defcustom mastodon-tl-symbols - '(;; See https://icon-sets.iconify.design/octicon/comment-24/ - (reply . ("" . "R")) - ;; See https://icon-sets.iconify.design/octicon/reply-24/ - (boost . ("" . "B")) - ;; See https://icon-sets.iconify.design/octicon/star-fill-24/ - (favourite . ("" . "F")) - ;; See https://icon-sets.iconify.design/octicon/bookmark-24/ - (bookmark . ("" . "K")) - ;; See https://icon-sets.iconify.design/octicon/file-media-24/ - (media . ("" . "M")) - ;; See https://icon-sets.iconify.design/octicon/verified-24/ - (verified . ("" . "V")) - ;; See https://icon-sets.iconify.design/octicon/person-fill-24/ - (private . ("" . "P")) - ;; See https://icon-sets.iconify.design/octicon/location-24/ - (direct . ("" . "D"))) - "Set of symbols (or strings) to be used in timeline. If a symbol does not look right (tofu), it means your font settings do not support it." +(defcustom mastodon-tl--symbols + '((reply . ("💬" . "R")) + (boost . ("🔁" . "B")) + (favourite . ("⭐" . "F")) + (bookmark . ("🔖" . "K")) + (media . ("" . "M")) + (verified . ("" . "V")) + (private . ("🔒" . "P")) + (direct . ("✉" . "D")) + (edited . ("✍" . "E"))) + "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. @@ -226,14 +218,12 @@ 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)) + (if-let* ((symbol (alist-get name mastodon-tl--symbols))) + (if (char-displayable-p (string-to-char (car symbol))) + (car symbol) + (cdr symbol)) "?")) -- cgit v1.2.3 From 8448f28c129662625e5c4beb98592fb9ef06032a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 10:58:14 +0100 Subject: cleanup --symbols, autoload --- lisp/mastodon-profile.el | 5 ++--- lisp/mastodon-tl.el | 38 +++++++------------------------------- 2 files changed, 9 insertions(+), 34 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 658b1d4..c275e5c 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -74,6 +74,7 @@ (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) @@ -628,9 +629,7 @@ HEADERS means also fetch link headers for pagination." (propertize (concat "@" acct) 'face 'default) (if (equal locked t) - (if (fontp (char-displayable-p #10r9993)) - " 🔒" - " [locked]") + (mastodon-tl--symbol 'locked) "") "\n ------------\n" ;; profile note: diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1a5fc33..8c9e00a 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -129,9 +129,10 @@ nil." (bookmark . ("🔖" . "K")) (media . ("" . "M")) (verified . ("" . "V")) - (private . ("🔒" . "P")) - (direct . ("✉" . "D")) - (edited . ("✍" . "E"))) + (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." @@ -629,7 +630,6 @@ this just means displaying toot client." (faved (equal 't (mastodon-tl--field 'favourited toot))) (boosted (equal 't (mastodon-tl--field 'reblogged toot))) (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot))) - (bookmark-str (mastodon-tl--symbol 'bookmark)) (visibility (mastodon-tl--field 'visibility toot)) (account (alist-get 'account toot)) (avatar-url (alist-get 'avatar account)) @@ -645,13 +645,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 @@ -718,30 +718,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 -- cgit v1.2.3 From e463727b4b77ac8cae8c3c3b0d41dd25eab15a85 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 11:04:13 +0100 Subject: fix byline-favourited and byline-boosted tests --- test/mastodon-tl-tests.el | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index a80c3ee..4286975 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -348,14 +348,15 @@ Strict-Transport-Security: max-age=31536000 (toot (cons '(reblogged . t) mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (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 - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (mastodon-tl--symbol 'boost) => "B") + (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 + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -365,14 +366,15 @@ Strict-Transport-Security: max-age=31536000 (toot (cons '(favourited . t) mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (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 - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (mastodon-tl--symbol 'favourite) => "F") + (mock (date-to-time timestamp) => '(22782 21551)) + (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 + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) -- cgit v1.2.3 From 5d5d4078f3f307e3fd5f020cbee53e9a3f9197c1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 11:14:16 +0100 Subject: hack to fix other byline tests --- test/mastodon-tl-tests.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 4286975..d32863b 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -386,13 +386,17 @@ Strict-Transport-Security: max-age=31536000 (timestamp (cdr (assoc 'created_at toot)))) (with-mock (mock (date-to-time timestamp) => '(22782 21551)) + ;; FIXME this mock refuses to recognise our different args + ;; (mock (mastodon-tl--symbol 'favourite) => "F") + ;; (mock (mastodon-tl--symbol 'boost) => "B") + (mock (mastodon-tl--symbol *) => "?") (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 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) - "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + "(?) (?) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -466,6 +470,10 @@ Strict-Transport-Security: max-age=31536000 ;; We don't expect to use the toot's timestamp but the timestamp of the ;; reblogged toot: (mock (date-to-time timestamp) => '(1 2)) + ;; FIXME this mock refuses to recognise our different args + ;; (mock (mastodon-tl--symbol 'favourite) => "F") + ;; (mock (mastodon-tl--symbol 'boost) => "B") + (mock (mastodon-tl--symbol *) => "?") (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") (mock (date-to-time original-timestamp) => '(3 4)) (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") @@ -474,7 +482,7 @@ Strict-Transport-Security: max-age=31536000 (mastodon-tl--byline toot 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) - "(B) (F) Account 42 (@acct42@example.space) + "(?) (?) Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ "))))) -- cgit v1.2.3 From 217af69c12d4472d308e2aec6cdd78045d70d97b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 11:22:10 +0100 Subject: symbols: preceding space for locked accounts, private/direct toots --- lisp/mastodon-profile.el | 2 +- lisp/mastodon-tl.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index c275e5c..54f0e84 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -629,7 +629,7 @@ HEADERS means also fetch link headers for pagination." (propertize (concat "@" acct) 'face 'default) (if (equal locked t) - (mastodon-tl--symbol 'locked) + (concat " " (mastodon-tl--symbol 'locked)) "") "\n ------------\n" ;; profile note: diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8c9e00a..aa34c2e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -667,9 +667,9 @@ this just means displaying toot client." (funcall author-byline toot) ;; visibility: (cond ((equal visibility "direct") - (mastodon-tl--symbol 'direct)) + (concat " " (mastodon-tl--symbol 'direct))) ((equal visibility "private") - (mastodon-tl--symbol 'private))) + (concat " " (mastodon-tl--symbol 'private)))) (funcall action-byline toot) " " ;; TODO: Once we have a view for toot (responses etc.) make -- cgit v1.2.3 From 0bee7050dd608c33b599434e17ce9229ce8ea3a0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 11:31:20 +0100 Subject: always use mastodon-tl--symbol --- lisp/mastodon-tl.el | 6 +++--- lisp/mastodon-toot.el | 38 ++++++++++++++++++-------------------- 2 files changed, 21 insertions(+), 23 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index aa34c2e..fc3dc2e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -697,9 +697,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) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 27e7ce5..c99f088 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 -- cgit v1.2.3 From 8ee5b29c10a128b8268ddac82c96154d9b0208c1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 11:52:25 +0100 Subject: tl--symbol -- add media icon --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index fc3dc2e..ce2062d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -127,7 +127,7 @@ nil." (boost . ("🔁" . "B")) (favourite . ("⭐" . "F")) (bookmark . ("🔖" . "K")) - (media . ("" . "M")) + (media . ("📹" . "[media]")) (verified . ("" . "V")) (locked . ("🔒" . "[locked]")) (private . ("🔒" . "[followers]")) -- cgit v1.2.3 From ae8f6c6d7dfdd8048c8bab21b3afd81f981fbc96 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 14:51:45 +0100 Subject: always use --set-buffer-spec, not setq --buffer-spec --- lisp/mastodon-async.el | 13 +++++-------- lisp/mastodon-search.el | 19 ++++++++----------- 2 files changed, 13 insertions(+), 19 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-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" -- cgit v1.2.3 From c6281d6579cdcae5d2e1200a35b4f09a4406496e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 15:08:32 +0100 Subject: remove --view-author-profile, replace with --get-toot-author --- lisp/mastodon-profile.el | 8 -------- lisp/mastodon-tl.el | 2 +- 2 files changed, 1 insertion(+), 9 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 54f0e84..91103f1 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -737,14 +737,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-tl.el b/lisp/mastodon-tl.el index ce2062d..dccf36a 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -254,7 +254,7 @@ 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 "") 'mastodon-tl--mpv-play-video-from-byline) - (define-key map (kbd "") 'mastodon-profile--view-author-profile) + (define-key map (kbd "") '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.'") -- cgit v1.2.3 From 8c3f5435b977c04edbe86015ecdf7f9ba181e80e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 15:20:02 +0100 Subject: --set-buffer-spec everywhere(?) and include handle/instance url set buffer spec in view instances description --- lisp/mastodon-profile.el | 9 ++++++++- lisp/mastodon-tl.el | 13 +++++++++---- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 91103f1..6dbe572 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -287,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)) @@ -295,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." @@ -497,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))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index dccf36a..b019272 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1368,10 +1368,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." @@ -1951,6 +1953,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) -- cgit v1.2.3 From 75896755e97a75523eb9e4a8aef3d30350c30299 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 15:31:38 +0100 Subject: no lambdas allowed in buffer-spec update-function! --- lisp/mastodon-profile.el | 1 - lisp/mastodon-tl.el | 4 ++-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 6dbe572..1200972 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -584,7 +584,6 @@ HEADERS means also fetch link headers for pagination." (link-header (when headers (mastodon-tl--get-link-header-from-response (cdr response)))) - (note (mastodon-profile--account-field account 'note)) (locked (mastodon-profile--account-field account 'locked)) (followers-count (mastodon-tl--as-string diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b019272..f02593c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1453,7 +1453,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)))))) @@ -1493,7 +1493,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)) -- cgit v1.2.3 From 2dee7f3fb663d2626fdbb028839c099a11932cba Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 16:16:57 +0100 Subject: fix do user fun test in tl --- test/mastodon-tl-tests.el | 90 +++++++++++++++++++++++------------------------ 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index a80c3ee..ee0f632 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -1050,53 +1050,53 @@ correct value for following, as well as notifications enabled or disabled." (let ((response-buffer-true (current-buffer))) (insert mastodon-tl--follow-notify-true-response) (with-mock - (mock (mastodon-http--post url-follow-only) - => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-follow-only - user-name - user-handle - "follow") - "User some-user (@some-user@instance.url) followed!")) - (mock (mastodon-http--post url-mute) - => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-mute - user-name - user-handle - "mute") - "User some-user (@some-user@instance.url) muted!")) - (mock (mastodon-http--post url-block) - => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-block - user-name - user-handle - "block") - "User some-user (@some-user@instance.url) blocked!"))) + (mock (mastodon-http--post url-follow-only nil) + => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-follow-only + user-name + user-handle + "follow") + "User some-user (@some-user@instance.url) followed!")) + (mock (mastodon-http--post url-mute nil) + => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-mute + user-name + user-handle + "mute") + "User some-user (@some-user@instance.url) muted!")) + (mock (mastodon-http--post url-block nil) + => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-block + user-name + user-handle + "block") + "User some-user (@some-user@instance.url) blocked!"))) (with-mock - (mock (mastodon-http--post url-true) => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-true - user-name - user-handle - "follow" - "true") - "Receiving notifications for user some-user (@some-user@instance.url)!"))))) + (mock (mastodon-http--post url-true nil) => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-true + user-name + user-handle + "follow" + "true") + "Receiving notifications for user some-user (@some-user@instance.url)!"))))) (with-temp-buffer (let ((response-buffer-false (current-buffer))) (insert mastodon-tl--follow-notify-false-response) (with-mock - (mock (mastodon-http--post url-false) => response-buffer-false) - (should - (equal - (mastodon-tl--do-user-action-function url-false - user-name - user-handle - "follow" - "false") - "Not receiving notifications for user some-user (@some-user@instance.url)!"))))))) + (mock (mastodon-http--post url-false nil) => response-buffer-false) + (should + (equal + (mastodon-tl--do-user-action-function url-false + user-name + user-handle + "follow" + "false") + "Not receiving notifications for user some-user (@some-user@instance.url)!"))))))) -- cgit v1.2.3 From fc003dced37165fdf36223461216304ae4d0b420 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 16:18:48 +0100 Subject: docstring --- lisp/mastodon-tl.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index dd3ce1b..3b9a8c6 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2109,7 +2109,9 @@ LANGS is an array parameters alist of languages to filer user's posts by." (mastodon-tl--follow-user user-handle "false")) (defun mastodon-tl--filter-user-user-posts-by-language (user-handle) - "Query for USER-HANDLE and enable notifications when they post." + "Query for USER-HANDLE and enable notifications when they post. +This feature is experimental and for now not easily varified by +the instance API." (interactive (list (mastodon-tl--interactive-user-handles-get "filter by language"))) -- cgit v1.2.3 From 1f4870555241fcc55f6f2c2e2f6f64993ec2c3ad Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 16:33:07 +0100 Subject: remove stray company funs in search.el --- lisp/mastodon-search.el | 14 +++----------- lisp/mastodon-toot.el | 3 +-- 2 files changed, 4 insertions(+), 13 deletions(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 4aa5721..1aed676 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -50,19 +50,13 @@ ;; functions for completion of mentions in mastodon-toot -(defun mastodon-search--get-user-info-@-capf (account) +(defun mastodon-search--get-user-info-@ (account) "Get user handle, display name and account URL from ACCOUNT." (list (concat "@" (cdr (assoc 'acct account))) (cdr (assoc 'url account)) (cdr (assoc 'display_name account)))) -(defun mastodon-search--get-user-info-@ (account) - "Get user handle, display name and account URL from ACCOUNT." - (list (cdr (assoc 'display_name account)) - (concat "@" (cdr (assoc 'acct account))) - (cdr (assoc 'url account)))) - -(defun mastodon-search--search-accounts-query (query &optional capf) +(defun mastodon-search--search-accounts-query (query) "Prompt for a search QUERY and return accounts synchronously. Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") @@ -70,9 +64,7 @@ Returns a nested list containing user handle, display name, and URL." (response (if (equal mastodon-toot--completion-style-for-mentions "following") (mastodon-http--get-json url `(("q" . ,query) ("following" . "true")) :silent) (mastodon-http--get-json url `(("q" . ,query)) :silent)))) - (if capf - (mapcar #'mastodon-search--get-user-info-@-capf response) - (mapcar #'mastodon-search--get-user-info-@ response)))) + (mapcar #'mastodon-search--get-user-info-@ response))) ;; functions for tags completion: diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 688717d..099ce10 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -853,8 +853,7 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." ;; just for the annotation-function? (setq mastodon-toot-completions (mastodon-search--search-accounts-query - (buffer-substring-no-properties start end) - :capf)))) + (buffer-substring-no-properties start end))))) :exclusive 'no :annotation-function (lambda (candidate) -- cgit v1.2.3