From c4ffff95371c25937bc61c86e72011a69fa3c078 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 12 Sep 2022 19:20:59 +0200 Subject: update meta fields (broken) --- lisp/mastodon-profile.el | 36 +++++++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 38aceae..87e467c 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -404,10 +404,40 @@ This endpoint only holds a few preferences. For others, see their-id)))) (mastodon-http--get-json url))) -(defun mastodon-profile--fields-get (account) +(defun mastodon-profile-update-meta-fields () + "" + (interactive) + (let* ((fields-updated (mastodon-profile--update-meta-fields-alist)) + (fields-json (json-encode + (mapcar (lambda (x) + (list (cons 'name (car x)) + (cons 'value (cdr x)) + (cons 'verified_at nil))) + fields-updated)))) + (mastodon-profile--update-preference 'fields_attributes fields-json))) + +(defun mastodon-profile--update-meta-fields-alist () + "" + (let ((fields-old + (mastodon-profile--fields-get + nil + ;; we must fetch the plaintext version: + (mastodon-profile--get-source-pref 'fields))) + fields-new) + (dolist (f fields-old (reverse fields-new)) + (push + (cons (read-string "Edit account metadata key: " + (car f)) + (read-string "Edit account metadata value: " + (cdr f))) + fields-new)))) + +(defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. -Returns an alist." - (let ((fields (mastodon-profile--account-field account 'fields))) +Returns an alist. +FIELDS means provide a fields vector fetched by other means." + (let ((fields (or fields + (mastodon-profile--account-field account 'fields)))) (when fields (mapcar (lambda (el) (cons (alist-get 'name el) -- cgit v1.2.3 From f5697f658cd8cbd608da36acf5d24850966831b7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 12 Sep 2022 21:34:19 +0200 Subject: factor out http--build-query-string for use PATCH reqs also --- lisp/mastodon-http.el | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index a8b3650..f73fd6b 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -73,7 +73,7 @@ "Retrieve URL asynchronously. This is a thin abstraction over the system -`url-retrieve-synchronously`. Depending on which version of this +`url-retrieve-synchronously'. Depending on which version of this is available we will call it with or without a timeout." (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) @@ -108,6 +108,18 @@ 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." + ;; (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)) + "=" + (url-hexify-string (cdr arg)))) + args + "&")) + (defun mastodon-http--post (url args headers &optional unauthenticated-p) "POST synchronously to URL with ARGS and HEADERS. @@ -116,12 +128,7 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. "POST" (let ((url-request-data (when args - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cdr arg)))) - args - "&"))) + (mastodon-http--build-query-string args))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -216,7 +223,9 @@ Optionally specify the PARAMS to send." Optionally specify the PARAMS to send." (mastodon-http--authorized-request "PATCH" - (let ((url (mastodon-http--append-query-string base-url params))) + (let ((url + (concat base-url "?" + (mastodon-http--build-query-string params)))) (mastodon-http--url-retrieve-synchronously url)))) ;; Asynchronous functions @@ -245,12 +254,7 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (let ((request-timeout 5) (url-request-data (when args - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cdr arg)))) - args - "&")))) + (mastodon-http--build-query-string args)))) (with-temp-buffer (url-retrieve url callback cbargs))))) -- cgit v1.2.3 From e2fd67b16104ab772a4ef962613cb9f3cb3cea52 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 12 Sep 2022 21:35:34 +0200 Subject: remove unused --append-query-string --- lisp/mastodon-http.el | 7 ------- 1 file changed, 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index f73fd6b..f32ccd4 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -173,13 +173,6 @@ Pass response buffer to CALLBACK function." (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))) - ;; search functions: (defun mastodon-http--process-json-search () "Process JSON returned by a search query to the server." -- cgit v1.2.3 From f7603638933ee7bb9bc7d9065eab15d186c5ca3c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 12 Sep 2022 21:40:22 +0200 Subject: format profile preference params to match toot-send ones --- lisp/mastodon-profile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 87e467c..590f463 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -274,7 +274,7 @@ Both args are strings. SOURCE means that the preference is in the 'source' part of the account JSON." (let* ((url (mastodon-http--api "accounts/update_credentials")) (pref-formatted (if source (concat "source[" pref "]") pref)) - (response (mastodon-http--patch url `((,pref-formatted ,val))))) + (response (mastodon-http--patch url `((,pref-formatted . ,val))))) (mastodon-http--triage response (lambda () (mastodon-profile-fetch-server-account-settings) -- cgit v1.2.3 From 4bfe8b8696ae36e3331f6900101aed003185be90 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 29 Oct 2022 13:27:51 +0200 Subject: restore -toot--kill fun for use with draft toot functionality --- lisp/mastodon-toot.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a96bdbf..bcf9c83 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -465,12 +465,16 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." (mastodon-toot-set-cw toot-cw) (mastodon-toot--update-status-fields)))) -(defun mastodon-toot--kill () - "Kill `mastodon-toot-mode' buffer and window." - (with-current-buffer (get-buffer "*new toot*") - ;; FIXME: prevent some weird bug when cancelling a non-empty toot: - (delete #'mastodon-toot--save-toot-text after-change-functions) - (kill-buffer-and-window))) +(defun mastodon-toot--kill (&optional cancel) + "Kill `mastodon-toot-mode' buffer and window. +CANCEL means the toot was not sent, so we save the toot text as a draft." + (unless (eq mastodon-toot-current-toot-text nil) + (when cancel + (cl-pushnew mastodon-toot-current-toot-text + mastodon-toot-draft-toots-list :test 'equal))) + ;; prevent some weird bug when cancelling a non-empty toot: + (delete #'mastodon-toot-save-toot-text after-change-functions) + (kill-buffer-and-window)) (defun mastodon-toot--cancel () "Kill new-toot buffer/window. Does not POST content to Mastodon. -- cgit v1.2.3 From f6b983e04fe3ac091398dd74cdbf3a986b969b2a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 29 Oct 2022 16:32:24 +0200 Subject: working meta fields update --- lisp/mastodon-http.el | 6 ++++-- lisp/mastodon-profile.el | 46 ++++++++++++++++++++++++++++++++-------------- 2 files changed, 36 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index f32ccd4..0491927 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -211,14 +211,16 @@ Optionally specify the PARAMS to send." (with-current-buffer (mastodon-http--patch url params) (mastodon-http--process-json))) -(defun mastodon-http--patch (base-url &optional params) +(defun mastodon-http--patch (base-url &optional params no-build) "Make synchronous PATCH request to BASE-URL. Optionally specify the PARAMS to send." (mastodon-http--authorized-request "PATCH" (let ((url (concat base-url "?" - (mastodon-http--build-query-string params)))) + (if no-build + params + (mastodon-http--build-query-string params))))) (mastodon-http--url-retrieve-synchronously url)))) ;; Asynchronous functions diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 590f463..6ecabb2 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -404,25 +404,43 @@ This endpoint only holds a few preferences. For others, see their-id)))) (mastodon-http--get-json url))) -(defun mastodon-profile-update-meta-fields () +;; TODO: ideally we wd make a nice alist of all these params +(defun mastodon-profile--make-meta-fields-params (fields) + "" + (let ((count 0) + list) + (cl-loop for x in fields + for count from 0 to 4 + collect (concat + (format "fields_attributes[%s][name]" count) + "=" + (url-hexify-string (car x)) + "&" + (format "fields_attributes[%s][value]" count) + "=" + (url-hexify-string (cdr x)))))) + +(defun mastodon-profile-update-meta-fields (&optional data) "" (interactive) - (let* ((fields-updated (mastodon-profile--update-meta-fields-alist)) - (fields-json (json-encode - (mapcar (lambda (x) - (list (cons 'name (car x)) - (cons 'value (cdr x)) - (cons 'verified_at nil))) - fields-updated)))) - (mastodon-profile--update-preference 'fields_attributes fields-json))) + (let* ((url (mastodon-http--api "accounts/update_credentials")) + (fields-updated (or data(mastodon-profile--update-meta-fields-alist))) + (params (mastodon-profile--make-meta-fields-params fields-updated)) + (param-str (mapconcat #'identity params "&")) + (response (mastodon-http--patch url param-str :no-build))) + (setq test-fields-str param-str) + (mastodon-http--triage response + (lambda () + (mastodon-profile-fetch-server-account-settings) + (message "Account setting %s updated to %s!" + "metadata fields" params))))) (defun mastodon-profile--update-meta-fields-alist () "" - (let ((fields-old - (mastodon-profile--fields-get - nil - ;; we must fetch the plaintext version: - (mastodon-profile--get-source-pref 'fields))) + (let ((fields-old (mastodon-profile--fields-get + nil + ;; we must fetch the plaintext version: + (mastodon-profile--get-source-value 'fields))) fields-new) (dolist (f fields-old (reverse fields-new)) (push -- cgit v1.2.3 From 6458ec4e1ca4a5af9c065231884f67dc27264f10 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 29 Oct 2022 17:04:08 +0200 Subject: still prompt for empty fields, up to 4 display meta field number in prompt --- lisp/mastodon-profile.el | 95 +++++++++++++++++++++++++----------------------- 1 file changed, 49 insertions(+), 46 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 0b35fa4..6724038 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -365,6 +365,55 @@ Current settings are fetched from the server." (interactive) (mastodon-profile--edit-string-value 'display_name)) +;; TODO: ideally this would return an alist to use like normal params +(defun mastodon-profile--make-meta-fields-params (fields) + "Construct a parameter query string from metadata alist FIELDS." + (let ((count 0) + (loop-list (cl-loop for x in fields + for count from 0 to 4 + collect (concat + (format "fields_attributes[%s][name]" count) + "=" + (url-hexify-string (car x)) + "&" + (format "fields_attributes[%s][value]" count) + "=" + (url-hexify-string (cdr x)))))) + (mapconcat #'identity loop-list "&"))) + +(defun mastodon-profile-update-meta-fields () + "Prompt for new metadata fields information and PATCH the server." + (interactive) + (let* ((url (mastodon-http--api "accounts/update_credentials")) + (fields-updated (or data (mastodon-profile--update-meta-fields-alist))) + (param-str (mastodon-profile--make-meta-fields-params fields-updated)) + (response (mastodon-http--patch url param-str :no-build))) + (setq test-fields-str param-str) + (mastodon-http--triage response + (lambda () + (mastodon-profile-fetch-server-account-settings) + (message "Account setting %s updated to %s!" + "metadata fields" params))))) + +(defun mastodon-profile--update-meta-fields-alist () + "Prompt for new metadata fields information." + (let ((fields-old (mastodon-profile--fields-get + nil + ;; we must fetch the plaintext version: + (mastodon-profile--get-source-value 'fields))) + fields-new) + ;; offer empty fields if user currently has less than four filled: + (while (< (length fields-old) 4) + (setq fields-old + (append fields-old '(("" . ""))))) + (cl-loop for f in fields-old + for x from 1 to 5 + collect + (cons (read-string (format "Edit account metadata key [%s/4]: " x) + (car f)) + (read-string (format "Edit account metadata value [%s/4]: " x) + (cdr f)))))) + (defun mastodon-profile--get-preferences-pref (pref) "Fetch PREF from the endpoint \"/preferences\". This endpoint only holds a few preferences. For others, see @@ -404,52 +453,6 @@ This endpoint only holds a few preferences. For others, see their-id)))) (mastodon-http--get-json url))) -;; TODO: ideally we wd make a nice alist of all these params -(defun mastodon-profile--make-meta-fields-params (fields) - "" - (let ((count 0) - list) - (cl-loop for x in fields - for count from 0 to 4 - collect (concat - (format "fields_attributes[%s][name]" count) - "=" - (url-hexify-string (car x)) - "&" - (format "fields_attributes[%s][value]" count) - "=" - (url-hexify-string (cdr x)))))) - -(defun mastodon-profile-update-meta-fields (&optional data) - "" - (interactive) - (let* ((url (mastodon-http--api "accounts/update_credentials")) - (fields-updated (or data(mastodon-profile--update-meta-fields-alist))) - (params (mastodon-profile--make-meta-fields-params fields-updated)) - (param-str (mapconcat #'identity params "&")) - (response (mastodon-http--patch url param-str :no-build))) - (setq test-fields-str param-str) - (mastodon-http--triage response - (lambda () - (mastodon-profile-fetch-server-account-settings) - (message "Account setting %s updated to %s!" - "metadata fields" params))))) - -(defun mastodon-profile--update-meta-fields-alist () - "" - (let ((fields-old (mastodon-profile--fields-get - nil - ;; we must fetch the plaintext version: - (mastodon-profile--get-source-value 'fields))) - fields-new) - (dolist (f fields-old (reverse fields-new)) - (push - (cons (read-string "Edit account metadata key: " - (car f)) - (read-string "Edit account metadata value: " - (cdr f))) - fields-new)))) - (defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. Returns an alist. -- cgit v1.2.3 From 075f1f9ba41100a0fb3161598065a55bf09aaedd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 30 Oct 2022 11:13:44 +0100 Subject: re-write --make-meta-fields-params to build normal params alist --- lisp/mastodon-http.el | 6 ++---- lisp/mastodon-profile.el | 32 ++++++++++++++------------------ 2 files changed, 16 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 0491927..f32ccd4 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -211,16 +211,14 @@ Optionally specify the PARAMS to send." (with-current-buffer (mastodon-http--patch url params) (mastodon-http--process-json))) -(defun mastodon-http--patch (base-url &optional params no-build) +(defun mastodon-http--patch (base-url &optional params) "Make synchronous PATCH request to BASE-URL. Optionally specify the PARAMS to send." (mastodon-http--authorized-request "PATCH" (let ((url (concat base-url "?" - (if no-build - params - (mastodon-http--build-query-string params))))) + (mastodon-http--build-query-string params)))) (mastodon-http--url-retrieve-synchronously url)))) ;; Asynchronous functions diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 6724038..33c4181 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -365,35 +365,31 @@ Current settings are fetched from the server." (interactive) (mastodon-profile--edit-string-value 'display_name)) -;; TODO: ideally this would return an alist to use like normal params (defun mastodon-profile--make-meta-fields-params (fields) "Construct a parameter query string from metadata alist FIELDS." - (let ((count 0) - (loop-list (cl-loop for x in fields - for count from 0 to 4 - collect (concat - (format "fields_attributes[%s][name]" count) - "=" - (url-hexify-string (car x)) - "&" - (format "fields_attributes[%s][value]" count) - "=" - (url-hexify-string (cdr x)))))) - (mapconcat #'identity loop-list "&"))) + (let ((keys (cl-loop for count from 1 to 5 + collect (cons (format "fields_attributes[%s][name]" count) + (format "fields_attributes[%s][value]" count))))) + (cl-loop for a-pair in keys + for b-pair in fields + append (list (cons (car a-pair) + (car b-pair)) + (cons (cdr a-pair) + (cdr b-pair)))))) (defun mastodon-profile-update-meta-fields () "Prompt for new metadata fields information and PATCH the server." (interactive) (let* ((url (mastodon-http--api "accounts/update_credentials")) - (fields-updated (or data (mastodon-profile--update-meta-fields-alist))) - (param-str (mastodon-profile--make-meta-fields-params fields-updated)) - (response (mastodon-http--patch url param-str :no-build))) - (setq test-fields-str param-str) + (fields-updated (mastodon-profile--update-meta-fields-alist)) + (params (mastodon-profile--make-meta-fields-params fields-updated)) + (response (mastodon-http--patch url params))) + (setq test-fields-str params) (mastodon-http--triage response (lambda () (mastodon-profile-fetch-server-account-settings) (message "Account setting %s updated to %s!" - "metadata fields" params))))) + "metadata fields" fields-updated))))) (defun mastodon-profile--update-meta-fields-alist () "Prompt for new metadata fields information." -- cgit v1.2.3 From 31b42363969ac5fbcba444c59c32dd142054bbd9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 30 Oct 2022 11:53:19 +0100 Subject: docstrings --- lisp/mastodon-profile.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 33c4181..505dbc4 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -366,7 +366,8 @@ Current settings are fetched from the server." (mastodon-profile--edit-string-value 'display_name)) (defun mastodon-profile--make-meta-fields-params (fields) - "Construct a parameter query string from metadata alist FIELDS." + "Construct a parameter query string from metadata alist FIELDS. +Returns an alist." (let ((keys (cl-loop for count from 1 to 5 collect (cons (format "fields_attributes[%s][name]" count) (format "fields_attributes[%s][value]" count))))) @@ -392,7 +393,8 @@ Current settings are fetched from the server." "metadata fields" fields-updated))))) (defun mastodon-profile--update-meta-fields-alist () - "Prompt for new metadata fields information." + "Prompt for new metadata fields information. +Returns the results as an alist." (let ((fields-old (mastodon-profile--fields-get nil ;; we must fetch the plaintext version: -- cgit v1.2.3 From 2fb09762a4150d6a14fb3217b2debef948df6ff9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 30 Oct 2022 13:05:08 +0100 Subject: hack to limit meta fields to 255 w/o using string-limit --- lisp/mastodon-profile.el | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 505dbc4..d6819db 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -385,7 +385,6 @@ Returns an alist." (fields-updated (mastodon-profile--update-meta-fields-alist)) (params (mastodon-profile--make-meta-fields-params fields-updated)) (response (mastodon-http--patch url params))) - (setq test-fields-str params) (mastodon-http--triage response (lambda () (mastodon-profile-fetch-server-account-settings) @@ -398,19 +397,30 @@ Returns the results as an alist." (let ((fields-old (mastodon-profile--fields-get nil ;; we must fetch the plaintext version: - (mastodon-profile--get-source-value 'fields))) - fields-new) + (mastodon-profile--get-source-value 'fields)))) ;; offer empty fields if user currently has less than four filled: (while (< (length fields-old) 4) (setq fields-old (append fields-old '(("" . ""))))) - (cl-loop for f in fields-old - for x from 1 to 5 - collect - (cons (read-string (format "Edit account metadata key [%s/4]: " x) - (car f)) - (read-string (format "Edit account metadata value [%s/4]: " x) - (cdr f)))))) + (let ((alist + (cl-loop for f in fields-old + for x from 1 to 5 + collect + (cons (read-string + (format "Metadata key [%s/4] (max. 255 chars): " x) + (car f)) + (read-string + (format "Metadata value [%s/4] (max. 255 chars): " x) + (cdr f)))))) + ;; hack to avoiding using `string-limit', which req. 28.1: + (mapcar (lambda (x) + (cons (mastodon-profile--limit-to-255 (car x)) + (mastodon-profile--limit-to-255 (cdr x)))) + alist)))) + +(defun mastodon-profile--limit-to-255 (x) + "Limit string X to 255 chars max." + (if (> (length x) 255) (substring x 0 255) x)) (defun mastodon-profile--get-preferences-pref (pref) "Fetch PREF from the endpoint \"/preferences\". -- cgit v1.2.3 From 36382243a2a9278837a63d677cb94203bd01ad6a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 30 Oct 2022 13:09:56 +0100 Subject: defvars for flycheck --- lisp/mastodon-profile.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index d6819db..cfb3bdb 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -74,6 +74,8 @@ (defvar mastodon-tl--update-point) (defvar mastodon-mode-map) (defvar mastodon-toot--max-toot-chars) +(defvar mastodon-toot--visibility) +(defvar mastodon-toot--content-nsfw) (defvar-local mastodon-profile--account nil "The data for the account being described in the current profile buffer.") -- cgit v1.2.3 From d93d1f15b7b02e7120ca2544b0c40295e6f62a09 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 11:08:30 +0100 Subject: toot-mode-hook: profile-fetch-server-account-settings --- lisp/mastodon-toot.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index bcf9c83..9d2d02d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -76,6 +76,7 @@ (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-profile--get-source-pref "mastodon-profile") (autoload 'mastodon-profile--update-preference "mastodon-profile") +(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") ;; for mastodon-toot--translate-toot-text @@ -1187,6 +1188,9 @@ a draft into the buffer." (when initial-text (insert initial-text)))) +;;;###autoload +(add-hook 'mastodon-toot-mode-hook #'mastodon-profile-fetch-server-account-settings) + (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." :group 'mastodon-toot -- cgit v1.2.3 From 42990b2a471afc2d4cc1102f8cec8e70982f2e2c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 5 Nov 2022 15:40:46 +0100 Subject: fetch-server-account-settings: only fetch if var not set --- lisp/mastodon-profile.el | 41 +++++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index cfb3bdb..c6aa5e2 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -296,26 +296,27 @@ This is done after changing the setting on the server." "Fetch basic account settings from the server. Store the values in `mastodon-profile-account-settings'. Run in `mastodon-mode-hook'." - (let ((keys '(locked discoverable display_name bot)) - (source-keys '(privacy sensitive language))) - (mapc (lambda (k) - (mastodon-profile-update-preference-plist - k - (mastodon-profile--get-json-value k))) - keys) - (mapc (lambda (sk) - (mastodon-profile-update-preference-plist - sk - (mastodon-profile--get-source-value sk))) - source-keys) - ;; hack for max toot chars: - (mastodon-toot--get-max-toot-chars :no-toot) - (mastodon-profile-update-preference-plist 'max_toot_chars - mastodon-toot--max-toot-chars) - ;; TODO: remove now redundant vars, replace with fetchers from the plist - (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) - mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) - mastodon-profile-account-settings)) + (unless mastodon-profile-account-settings + (let ((keys '(locked discoverable display_name bot)) + (source-keys '(privacy sensitive language))) + (mapc (lambda (k) + (mastodon-profile-update-preference-plist + k + (mastodon-profile--get-json-value k))) + keys) + (mapc (lambda (sk) + (mastodon-profile-update-preference-plist + sk + (mastodon-profile--get-source-value sk))) + source-keys) + ;; hack for max toot chars: + (mastodon-toot--get-max-toot-chars :no-toot) + (mastodon-profile-update-preference-plist 'max_toot_chars + mastodon-toot--max-toot-chars) + ;; TODO: remove now redundant vars, replace with fetchers from the plist + (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) + mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) + mastodon-profile-account-settings))) (defun mastodon-profile-account-locked-toggle () "Toggle the locked status of your account. -- cgit v1.2.3 From 0f85f3d69066a48434a6b27c4cbb77aa976984e9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 11:35:00 +0100 Subject: convert :json-false to nil in account settings handling :json-false isn't nil, so doesn't work as we want --- lisp/mastodon-profile.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index c6aa5e2..55e7d42 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -228,7 +228,9 @@ JSON is the data returned by the server." "Fetch current VAL ue from account." (let* ((url (mastodon-http--api "accounts/verify_credentials")) (response (mastodon-http--get-json url))) - (alist-get val response))) + (if (eq (alist-get val response) ':json-false) + nil + (alist-get val response)))) (defun mastodon-profile--get-source-values () "Return the \"source\" preferences from the server." @@ -237,7 +239,9 @@ JSON is the data returned by the server." (defun mastodon-profile--get-source-value (pref) "Return account PREF erence from the \"source\" section on the server." (let ((source (mastodon-profile--get-source-values))) - (alist-get pref source))) + (if (eq (alist-get pref source) ':json-false) + nil + (alist-get pref source)))) (defun mastodon-profile--update-user-profile-note () "Fetch user's profile note and display for editing." @@ -349,7 +353,7 @@ Current settings are fetched from the server." (mastodon-profile--get-source-value key) (mastodon-profile--get-json-value key))) (prompt (format "Account setting %s is %s. Toggle?" key val))) - (if (not (equal val :json-false)) + (if val (when (y-or-n-p prompt) (mastodon-profile--update-preference (symbol-name key) "false" source)) (when (y-or-n-p prompt) -- cgit v1.2.3 From b2d79eabd34040c9e8cadffb44ebcde771c35b33 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 11:42:40 +0100 Subject: toot--kill: fix delete after change funs fun name --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9d2d02d..bcb4af1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -474,7 +474,7 @@ CANCEL means the toot was not sent, so we save the toot text as a draft." (cl-pushnew mastodon-toot-current-toot-text mastodon-toot-draft-toots-list :test 'equal))) ;; prevent some weird bug when cancelling a non-empty toot: - (delete #'mastodon-toot-save-toot-text after-change-functions) + (delete #'mastodon-toot--save-toot-text after-change-functions) (kill-buffer-and-window)) (defun mastodon-toot--cancel () -- cgit v1.2.3 From bcf418d78366c356ab11d0feba3fd1996782af8f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 11:47:03 +0100 Subject: flycheck requires / thingatpt fun --- lisp/mastodon.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index bc624d9..a5ba9e4 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -37,6 +37,8 @@ (require 'mastodon-http) (require 'mastodon-toot) (require 'url) +(require 'thingatpt) +(require 'shr) (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") @@ -279,7 +281,7 @@ If a status or account is found, load it in `mastodon.el', if not, just browse the URL in the normal fashion." (interactive) (let* ((query (or query-url - (url-get-url-at-point) + (thing-at-point-url-at-point) (get-text-property (point) 'shr-url) (read-string "Lookup URL: ")))) (if (not (mastodon--masto-url-p query)) -- cgit v1.2.3 From 1c1e8281d22fe6cd0fb40925fb5efa22c11e7dd3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 12:48:32 +0100 Subject: http.el docstrings --- lisp/mastodon-http.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index f32ccd4..eebfa85 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -74,7 +74,8 @@ This is a thin abstraction over the system `url-retrieve-synchronously'. Depending on which version of this -is available we will call it with or without a timeout." +is available we will call it with or without a timeout. +SILENT means don't message." (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) (url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout))) @@ -141,14 +142,15 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. (defun mastodon-http--get (url &optional silent) "Make synchronous GET request to URL. - -Pass response buffer to CALLBACK function." +Pass response buffer to CALLBACK function. +SILENT means don't message." (mastodon-http--authorized-request "GET" (mastodon-http--url-retrieve-synchronously url silent))) (defun mastodon-http--get-json (url &optional silent) - "Make synchronous GET request to URL. Return JSON response." + "Make synchronous GET request to URL. Return JSON response. +SILENT means don't message." (with-current-buffer (mastodon-http--get url silent) (mastodon-http--process-json))) @@ -187,7 +189,8 @@ Pass response buffer to CALLBACK function." (defun mastodon-http--get-search-json (url query &optional param silent) "Make GET request to URL, searching for QUERY and return JSON response. -PARAM is any extra parameters to send with the request." +PARAM is any extra parameters to send with the request. +SILENT means don't message." (let ((buffer (mastodon-http--get-search url query param silent))) (with-current-buffer buffer (mastodon-http--process-json-search)))) @@ -195,7 +198,8 @@ PARAM is any extra parameters to send with the request." (defun mastodon-http--get-search (base-url query &optional param 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'." +PARAM is a formatted request parameter, eg 'following=true'. +SILENT means don't message." (mastodon-http--authorized-request "GET" (let ((url (if param -- cgit v1.2.3 From 6d11e60a7a0b661e0241dcd8372de53edbfbf27f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 3 Nov 2022 21:44:06 +0100 Subject: Revert "remove unused --append-query-string" This reverts commit e2fd67b16104ab772a4ef962613cb9f3cb3cea52. --- lisp/mastodon-http.el | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index eebfa85..e3efabe 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -175,6 +175,13 @@ SILENT means don't message." (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))) + ;; search functions: (defun mastodon-http--process-json-search () "Process JSON returned by a search query to the server." -- cgit v1.2.3 From f5257ee34b46c383f537ab106fd3ae6a394efdfd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 3 Nov 2022 23:37:53 +0100 Subject: basic poll create funs --- lisp/mastodon-toot.el | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index bcb4af1..a17fabb 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -162,6 +162,9 @@ change the setting on the server, see (defvar-local mastodon-toot--media-attachment-ids nil "A list of any media attachment ids of the toot being composed.") +(defvar-local mastodon-toot-poll-options nil + "A list of poll options for the toot being composed.") + (defvar-local mastodon-toot--reply-to-id nil "Buffer-local variable to hold the id of the toot being replied to.") @@ -188,6 +191,7 @@ send.") (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) (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) map) "Keymap for `mastodon-toot'.") @@ -615,7 +619,17 @@ If media items have been attached and uploaded with (mapcar (lambda (id) (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) - (args (append args-media args-no-media))) + (args-poll (when mastodon-toot-poll-options + (append + (mastodon-toot--make-poll-params + mastodon-toot-poll-options) + `(("poll[expires_in]" . ,mastodon-toot-poll-expiry))))) + ;; media || polls: + (args (if mastodon-toot--media-attachments + (append args-media args-no-media) + (if mastodon-toot-poll-options + (append args-no-media args-poll) + args-no-media)))) (cond ((and mastodon-toot--media-attachments ;; make sure we have media args ;; and the same num of ids as attachments @@ -920,6 +934,27 @@ which is used to attach it to a toot when posting." mastodon-toot--media-attachments)) (list "None"))) +(defun mastodon-toot--make-poll-params (options) + "Returns an parameter query alist from poll OPTIONS." + (let ((key "poll[options][]")) + (cl-loop for o in options + collect `(,key . ,o)))) + +(defun mastodon-toot--create-poll () + "Prompt for new poll options and return as a list." + (interactive) + (let ((length (read-number "Number of poll options [2-4]: " 2))) + (setq mastodon-toot-poll-options + (cl-loop for x from 1 to length + collect (read-string (format "Poll option [%s/%s]: " x length)))) + (mastodon-toot--get-poll-expiry))) + +(defun mastodon-toot--get-poll-expiry () + "Prompt for a poll expiry time." + ;; API requires this in seconds + (setq mastodon-toot-poll-expiry + (read-string "poll ends in [seconds, min 5 mins]: "))) + ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () -- cgit v1.2.3 From af6cbd56602a4a1f56fd8bd9e6b8ac0d750bb0f5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 4 Nov 2022 12:33:12 +0100 Subject: basic poll creation, with all options polls docstrings etc cleanup --- lisp/mastodon-toot.el | 45 ++++++++++++++++++++++++++++++--------------- 1 file changed, 30 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a17fabb..44386f7 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -162,7 +162,7 @@ change the setting on the server, see (defvar-local mastodon-toot--media-attachment-ids nil "A list of any media attachment ids of the toot being composed.") -(defvar-local mastodon-toot-poll-options nil +(defvar-local mastodon-toot-poll nil "A list of poll options for the toot being composed.") (defvar-local mastodon-toot--reply-to-id nil @@ -599,6 +599,15 @@ to `emojify-user-emojis', and the emoji data is updated." (setq mastodon-toot--visibility visibility) (message "Visibility set to %s" visibility)) +(defun mastodon-toot--build-poll-params () + "Return an alist of parameters for POSTing a poll status." + (append + (mastodon-toot--make-poll-params + (plist-get mastodon-toot-poll :options)) + `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) + `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi)))) + `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide)))))) + (defun mastodon-toot--send () "POST contents of new-toot buffer to Mastodon instance and kill buffer. If media items have been attached and uploaded with @@ -619,15 +628,12 @@ If media items have been attached and uploaded with (mapcar (lambda (id) (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) - (args-poll (when mastodon-toot-poll-options - (append - (mastodon-toot--make-poll-params - mastodon-toot-poll-options) - `(("poll[expires_in]" . ,mastodon-toot-poll-expiry))))) + (args-poll (when mastodon-toot-poll + (mastodon-toot--build-poll-params))) ;; media || polls: (args (if mastodon-toot--media-attachments (append args-media args-no-media) - (if mastodon-toot-poll-options + (if mastodon-toot-poll (append args-no-media args-poll) args-no-media)))) (cond ((and mastodon-toot--media-attachments @@ -935,7 +941,7 @@ which is used to attach it to a toot when posting." (list "None"))) (defun mastodon-toot--make-poll-params (options) - "Returns an parameter query alist from poll OPTIONS." + "Return an parameter query alist from poll OPTIONS." (let ((key "poll[options][]")) (cl-loop for o in options collect `(,key . ,o)))) @@ -943,17 +949,26 @@ which is used to attach it to a toot when posting." (defun mastodon-toot--create-poll () "Prompt for new poll options and return as a list." (interactive) - (let ((length (read-number "Number of poll options [2-4]: " 2))) - (setq mastodon-toot-poll-options - (cl-loop for x from 1 to length - collect (read-string (format "Poll option [%s/%s]: " x length)))) - (mastodon-toot--get-poll-expiry))) + ;; re length, API docs show a poll 9 options. + (let* ((length (read-number "Number of poll options [2-9]: " 2)) + (multiple-p (y-or-n-p "Multiple choice poll? ")) + (options (mastodon-toot--read-poll-options length)) + (hide-totals (y-or-n-p "Hide votes until poll ends? ")) + (expiry (mastodon-toot--get-poll-expiry))) + (setq mastodon-toot-poll + `(:options ,options :length ,length :multi ,multiple-p :hide ,hide-totals :expiry ,expiry)) + (message "poll created!"))) + +(defun mastodon-toot--read-poll-options (length) + "Read a list of options for poll of LENGTH options." + (cl-loop for x from 1 to length + collect (read-string (format "Poll option [%s/%s]: " x length)))) (defun mastodon-toot--get-poll-expiry () "Prompt for a poll expiry time." ;; API requires this in seconds - (setq mastodon-toot-poll-expiry - (read-string "poll ends in [seconds, min 5 mins]: "))) + ;; TODO: offer sane poll expiry options + (read-string "poll ends in [seconds, min 5 mins]: ")) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings -- cgit v1.2.3 From ebbe5372bc4e1b99a97559982dbbe10ea7936c3b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 4 Nov 2022 13:03:34 +0100 Subject: small improvements to poll display in timeline revert display of poll votes --- lisp/mastodon-tl.el | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 130b01f..3399791 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -946,6 +946,9 @@ this just means displaying toot client." (defun mastodon-tl--get-poll (toot) "If TOOT includes a poll, return it as a formatted string." (let* ((poll (mastodon-tl--field 'poll toot)) + (expiry (mastodon-tl--field 'expires_at poll)) + (expired-p (if (eq (mastodon-tl--field 'expired poll) :json-false) nil t)) + (multi (mastodon-tl--field 'multiple poll)) (options (mastodon-tl--field 'options poll)) (option-titles (mapcar (lambda (x) (alist-get 'title x)) @@ -958,18 +961,27 @@ this just means displaying toot client." (concat "\nPoll: \n\n" (mapconcat (lambda (option) (progn - (format "Option %s: %s%s [%s votes].\n" + (format "%s: %s%s%s\n" (setq option-counter (1+ option-counter)) - (alist-get 'title option) + (propertize (alist-get 'title option) + 'face 'success) (make-string (1+ (- (length longest-option) (length (alist-get 'title option)))) ?\ ) - (alist-get 'votes_count option)))) + ;; TODO: disambiguate no votes from hidden votes + (format "[%s votes]" (or (alist-get 'votes_count option) + "0"))))) options "\n") + (unless expired-p + (propertize (format "Expires: %s" expiry) + 'face 'font-lock-comment-face)) + (when expired-p + (propertize "Poll expired." + 'face 'font-lock-comment-face)) "\n"))) (defun mastodon-tl--poll-vote (option) -- cgit v1.2.3 From 70c40eb1f903481fc7c2ff1fcbddf73411240412 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 5 Nov 2022 11:42:43 +0100 Subject: rename --make-poll-params to --make-poll-options-params --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 44386f7..29f9524 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -602,7 +602,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-toot--make-poll-params + (mastodon-toot--make-poll-options-params (plist-get mastodon-toot-poll :options)) `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi)))) @@ -940,7 +940,7 @@ which is used to attach it to a toot when posting." mastodon-toot--media-attachments)) (list "None"))) -(defun mastodon-toot--make-poll-params (options) +(defun mastodon-toot--make-poll-options-params (options) "Return an parameter query alist from poll OPTIONS." (let ((key "poll[options][]")) (cl-loop for o in options -- cgit v1.2.3 From 2e89ac925f1198b5896061ec1d0442a9edbd8dcf Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 5 Nov 2022 11:43:10 +0100 Subject: poll - add collection of expiry times --- lisp/mastodon-toot.el | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 29f9524..bd24f6f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -950,8 +950,8 @@ which is used to attach it to a toot when posting." "Prompt for new poll options and return as a list." (interactive) ;; re length, API docs show a poll 9 options. - (let* ((length (read-number "Number of poll options [2-9]: " 2)) - (multiple-p (y-or-n-p "Multiple choice poll? ")) + (let* ((length (read-number "Number of options [2-4]: " 2)) + (multiple-p (y-or-n-p "Multiple choice? ")) (options (mastodon-toot--read-poll-options length)) (hide-totals (y-or-n-p "Hide votes until poll ends? ")) (expiry (mastodon-toot--get-poll-expiry))) @@ -967,8 +967,25 @@ which is used to attach it to a toot when posting." (defun mastodon-toot--get-poll-expiry () "Prompt for a poll expiry time." ;; API requires this in seconds - ;; TODO: offer sane poll expiry options - (read-string "poll ends in [seconds, min 5 mins]: ")) + (let* ((options (mastodon-toot--poll-expiry-options-alist)) + (response (completing-read "poll ends in [or enter seconds]: " + options nil 'confirm))) + (or (alist-get response options nil nil #'equal) + (if (< (string-to-number response) 600) + "600" ;; min 5 mins + response)))) + +(defun mastodon-toot--poll-expiry-options-alist () + "Return an alist of seconds options." + `(("5 minutes" . ,(number-to-string (* 60 5))) + ("30 minutes" . ,(number-to-string (* 60 30))) + ("1 hour" . ,(number-to-string (* 60 60))) + ("6 hours" . ,(number-to-string (* 60 60 6))) + ("1 day" . ,(number-to-string (* 60 60 24))) + ("3 days" . ,(number-to-string (* 60 60 24 3))) + ("7 days" . ,(number-to-string (* 60 60 24 7))) + ("14 days" . ,(number-to-string (* 60 60 24 14))) + ("30 days" . ,(number-to-string (* 60 60 24 30))))) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings -- cgit v1.2.3 From 8da3601be521952f0435b2692fe9d55f40bdb218 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 5 Nov 2022 12:43:12 +0100 Subject: pretty expiry display and voter count --- lisp/mastodon-tl.el | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 3399791..2db5700 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -949,6 +949,7 @@ this just means displaying toot client." (expiry (mastodon-tl--field 'expires_at poll)) (expired-p (if (eq (mastodon-tl--field 'expired poll) :json-false) nil t)) (multi (mastodon-tl--field 'multiple poll)) + (vote-count (mastodon-tl--field 'voters_count poll)) (options (mastodon-tl--field 'options poll)) (option-titles (mapcar (lambda (x) (alist-get 'title x)) @@ -976,14 +977,25 @@ this just means displaying toot client." "0"))))) options "\n") - (unless expired-p - (propertize (format "Expires: %s" expiry) - 'face 'font-lock-comment-face)) - (when expired-p - (propertize "Poll expired." - 'face 'font-lock-comment-face)) + "\n" + (propertize (format "%s people | " vote-count) + 'face 'font-lock-comment-face) + (let ((str (if expired-p + "Poll expired." + (matodon-tl--format-poll-expiry expiry)))) + (propertize str 'face 'font-lock-comment-face)) "\n"))) +(defun matodon-tl--format-poll-expiry (timestamp) + "Convert poll expiry TIMESTAMP into a descriptive string." + (let ((parsed (iso8601-parse timestamp))) + (cond ((> (decoded-time-day parsed) 0) + (format "%s days left" (decoded-time-day parsed))) + ((> (decoded-time-hour parsed) 0) + (format "%s hours left" (decoded-time-hour parsed))) + ((> (decoded-time-minute parsed) 0) + (format "%s minutes left" (decoded-time-minute parsed)))))) + (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." (interactive -- cgit v1.2.3 From 10c5926d75a67ab799e63f896546f54e3706d65d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 5 Nov 2022 13:39:31 +0100 Subject: use ts library to format poll expiry --- Cask | 1 + lisp/mastodon-tl.el | 22 ++++++++++++---------- lisp/mastodon.el | 2 +- 3 files changed, 14 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/Cask b/Cask index a960f81..c193326 100644 --- a/Cask +++ b/Cask @@ -7,6 +7,7 @@ (depends-on "request" "0.3.0") (depends-on "seq") (depends-on "persist") +(depends-on "ts") (development (depends-on "ert-runner") diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2db5700..6f53f93 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -5,7 +5,7 @@ ;; Marty Hiatt ;; Maintainer: Marty Hiatt ;; Version: 1.0.0 -;; Package-Requires: ((emacs "27.1")) +;; Package-Requires: ((emacs "27.1") (ts "0.3")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. @@ -32,6 +32,7 @@ ;;; Code: (require 'shr) +(require 'ts) (require 'thingatpt) ; for word-at-point (require 'time-date) (require 'cl-lib) @@ -982,19 +983,20 @@ this just means displaying toot client." 'face 'font-lock-comment-face) (let ((str (if expired-p "Poll expired." - (matodon-tl--format-poll-expiry expiry)))) + (mastodon-tl--format-poll-expiry expiry)))) (propertize str 'face 'font-lock-comment-face)) "\n"))) -(defun matodon-tl--format-poll-expiry (timestamp) +(defun mastodon-tl--format-poll-expiry (timestamp) "Convert poll expiry TIMESTAMP into a descriptive string." - (let ((parsed (iso8601-parse timestamp))) - (cond ((> (decoded-time-day parsed) 0) - (format "%s days left" (decoded-time-day parsed))) - ((> (decoded-time-hour parsed) 0) - (format "%s hours left" (decoded-time-hour parsed))) - ((> (decoded-time-minute parsed) 0) - (format "%s minutes left" (decoded-time-minute parsed)))))) + (let ((parsed (ts-human-duration + (ts-diff (ts-parse timestamp) (ts-now))))) + (cond ((> (plist-get parsed :days) 0) + (format "%s days, %s hours left" (plist-get parsed :days) (plist-get parsed :hours))) + ((> (plist-get parsed :hours) 0) + (format "%s hours, %s minutes left" (plist-get parsed :hours) (plist-get parsed :minutes))) + ((> (plist-get parsed :minutes) 0) + (format "%s minutes left" (plist-get parsed :minutes)))))) (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index a5ba9e4..5ec48b6 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -5,7 +5,7 @@ ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt ;; Version: 1.0.0 -;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4")) +;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4") (ts "0.3")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. -- cgit v1.2.3 From 6556a83fa6bc67c5c44022ab9c2334ef7ffe5549 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 5 Nov 2022 15:43:35 +0100 Subject: Revert "fetch-server-account-settings: only fetch if var not set" This reverts commit 42990b2a471afc2d4cc1102f8cec8e70982f2e2c. --- lisp/mastodon-profile.el | 41 ++++++++++++++++++++--------------------- 1 file changed, 20 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 55e7d42..4aa9310 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -300,27 +300,26 @@ This is done after changing the setting on the server." "Fetch basic account settings from the server. Store the values in `mastodon-profile-account-settings'. Run in `mastodon-mode-hook'." - (unless mastodon-profile-account-settings - (let ((keys '(locked discoverable display_name bot)) - (source-keys '(privacy sensitive language))) - (mapc (lambda (k) - (mastodon-profile-update-preference-plist - k - (mastodon-profile--get-json-value k))) - keys) - (mapc (lambda (sk) - (mastodon-profile-update-preference-plist - sk - (mastodon-profile--get-source-value sk))) - source-keys) - ;; hack for max toot chars: - (mastodon-toot--get-max-toot-chars :no-toot) - (mastodon-profile-update-preference-plist 'max_toot_chars - mastodon-toot--max-toot-chars) - ;; TODO: remove now redundant vars, replace with fetchers from the plist - (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) - mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) - mastodon-profile-account-settings))) + (let ((keys '(locked discoverable display_name bot)) + (source-keys '(privacy sensitive language))) + (mapc (lambda (k) + (mastodon-profile-update-preference-plist + k + (mastodon-profile--get-json-value k))) + keys) + (mapc (lambda (sk) + (mastodon-profile-update-preference-plist + sk + (mastodon-profile--get-source-value sk))) + source-keys) + ;; hack for max toot chars: + (mastodon-toot--get-max-toot-chars :no-toot) + (mastodon-profile-update-preference-plist 'max_toot_chars + mastodon-toot--max-toot-chars) + ;; TODO: remove now redundant vars, replace with fetchers from the plist + (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) + mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) + mastodon-profile-account-settings)) (defun mastodon-profile-account-locked-toggle () "Toggle the locked status of your account. -- cgit v1.2.3 From 32679d73fdad010718be972ce29d5b63b91ef8c5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 5 Nov 2022 16:47:40 +0100 Subject: edit header prop line for melpa --- lisp/mastodon.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 5ec48b6..4085c86 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -1,4 +1,4 @@ -;;; mastodon.el --- Client for Mastodon -*- lexical-binding: t -*- +;;; mastodon.el --- Client for Mastodon, a federated social network -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen ;; Copyright (C) 2021 Abhiseck Paira -- cgit v1.2.3 From 8f5cb76677836703f0b554fe5ab669ba1e9d6d91 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 5 Nov 2022 17:03:17 +0100 Subject: boilerplate --- lisp/mastodon.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 4085c86..3b0a7d0 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -1,8 +1,10 @@ ;;; mastodon.el --- Client for Mastodon, a federated social network -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen +;; Copyright (C) 2020-2022 Marty Hiatt ;; Copyright (C) 2021 Abhiseck Paira ;; Author: Johnson Denen +;; Marty Hiatt ;; Maintainer: Marty Hiatt ;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4") (ts "0.3")) @@ -29,7 +31,7 @@ ;; mastodon.el is an Emacs client for Mastodon , ;; the federated microblogging social network. It also works with Pleroma instances. -;; see the readme file at https://codeberg.org/martianh/mastodon.el for set up and usage details. +;; See the readme file at https://codeberg.org/martianh/mastodon.el for set up and usage details. ;;; Code: (require 'cl-lib) ; for `cl-some' call in mastodon -- cgit v1.2.3