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-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') 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." -- 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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(-) (limited to 'lisp/mastodon-toot.el') 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(-) (limited to 'lisp/mastodon-toot.el') 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(-) (limited to 'lisp/mastodon-toot.el') 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(-) (limited to 'lisp/mastodon-toot.el') 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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(-) (limited to 'lisp/mastodon-toot.el') 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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 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(-) (limited to 'lisp/mastodon-toot.el') 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