From 7b51ffda41dbf40ed5c5830b4911c5a6cab68d4d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 7 Aug 2022 17:21:45 +0200 Subject: profile - small cleanup of fields-insert --- lisp/mastodon-profile.el | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 260c2d3..0ac1c04 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -267,23 +267,15 @@ Returns a list of lists." (defun mastodon-profile--fields-insert (fields) "Format and insert field pairs (a.k.a profile metadata) in FIELDS." (let* ((car-fields (mapcar 'car fields)) - ;; (cdr-fields (mapcar 'cadr fields)) - ;; (cdr-fields-rendered - ;; (list - ;; (mapcar (lambda (x) - ;; (mastodon-tl--render-text x nil)) - ;; cdr-fields))) (left-width (car (sort (mapcar 'length car-fields) '>)))) ;; (right-width (car (sort (mapcar 'length cdr-fields) '>)))) (mapconcat (lambda (field) (mastodon-tl--render-text (concat - (format "_ %s " (car field)) - (make-string (- (+ 1 left-width) (length (car field))) ?_) + (format "_ '%-54s " (car field)) + ;; (make-string (- (+ 1 left-width) (length (car field))) ?_) (format " :: %s" (cadr field))) - ;; (make-string (- (+ 1 right-width) (length (cdr field))) ?_) - ;; " |") - field)) ; nil)) ; hack to make links tabstops + field)) ; hack to make links tabstops fields ""))) (defun mastodon-profile--get-statuses-pinned (account) -- cgit v1.2.3 From 44e8e75273b692fa69b9f9997046b342c364712d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 7 Aug 2022 17:22:28 +0200 Subject: http: --authorized-request macro --- lisp/mastodon-http.el | 94 +++++++++++++++++++++++++-------------------------- 1 file changed, 46 insertions(+), 48 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 35fd070..9c09996 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -117,19 +117,25 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." ;; pleroma compatibility: (unless (assoc "Content-Type" headers) '(("Content-Type" . "application/x-www-form-urlencoded"))) - headers))) + headers))) (with-temp-buffer (mastodon-http--url-retrieve-synchronously url)))) +(defmacro mastodon-http--authorized-request (method body) + "Make a METHOD request with Mastodon authorization." + `(let ((url-request-method ,method) + (url-request-extra-headers + (("Authorization" + (concat "Bearer " (mastodon-auth--access-token)))))) + ,body)) + (defun mastodon-http--get (url) "Make synchronous GET request to URL. -Pass response buffer to CALLBACK function." - (let ((url-request-method "GET") - (url-request-extra-headers - `(("Authorization" . ,(concat "Bearer " - (mastodon-auth--access-token)))))) - (mastodon-http--url-retrieve-synchronously url))) +Pass response buffer to CALLBACK function." + (mastodon-http--authorized-request + "GET" + (mastodon-http--url-retrieve-synchronously url))) (defun mastodon-http--get-json (url) "Make synchronous GET request to URL. Return JSON response." @@ -138,6 +144,8 @@ Pass response buffer to CALLBACK function." (defun mastodon-http--process-json () "Process JSON response." + ;; view raw response: + ;; (switch-to-buffer (current-buffer)) (goto-char (point-min)) (re-search-forward "^$" nil 'move) (let ((json-string @@ -150,12 +158,10 @@ Pass response buffer to CALLBACK function." (defun mastodon-http--delete (url) "Make DELETE request to URL." - (let ((url-request-method "DELETE") - (url-request-extra-headers - `(("Authorization" . ,(concat "Bearer " - (mastodon-auth--access-token)))))) - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url)))) + (mastodon-http--authorized-request + "DELETE" + (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. @@ -187,14 +193,12 @@ PARAM is any extra parameters to send with the request." "Make GET request to BASE-URL, searching for QUERY. Pass response buffer to CALLBACK function. PARAM is a formatted request parameter, eg 'following=true'." - (let ((url-request-method "GET") - (url (if param - (concat base-url "?" param "&q=" (url-hexify-string query)) - (concat base-url "?q=" (url-hexify-string query)))) - (url-request-extra-headers - `(("Authorization" . ,(concat "Bearer " - (mastodon-auth--access-token)))))) - (mastodon-http--url-retrieve-synchronously url))) + (mastodon-http--authorized-request + "GET" + (let ((url (if param + (concat base-url "?" param "&q=" (url-hexify-string query)) + (concat base-url "?q=" (url-hexify-string query))))) + (mastodon-http--url-retrieve-synchronously url)))) ;; profile update functions @@ -208,25 +212,21 @@ PARAM is a formatted request parameter, eg 'following=true'." "Make synchronous PATCH request to BASE-URL. Optionally specify the NOTE to edit. Pass response buffer to CALLBACK function." - (let ((url-request-method "PATCH") - (url (if note + (mastodon-http--authorized-request + "PATCH" + (let ((url (if note (concat base-url "?note=" (url-hexify-string note)) - base-url)) - (url-request-extra-headers - `(("Authorization" . ,(concat "Bearer " - (mastodon-auth--access-token)))))) - (mastodon-http--url-retrieve-synchronously url))) + base-url))) + (mastodon-http--url-retrieve-synchronously url)))) ;; Asynchronous functions (defun mastodon-http--get-async (url &optional callback &rest cbargs) "Make GET request to URL. Pass response buffer to CALLBACK function with args CBARGS." - (let ((url-request-method "GET") - (url-request-extra-headers - `(("Authorization" . ,(concat "Bearer " - (mastodon-auth--access-token)))))) - (url-retrieve url callback cbargs))) + (mastodon-http--authorized-request + "GET" + (url-retrieve url callback cbargs))) (defun mastodon-http--get-json-async (url &optional callback &rest args) "Make GET request to URL. Call CALLBACK with json-vector and ARGS." @@ -240,21 +240,19 @@ Pass response buffer to CALLBACK function with args CBARGS." "POST asynchronously to URL with ARGS and HEADERS. Then run function CALLBACK with arguements CBARGS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (let ((url-request-method "POST") - (request-timeout 5) - (url-request-data - (when args - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cdr arg)))) - args - "&"))) - (url-request-extra-headers - (append `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))) - headers))) - (with-temp-buffer - (url-retrieve url callback cbargs)))) + (mastodon-http--authorized-request + "POST" + (let ((request-timeout 5) + (url-request-data + (when args + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cdr arg)))) + args + "&")))) + (with-temp-buffer + (url-retrieve url callback cbargs))))) ;; TODO: test for curl first? (defun mastodon-http--post-media-attachment (url filename caption) -- cgit v1.2.3 From a44de346afbce43e4cd0d79280a45e2d2cd68758 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 7 Aug 2022 18:06:37 +0200 Subject: expand authorized-request macro to hand POST requests --- lisp/mastodon-http.el | 53 ++++++++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 9c09996..48046c2 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -97,38 +97,39 @@ Message status and JSON error from RESPONSE if unsuccessful." (insert-file-contents filename) (string-to-unibyte (buffer-string)))) -(defun mastodon-http--post (url args headers &optional unauthenticed-p) - "POST synchronously to URL with ARGS and HEADERS. - -Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (let ((url-request-method "POST") - (url-request-data - (when args - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cdr arg)))) - args - "&"))) - (url-request-extra-headers - (append - (unless unauthenticed-p - `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) - ;; pleroma compatibility: - (unless (assoc "Content-Type" headers) - '(("Content-Type" . "application/x-www-form-urlencoded"))) - headers))) - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url)))) - -(defmacro mastodon-http--authorized-request (method body) +(defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p) "Make a METHOD request with Mastodon authorization." `(let ((url-request-method ,method) (url-request-extra-headers + (unless ,unauthenticated-p (("Authorization" - (concat "Bearer " (mastodon-auth--access-token)))))) + (concat "Bearer " (mastodon-auth--access-token))))))) ,body)) +(defun mastodon-http--post (url args headers &optional unauthenticated-p) + "POST synchronously to URL with ARGS and HEADERS. + +Authorization header is included by default unless UNAUTHENTICATED-P is non-nil." + (mastodon-http--authorized-request + "POST" + (let ((url-request-data + (when args + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cdr arg)))) + args + "&"))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + ;; pleroma compat: + (unless (assoc "Content-Type" headers) + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url)) + unauthenticated-p))) + (defun mastodon-http--get (url) "Make synchronous GET request to URL. -- cgit v1.2.3 From e59ced7c51403a1f8fb7b312dccfa1516162637a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 7 Aug 2022 18:17:39 +0200 Subject: restore (list (cons call in macro --- lisp/mastodon-http.el | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 48046c2..8c55534 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -102,8 +102,8 @@ Message status and JSON error from RESPONSE if unsuccessful." `(let ((url-request-method ,method) (url-request-extra-headers (unless ,unauthenticated-p - (("Authorization" - (concat "Bearer " (mastodon-auth--access-token))))))) + (list (cons "Authorization" + (concat "Bearer " (mastodon-auth--access-token))))))) ,body)) (defun mastodon-http--post (url args headers &optional unauthenticated-p) @@ -112,23 +112,23 @@ Message status and JSON error from RESPONSE if unsuccessful." Authorization header is included by default unless UNAUTHENTICATED-P is non-nil." (mastodon-http--authorized-request "POST" - (let ((url-request-data - (when args - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cdr arg)))) - args - "&"))) - (url-request-extra-headers - (append url-request-extra-headers ; auth set in macro - ;; pleroma compat: - (unless (assoc "Content-Type" headers) - '(("Content-Type" . "application/x-www-form-urlencoded"))) - headers))) - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url)) - unauthenticated-p))) + (let ((url-request-data + (when args + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cdr arg)))) + args + "&"))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + ;; pleroma compat: + (unless (assoc "Content-Type" headers) + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))) + unauthenticated-p)) (defun mastodon-http--get (url) "Make synchronous GET request to URL. -- cgit v1.2.3 From e975ada204591fe4fb35ce055c726256ccf3004b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 7 Aug 2022 20:39:58 +0200 Subject: emoji funs indentation --- lisp/mastodon-toot.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 022cbec..7ff2b78 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -469,10 +469,10 @@ The list is formatted for `emojify-user-emojis', which see." (mapc (lambda (x) (push `(,(concat ":" - (file-name-base x) - ":") . (("name" . ,(file-name-base x)) - ("image" . ,(concat mastodon-custom-emojis-dir x)) - ("style" . "github"))) + (file-name-base x) ":") + . (("name" . ,(file-name-base x)) + ("image" . ,(concat mastodon-custom-emojis-dir x)) + ("style" . "github"))) mastodon-emojify-user-emojis)) custom-emoji-files) (reverse mastodon-emojify-user-emojis))) @@ -486,7 +486,8 @@ to `emojify-user-emojis', and the emoji data is updated." (unless (file-exists-p (concat (expand-file-name emojify-emojis-dir) "/mastodon-custom-emojis/")) - (when (y-or-n-p "Looks like you haven't downloaded your instance's custom emoji yet. Download now? ") + (when (y-or-n-p "Looks like you haven't downloaded your + instance's custom emoji yet. Download now? ") (mastodon-toot--download-custom-emoji))) (setq emojify-user-emojis (append (mastodon-toot--collect-custom-emoji) -- cgit v1.2.3 From 52adc2210f15d89188a8c3cf2bbf07e3849d916c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 7 Aug 2022 20:40:32 +0200 Subject: optional cd in -set-ce refactor --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7ff2b78..e5e6ce1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -365,7 +365,7 @@ NO-REDRAFT means delete toot only." toot-visibility toot-cw))))))))) -(defun mastodon-toot-set-cw (cw) +(defun mastodon-toot-set-cw (&optional cw) "Set content warning to CW if it is non-nil" (unless (equal cw "") (setq mastodon-toot--content-warning t) -- cgit v1.2.3 From 48f6f77cbffcdf8bfdc4ad6bb23d6e3dd7d67dda Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 7 Aug 2022 20:52:18 +0200 Subject: Revert "profile - small cleanup of fields-insert" This reverts commit 7b51ffda41dbf40ed5c5830b4911c5a6cab68d4d. --- lisp/mastodon-profile.el | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 0ac1c04..260c2d3 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -267,15 +267,23 @@ Returns a list of lists." (defun mastodon-profile--fields-insert (fields) "Format and insert field pairs (a.k.a profile metadata) in FIELDS." (let* ((car-fields (mapcar 'car fields)) + ;; (cdr-fields (mapcar 'cadr fields)) + ;; (cdr-fields-rendered + ;; (list + ;; (mapcar (lambda (x) + ;; (mastodon-tl--render-text x nil)) + ;; cdr-fields))) (left-width (car (sort (mapcar 'length car-fields) '>)))) ;; (right-width (car (sort (mapcar 'length cdr-fields) '>)))) (mapconcat (lambda (field) (mastodon-tl--render-text (concat - (format "_ '%-54s " (car field)) - ;; (make-string (- (+ 1 left-width) (length (car field))) ?_) + (format "_ %s " (car field)) + (make-string (- (+ 1 left-width) (length (car field))) ?_) (format " :: %s" (cadr field))) - field)) ; hack to make links tabstops + ;; (make-string (- (+ 1 right-width) (length (cdr field))) ?_) + ;; " |") + field)) ; nil)) ; hack to make links tabstops fields ""))) (defun mastodon-profile--get-statuses-pinned (account) -- cgit v1.2.3 From b7800ee9cd3267e7e5b220feeac459ac8741c8dd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 Aug 2022 16:10:13 +0200 Subject: re-allow boost/fave of own toots! --- lisp/mastodon-toot.el | 41 +++++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index e5e6ce1..38179be 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -240,26 +240,27 @@ TYPE is a symbol, either 'favourite or 'boost." (remove (if boost-p (when boosted t) (when faved t))) (toot-type (alist-get 'type (mastodon-tl--property 'toot-json)))) (if byline-region - (cond ((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json)) - (error "You can't %s your own toots." action-string)) - ((equal "reblog" toot-type) - (error "You can't %s boosts." action-string)) - ((equal "favourite" toot-type) - (error "Your can't %s favourites." action-string)) - (t - (mastodon-toot--action - action - (lambda () - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (if boost-p - (list 'boosted-p (not boosted)) - (list 'favourited-p (not faved)))) - (mastodon-toot--action-success - (if boost-p "B" "F") - byline-region remove)) - (message (format "%s #%s" (if boost-p msg action) id)))))) + (cond ;; actually there's nothing wrong with faving/boosting own toots! + ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json)) + ;;(error "You can't %s your own toots." action-string)) + ((equal "reblog" toot-type) + (error "You can't %s boosts." action-string)) + ((equal "favourite" toot-type) + (error "Your can't %s favourites." action-string)) + (t + (mastodon-toot--action + action + (lambda () + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (if boost-p + (list 'boosted-p (not boosted)) + (list 'favourited-p (not faved)))) + (mastodon-toot--action-success + (if boost-p "B" "F") + byline-region remove)) + (message (format "%s #%s" (if boost-p msg action) id)))))) (message (format "Nothing to %s here?!?" action-string))))) (defun mastodon-toot--toggle-boost () -- cgit v1.2.3 From 036088469a567caee7630f9538c8fa525e78b6be Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 Aug 2022 14:43:31 +0200 Subject: -tl--do-if-toot macro --- lisp/mastodon-tl.el | 91 +++++++++++++++++++++++++---------------------------- 1 file changed, 43 insertions(+), 48 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7aef0a1..80a0831 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1279,28 +1279,31 @@ RESPONSE is the JSON returned by the server." (mastodon-search--insert-users-propertized response :note) (goto-char (point-min))) +(defmacro mastodon--do-if-toot (&rest body) + "Execute BODY if we have a toot or user at point." + `(if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view + (not (mastodon-tl--property 'toot-json))) + (message "Looks like there's no toot or user at point?") + ,@body)) + (defun mastodon-tl--follow-user (user-handle &optional notify) "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." - (interactive - (list - (mastodon-tl--interactive-user-handles-get "follow"))) - (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view - (not (get-text-property (point) 'toot-json))) - (message "Looks like there's no toot or user at point?") - (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify))) + (interactive + (list + (mastodon-tl--interactive-user-handles-get "follow"))) + (mastodon--do-if-toot + (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify))) (defun mastodon-tl--enable-notify-user-posts (user-handle) "Query for USER-HANDLE and enable notifications when they post." (interactive (list (mastodon-tl--interactive-user-handles-get "enable"))) - (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view - (not (get-text-property (point) 'toot-json))) - (message "Looks like there's no toot or user at point?") - (mastodon-tl--follow-user user-handle "true"))) + (mastodon--do-if-toot + (mastodon-tl--follow-user user-handle "true"))) (defun mastodon-tl--disable-notify-user-posts (user-handle) "Query for USER-HANDLE and disable notifications when they post." @@ -1314,20 +1317,16 @@ Can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "unfollow"))) - (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view - (not (get-text-property (point) 'toot-json))) - (message "Looks like there's no toot or user at point?") - (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))) + (mastodon--do-if-toot + (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))) (defun mastodon-tl--block-user (user-handle) "Query for USER-HANDLE from current status and block that user." (interactive (list (mastodon-tl--interactive-user-handles-get "block"))) - (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view - (not (get-text-property (point) 'toot-json))) - (message "Looks like there's no toot or user at point?") - (mastodon-tl--do-user-action-and-response user-handle "block"))) + (mastodon--do-if-toot + (mastodon-tl--do-user-action-and-response user-handle "block"))) (defun mastodon-tl--unblock-user (user-handle) "Query for USER-HANDLE from list of blocked users and unblock that user." @@ -1343,10 +1342,8 @@ Can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "mute"))) - (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view - (not (get-text-property (point) 'toot-json))) - (message "Looks like there's no toot or user at point?") - (mastodon-tl--do-user-action-and-response user-handle "mute"))) + (mastodon--do-if-toot + (mastodon-tl--do-user-action-and-response user-handle "mute"))) (defun mastodon-tl--unmute-user (user-handle) "Query for USER-HANDLE from list of muted users and unmute that user." @@ -1359,31 +1356,29 @@ Can be called to toggle NOTIFY on users already being followed." (defun mastodon-tl--interactive-user-handles-get (action) "Get the list of user-handles for ACTION from the current toot." - (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view - (not (get-text-property (point) 'toot-json))) - (message "Looks like there's no toot or user at point?") - (let ((user-handles - (cond ((or (equal (buffer-name) "*mastodon-follow-suggestions*") - ;; follow suggests / search / foll requests compat: - (string-prefix-p "*mastodon-search" (buffer-name)) - (equal (buffer-name) "*mastodon-follow-requests*") - ;; profile view follows/followers compat: - ;; but not for profile statuses: - (and (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) - (not (string-suffix-p "statuses" (mastodon-tl--get-endpoint))))) - ;; avoid tl--property here because it calls next-toot - ;; which breaks non-toot buffers like foll reqs etc.: - (list (alist-get 'acct (get-text-property (point) 'toot-json)))) - (t - (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))))) - (completing-read (if (or (equal action "disable") - (equal action "enable")) - (format "%s notifications when user posts: " action) - (format "Handle of user to %s: " action)) - user-handles - nil ; predicate - 'confirm)))) + (mastodon--do-if-toot + (let ((user-handles + (cond ((or (equal (buffer-name) "*mastodon-follow-suggestions*") + ;; follow suggests / search / foll requests compat: + (string-prefix-p "*mastodon-search" (buffer-name)) + (equal (buffer-name) "*mastodon-follow-requests*") + ;; profile view follows/followers compat: + ;; but not for profile statuses: + (and (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) + (not (string-suffix-p "statuses" (mastodon-tl--get-endpoint))))) + ;; avoid tl--property here because it calls next-toot + ;; which breaks non-toot buffers like foll reqs etc.: + (list (alist-get 'acct (get-text-property (point) 'toot-json)))) + (t + (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))))) + (completing-read (if (or (equal action "disable") + (equal action "enable")) + (format "%s notifications when user posts: " action) + (format "Handle of user to %s: " action)) + user-handles + nil ; predicate + 'confirm)))) (defun mastodon-tl--interactive-blocks-or-mutes-list-get (action) "Fetch the list of accounts for ACTION from the server. -- cgit v1.2.3 From 4b34d4f8e0314380a7877527c9a3f7e7270b9d3a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 Aug 2022 14:57:19 +0200 Subject: fix formatting of unmute-user --- lisp/mastodon-tl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 80a0831..bd4df7b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1439,7 +1439,8 @@ by `mastodon-tl--follow-user' to enable or disable notifications." ((string-equal notify "false") (message "Not receiving notifications for user %s (@%s)!" name user-handle)) - ((string-equal action "mute") + ((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))))))) -- cgit v1.2.3 From d2c300322b5899a420c057301406ca0ad0c53f1f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 17 Aug 2022 17:32:03 +0200 Subject: docstrings --- lisp/mastodon-http.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 8c55534..ec3b5e6 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -98,7 +98,8 @@ Message status and JSON error from RESPONSE if unsuccessful." (string-to-unibyte (buffer-string)))) (defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p) - "Make a METHOD request with Mastodon authorization." + "Make a METHOD type request using BODY, with Mastodon authorization. +Unless UNAUTHENTICATED-P is non-nil." `(let ((url-request-method ,method) (url-request-extra-headers (unless ,unauthenticated-p @@ -133,7 +134,7 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. (defun mastodon-http--get (url) "Make synchronous GET request to URL. -Pass response buffer to CALLBACK function." +Pass response buffer to CALLBACK function." (mastodon-http--authorized-request "GET" (mastodon-http--url-retrieve-synchronously url))) -- cgit v1.2.3 From 5d170358b15d8014cd8648b8e0a2e22306d80430 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 19 Aug 2022 09:21:24 +0200 Subject: rename do-if-toot -- add tl prefix --- lisp/mastodon-tl.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index bd4df7b..b6c3632 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1279,7 +1279,7 @@ RESPONSE is the JSON returned by the server." (mastodon-search--insert-users-propertized response :note) (goto-char (point-min))) -(defmacro mastodon--do-if-toot (&rest body) +(defmacro mastodon-tl--do-if-toot (&rest body) "Execute BODY if we have a toot or user at point." `(if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view (not (mastodon-tl--property 'toot-json))) @@ -1294,7 +1294,7 @@ Can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "follow"))) - (mastodon--do-if-toot + (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify))) (defun mastodon-tl--enable-notify-user-posts (user-handle) @@ -1302,7 +1302,7 @@ Can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "enable"))) - (mastodon--do-if-toot + (mastodon-tl--do-if-toot (mastodon-tl--follow-user user-handle "true"))) (defun mastodon-tl--disable-notify-user-posts (user-handle) @@ -1317,7 +1317,7 @@ Can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "unfollow"))) - (mastodon--do-if-toot + (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))) (defun mastodon-tl--block-user (user-handle) @@ -1325,7 +1325,7 @@ Can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "block"))) - (mastodon--do-if-toot + (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "block"))) (defun mastodon-tl--unblock-user (user-handle) @@ -1342,7 +1342,7 @@ Can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "mute"))) - (mastodon--do-if-toot + (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "mute"))) (defun mastodon-tl--unmute-user (user-handle) @@ -1356,7 +1356,7 @@ Can be called to toggle NOTIFY on users already being followed." (defun mastodon-tl--interactive-user-handles-get (action) "Get the list of user-handles for ACTION from the current toot." - (mastodon--do-if-toot + (mastodon-tl--do-if-toot (let ((user-handles (cond ((or (equal (buffer-name) "*mastodon-follow-suggestions*") ;; follow suggests / search / foll requests compat: -- cgit v1.2.3 From b19bb4b213e7de074bd0c4d1c6d2dfd6f2773353 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 19 Aug 2022 09:21:39 +0200 Subject: tl--init*: fix a stray bracket --- lisp/mastodon-tl.el | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b6c3632..40e7218 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1683,14 +1683,13 @@ JSON is the data returned from the server." #'mastodon-tl--update-timestamps-callback (current-buffer) nil))) - (unless - ;; for everything save profiles: - (string-prefix-p "accounts" endpoint)) - ;;(or (equal endpoint "notifications") - ;; (string-prefix-p "timelines" endpoint) - ;; (string-prefix-p "favourites" endpoint) - ;; (string-prefix-p "statuses" endpoint)) - (mastodon-tl--goto-first-item))) + (unless (string-prefix-p "accounts" endpoint) + ;; for everything save profiles + (mastodon-tl--goto-first-item)))) +;;(or (equal endpoint "notifications") +;; (string-prefix-p "timelines" endpoint) +;; (string-prefix-p "favourites" endpoint) +;; (string-prefix-p "statuses" endpoint)) (defun mastodon-tl--init-sync (buffer-name endpoint update-function) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. -- cgit v1.2.3 From 818dc1525fe2181e034b6fd020a34a40ce5a200e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 19 Aug 2022 09:23:59 +0200 Subject: docstring --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 40e7218..a59897c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -264,7 +264,7 @@ text, i.e. hidden spoiler text." "local" "timelines/public?local=true" 'mastodon-tl--timeline)) (defun mastodon-tl--get-tag-timeline () - "Prompts for tag and opens its timeline." + "Prompt for tag and opens its timeline." (interactive) (let* ((word (or (word-at-point) "")) (input (read-string (format "Load timeline for tag (%s): " word))) -- cgit v1.2.3 From 51eb7c54e342b6bf2cb76fd93af5d5c2c184eea4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 19 Aug 2022 09:35:44 +0200 Subject: format for bookmarked toots, help-echo for B/F/K format chars --- lisp/mastodon-tl.el | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a59897c..be416f3 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -532,6 +532,7 @@ By default it is `mastodon-tl--byline-boosted'" (parsed-time (date-to-time created-time)) (faved (equal 't (mastodon-tl--field 'favourited toot))) (boosted (equal 't (mastodon-tl--field 'reblogged toot))) + (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot))) (visibility (mastodon-tl--field 'visibility toot))) (concat ;; Boosted/favourited markers are not technically part of the byline, so @@ -544,7 +545,9 @@ By default it is `mastodon-tl--byline-boosted'" (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 "F")) + (when bookmarked + (mastodon-tl--format-faved-or-boosted-byline "K"))) (propertize (concat ;; we propertize help-echo format faves for author name @@ -575,9 +578,17 @@ By default it is `mastodon-tl--byline-boosted'" (defun mastodon-tl--format-faved-or-boosted-byline (letter) "Format the byline marker for a boosted or favourited status. -LETTER is a string, either F or B." - (format "(%s) " - (propertize letter 'face 'mastodon-boost-fave-face))) +LETTER is a string, F for favourited, B for boosted, or K for bookmarked." + (let ((help-string (cond ((equal letter "F") + "favourited") + ((equal letter "B") + "boosted") + ((equal letter "K") + "bookmarked")))) + (format "(%s) " + (propertize letter 'face 'mastodon-boost-fave-face + 'help-echo (format "You have %s this status." + help-string))))) (defun mastodon-tl--render-text (string toot) "Return a propertized text rendering the given HTML string STRING. -- cgit v1.2.3 From 925c26eefb5fccebba786b7232fd8e107246ed18 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 19 Aug 2022 10:18:16 +0200 Subject: FIX the post visibility marker displayable check --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index be416f3..378b98c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -554,11 +554,11 @@ By default it is `mastodon-tl--byline-boosted'" ;; in `mastodon-tl--byline-author' (funcall author-byline toot) (cond ((equal visibility "direct") - (if (fontp (char-displayable-p #10r128274)) + (if (fontp (char-displayable-p #10r9993)) " ✉" " [direct]")) ((equal visibility "private") - (if (fontp (char-displayable-p #10r9993)) + (if (fontp (char-displayable-p #10r128274)) " 🔒" " [followers]"))) (funcall action-byline toot) -- cgit v1.2.3 From 5c8ec25bea01223aa37f5291bad560c0c2e6f806 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 19 Aug 2022 10:19:05 +0200 Subject: use bookmark emoji if possible --- lisp/mastodon-tl.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 378b98c..d5a893d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -547,7 +547,10 @@ By default it is `mastodon-tl--byline-boosted'" (when faved (mastodon-tl--format-faved-or-boosted-byline "F")) (when bookmarked - (mastodon-tl--format-faved-or-boosted-byline "K"))) + (mastodon-tl--format-faved-or-boosted-byline + (if (fontp (char-displayable-p #10r128278)) + "🔖" + "K")))) (propertize (concat ;; we propertize help-echo format faves for author name @@ -583,10 +586,11 @@ LETTER is a string, F for favourited, B for boosted, or K for bookmarked." "favourited") ((equal letter "B") "boosted") - ((equal letter "K") + ((equal letter (or "🔖" "K")) "bookmarked")))) (format "(%s) " (propertize letter 'face 'mastodon-boost-fave-face + ;; emojify breaks this for 🔖: 'help-echo (format "You have %s this status." help-string))))) -- cgit v1.2.3 From 07953cabfc08fe43552016185525d1b34cd05769 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 20 Aug 2022 13:31:58 +0200 Subject: skip toot-json check on own profile load --- lisp/mastodon-profile.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index cfea26c..ae244d8 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -416,7 +416,10 @@ If toot is a boost, opens the profile of the booster." user-handles nil ; predicate 'confirm))))) - (if (not (get-text-property (point) 'toot-json)) + (if (not (or + ;; own profile has no need for toot-json test: + (equal user-handle (mastodon-auth--get-account-name)) + (get-text-property (point) 'toot-json))) (message "Looks like there's no toot or user at point?") (let ((account (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json)))) -- cgit v1.2.3 From 88895d0c8307f27c643171cc7095c876856fe300 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 20 Aug 2022 15:42:50 +0200 Subject: FIX bookmark toggle, updating display in byline just boilerplate copying fave/boost funs for now, better than nothing. --- lisp/mastodon-tl.el | 8 +++---- lisp/mastodon-toot.el | 59 +++++++++++++++++++++++++++++++-------------------- 2 files changed, 40 insertions(+), 27 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d5a893d..aab0509 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -533,6 +533,9 @@ By default it is `mastodon-tl--byline-boosted'" (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))) (concat ;; Boosted/favourited markers are not technically part of the byline, so @@ -547,10 +550,7 @@ By default it is `mastodon-tl--byline-boosted'" (when faved (mastodon-tl--format-faved-or-boosted-byline "F")) (when bookmarked - (mastodon-tl--format-faved-or-boosted-byline - (if (fontp (char-displayable-p #10r128278)) - "🔖" - "K")))) + (mastodon-tl--format-faved-or-boosted-byline bookmark-str))) (propertize (concat ;; we propertize help-echo format faves for author name diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 38179be..821dd43 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -216,8 +216,6 @@ Makes a POST request to the server." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response callback)))) - - (defun mastodon-toot--toggle-boost-or-favourite (type) "Toggle boost or favourite of toot at `point'. TYPE is a symbol, either 'favourite or 'boost." @@ -273,6 +271,42 @@ TYPE is a symbol, either 'favourite or 'boost." (interactive) (mastodon-toot--toggle-boost-or-favourite 'favourite)) +;; TODO maybe refactor into boost/fave fun +(defun mastodon-toot--bookmark-toot-toggle () + "Bookmark or unbookmark toot at point." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (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))) + (if byline-region + (when (y-or-n-p prompt) + (mastodon-toot--action + action + (lambda () + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (list 'bookmarked-p (not bookmarked-p)))) + (mastodon-toot--action-success + bookmark-str + byline-region remove) + (message (format "%s #%s" message id))))) + (message (format "Nothing to %s here?!?" action))))) + (defun mastodon-toot--copy-toot-url () "Copy URL of toot at point." (interactive) @@ -388,27 +422,6 @@ 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--bookmark-toot-toggle () - "Bookmark or unbookmark toot at point synchronously." - (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (bookmarked (alist-get 'bookmarked toot)) - (url (mastodon-http--api (if (equal bookmarked t) - (format "statuses/%s/unbookmark" id) - (format "statuses/%s/bookmark" id)))) - (prompt (if (equal bookmarked t) - (format "Toot already bookmarked. Remove? ") - (format "Bookmark this toot? "))) - (message (if (equal bookmarked t) - "Bookmark removed!" - "Toot bookmarked!"))) - (when (y-or-n-p prompt) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message message))))))) - (defun mastodon-toot--kill () "Kill `mastodon-toot-mode' buffer and window." (kill-buffer-and-window)) -- cgit v1.2.3 From bdf8f50edb3e44401657f8851b3ecef0ce3f0f1c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 20 Aug 2022 16:05:09 +0200 Subject: tl--insert-status: fetch base-toot-id from parent-toot if present --- lisp/mastodon-tl.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index aab0509..de08971 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -898,7 +898,9 @@ PARENT-TOOT is the JSON of the toot responded to." (mastodon-tl--byline toot author-byline action-byline)) 'toot-id (or id ; for notifications (alist-get 'id toot)) - 'base-toot-id (mastodon-tl--toot-id toot) + 'base-toot-id (mastodon-tl--toot-id + ;; if a favourite/boost notif, get ID of toot responded to: + (or parent-toot toot)) 'toot-json toot 'parent-toot parent-toot) "\n") -- cgit v1.2.3 From 53107deb0eb937c770f5a4a8adcb853c3eb9e00a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 20 Aug 2022 16:25:08 +0200 Subject: tl--byline: add bookmarked-p prop --- lisp/mastodon-tl.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index de08971..4b3f3c9 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -577,6 +577,7 @@ By default it is `mastodon-tl--byline-boosted'" (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted + 'bookmarked-p bookmarked 'byline t)))) (defun mastodon-tl--format-faved-or-boosted-byline (letter) -- cgit v1.2.3 From 705adb3ae86ee2c09074e9938673fc9083b9ab9d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 20 Aug 2022 16:25:52 +0200 Subject: tl--bookmark-toggle: use 'base-toot-id prop --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 821dd43..3081637 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -276,7 +276,8 @@ 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--as-string (mastodon-tl--toot-id toot))) + (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? ") -- cgit v1.2.3