aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp/mastodon-http.el4
-rw-r--r--lisp/mastodon-tl.el5
-rw-r--r--lisp/mastodon-views.el263
3 files changed, 213 insertions, 59 deletions
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index 51b144e..2635eef 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -53,6 +53,10 @@ Optionally specify VERSION in format vX."
(concat mastodon-instance-url "/api/"
(or version mastodon-http--api-version) "/" endpoint))
+(defun mastodon-http--api-v2 (endpoint)
+ "Return Mastodon API v2 URL for ENDPOINT."
+ (mastodon-http--api endpoint "v2"))
+
(defun mastodon-http--api-search ()
"Return Mastodon API url for the /search endpoint (v2)."
(format "%s/api/v2/search" mastodon-instance-url))
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 0d5d8a9..fbd76ff 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -3120,7 +3120,8 @@ JSON and http headers, without it just the JSON."
(defun mastodon-tl--init-sync
(buffer-name endpoint update-function
- &optional note-type params headers view-name binding-str)
+ &optional note-type params headers view-name binding-str
+ endpoint-version)
"Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
UPDATE-FUNCTION is used to receive more toots.
Runs synchronously.
@@ -3136,7 +3137,7 @@ BINDING-STR is a string explaining any bindins in the view."
(mastodon-http--build-array-params-alist
"exclude_types[]" exclude-types)))
(params (append notes-params params))
- (url (mastodon-http--api endpoint))
+ (url (mastodon-http--api endpoint endpoint-version))
(buffer (concat "*mastodon-" buffer-name "*"))
(response (mastodon-http--get-response url params))
(json (car response))
diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el
index 9b40541..f033d3c 100644
--- a/lisp/mastodon-views.el
+++ b/lisp/mastodon-views.el
@@ -92,6 +92,11 @@
(define-key map (kbd "d") #'mastodon-views--delete-filter)
(define-key map (kbd "c") #'mastodon-views--create-filter)
(define-key map (kbd "g") #'mastodon-views--view-filters)
+ (define-key map (kbd "u") #'mastodon-views--update-filter)
+ (define-key map (kbd "k") #'mastodon-views--delete-filter)
+ (define-key map (kbd "a") #'mastodon-views--add-filter-kw)
+ (define-key map (kbd "r") #'mastodon-views--remove-filter-kw)
+ (define-key map (kbd "U") #'mastodon-views--update-filter-kw)
map)
"Keymap for viewing filters.")
@@ -584,86 +589,230 @@ NO-CONFIRM means there is no ask or message, there is only do."
'mastodon-views--insert-filters
nil nil nil
"current filters"
- "c - create filter\n d - delete filter at point\n\
- n/p - go to next/prev filter")
+ "c - create filter | d/k - delete filter at point\n\
+ u - update filter\n a/r/U - add/remove/Update filter keyword\n
+ n/p - next/prev filter" "v2")
(with-current-buffer "*mastodon-filters*"
(use-local-map mastodon-views--view-filters-keymap)))
(defun mastodon-views--insert-filters (json)
- "Insert the user's current filters.
-JSON is what is returned by by the server."
- (mastodon-views--minor-view
- "filters"
- #'mastodon-views--insert-filter-string-set
- json))
-
-(defun mastodon-views--insert-filter-string-set (json)
"Insert a filter string plus a blank line.
JSON is the filters data."
- (mapc #'mastodon-views--insert-filter-string json))
-
-(defun mastodon-views--insert-filter-string (filter)
+ (mapc #'mastodon-views--insert-filter json))
+
+(require 'table)
+
+(defun mastodon-views--insert-filter-kws (kws)
+ "Insert filter keywords KWS."
+ (insert "\n\n")
+ (let ((beg (point))
+ (table-cell-horizontal-chars (if (char-displayable-p ?–) ; ?– ?-)
+ "–"
+ "-"))
+ (whole-str "whole-words-only:"))
+ (insert (concat "Keywords: | " whole-str "\n"))
+ (mapc (lambda (kw)
+ (let ((whole (if (eq :json-false (alist-get 'whole_word kw))
+ "nil"
+ "t")))
+ (insert
+ (propertize (concat
+ (format "\"%s\" | %s\n"
+ (alist-get 'keyword kw) whole))
+ 'kw-id (alist-get 'id kw)
+ 'item-json kw
+ 'mastodon-tab-stop t
+ 'whole-word whole))))
+ kws)
+ ;; table display of kws:
+ (table-capture beg (point) "|" "\n" nil (+ 2 (length whole-str)))
+ (table-justify-column 'center)
+ (table-forward-cell) ;; col 2
+ (table-justify-column 'center)
+ (while (re-search-forward ;; goto end of table:
+ (concat table-cell-horizontal-chars
+ (make-string 1 table-cell-intersection-char)
+ "\n")
+ nil :no-error))))
+
+(defun mastodon-views--insert-filter (filter)
"Insert a single FILTER."
- (let* ((phrase (alist-get 'phrase filter))
- (contexts (alist-get 'context filter))
- (id (alist-get 'id filter))
- (filter-string (concat "- \"" phrase "\" filtered in: "
- (mapconcat #'identity contexts ", "))))
+ (let-alist filter
(insert
- (propertize filter-string
- 'item-id id ;for goto-next-filter compat
- 'item-type 'filter
- 'phrase phrase
- 'byline t) ;for goto-next-filter compat
- "\n\n")))
+ (propertize
+ (concat
+ ;; heading:
+ (mastodon-tl--set-face
+ (concat "\n " mastodon-tl--horiz-bar "\n "
+ (propertize (upcase .title)
+ 'item-id .id
+ 'item-type 'filter
+ 'filter-title .title
+ 'byline t)
+ " " "\n"
+ " " mastodon-tl--horiz-bar "\n")
+ 'success)
+ ;; context:
+ (concat "Context: "
+ (mapconcat #'identity .context ", "))
+ ;; type (warn or hide):
+ (concat "\nType: " .filter_action))
+ 'item-json filter
+ 'item-id .id
+ 'item-type 'filter))
+ ;; terms list:
+ (if (not .keywords) ;; poss to have a filter sans keywords
+ ""
+ (mastodon-views--insert-filter-kws .keywords))))
(defvar mastodon-views--filter-types
'("home" "notifications" "public" "thread" "profile"))
-(defun mastodon-views--create-filter ()
+(defun mastodon-views--create-filter (&optional id title context type terms)
"Create a filter for a word.
Prompt for a context, must be a list containting at least one of \"home\",
-\"notifications\", \"public\", \"thread\"."
+\"notifications\", \"public\", \"thread\".
+Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter."
(interactive)
- (let* ((url (mastodon-http--api "filters"))
- (word (read-string
- (format "Word(s) to filter (%s): " (or (current-word) ""))
- nil nil (or (current-word) "")))
+ (let* ((url (if id
+ (mastodon-http--api-v2 (format "filters/%s" id))
+ (mastodon-http--api-v2 "filters")))
+ (title (or title (read-string "Filter name: ")))
+ (terms (or terms (read-string "Terms to filter (comma or space separated): ")))
+ (terms-split (split-string terms "[, ]"))
+ (terms-processed
+ (if (not terms)
+ (user-error "You must select at least one term to filter")
+ (mastodon-http--build-array-params-alist
+ "keywords_attributes[][keyword]" terms-split)))
+ (warn-or-hide
+ (or type
+ (completing-read "Warn (like CW) or hide? "
+ '("warn" "hide") nil :match)))
(contexts
- (if (string-empty-p word)
- (user-error "You must select at least one word for a filter")
- (completing-read-multiple
- "Contexts to filter [TAB for options]: "
- mastodon-views--filter-types
- nil t)))
+ (or context
+ (completing-read-multiple
+ "Filter contexts [TAB for options, comma separated]: "
+ mastodon-views--filter-types nil :match)))
(contexts-processed
- (if (equal nil contexts)
+ (if (not contexts)
(user-error "You must select at least one context for a filter")
- (cl-loop for c in contexts
- collect (cons "context[]" c))))
- (response (mastodon-http--post url (push
- `("phrase" . ,word)
- contexts-processed))))
- (mastodon-http--triage response
- (lambda (_)
- (when (mastodon-tl--buffer-type-eq 'filters)
- (mastodon-views--view-filters))
- (message "Filter created for %s!" word)))))
+ (mastodon-http--build-array-params-alist "context[]" contexts)))
+ (params (append `(("title" . ,title)
+ ("filter_action" . ,warn-or-hide))
+ ;; ("keywords_attributes[][whole_word]" . "false"))
+ terms-processed
+ contexts-processed))
+ (resp (if id
+ (mastodon-http--put url params)
+ (mastodon-http--post url params))))
+ (mastodon-views--filters-triage
+ resp
+ (message "Filter %s created!" title))))
+
+(defun mastodon-views--update-filter ()
+ "Update filter at point."
+ (interactive)
+ (if (not (eq 'filter (mastodon-tl--property 'item-type)))
+ (user-error "No filter at point?")
+ (let* ((filter (mastodon-tl--property 'item-json))
+ (id (mastodon-tl--property 'item-id))
+ (name (read-string "Name: " (alist-get 'title filter)))
+ (contexts (completing-read-multiple
+ "Filter contexts [TAB for options, comma separated]: "
+ mastodon-views--filter-types nil :match
+ (mapconcat #'identity
+ (alist-get 'context filter) ",")))
+ (type (completing-read "Warn (like CW) or hide? "
+ '("warn" "hide") nil :match
+ (alist-get 'type filter)))
+ (terms (read-string "Terms to add (comma or space separated): ")))
+ (mastodon-views--create-filter id name contexts type terms))))
+
(defun mastodon-views--delete-filter ()
"Delete filter at point."
(interactive)
- (let* ((filter-id (mastodon-tl--property 'item-id :no-move))
- (phrase (mastodon-tl--property 'phrase :no-move))
- (url (mastodon-http--api (format "filters/%s" filter-id))))
- (if (null phrase)
+ (let* ((id (mastodon-tl--property 'item-id :no-move))
+ (title (mastodon-tl--property 'filter-title :no-move))
+ (url (mastodon-http--api-v2 (format "filters/%s" id))))
+ (if (not (eq 'filter (mastodon-tl--property 'item-type)))
(user-error "No filter at point?")
- (when (y-or-n-p (format "Delete filter %s? " phrase))
- (let ((response (mastodon-http--delete url)))
- (mastodon-http--triage
- response (lambda (_)
- (mastodon-views--view-filters)
- (message "Filter for \"%s\" deleted!" phrase))))))))
+ (when (y-or-n-p (format "Delete filter %s? " title))
+ (let ((resp (mastodon-http--delete url)))
+ (mastodon-views--filters-triage
+ resp
+ (message "Filter \"%s\" deleted!" title)))))))
+
+(defun mastodon-views--get-filter-kw (&optional id)
+ "GET filter with ID."
+ (let* ((id (or id (mastodon-tl--property 'kw-id :no-move)))
+ (url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
+ (resp (mastodon-http--get-json url)))
+ resp))
+
+(defun mastodon-views--update-filter-kw ()
+ "Update filter keyword.
+Prmopt to change the term, and the whole words option.
+When t, whole words means only match whole words."
+ (interactive)
+ (if (not (eq 'filter (mastodon-tl--property 'item-type)))
+ (user-error "No filter at point?")
+ (let* ((kws (alist-get 'keywords
+ (mastodon-tl--property 'item-json :no-move)))
+ (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws))
+ (choice (completing-read "Update keyword: " alist))
+ (updated (read-string "Keyword: " choice))
+ (whole-word (if (y-or-n-p "Match whole words only? ")
+ "true"
+ "false"))
+ (params `(("keyword" . ,updated)
+ ("whole_word" . ,whole-word)))
+ (id (cdr (assoc choice alist #'equal)))
+ (url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
+ (resp (mastodon-http--put url params)))
+ (mastodon-views--filters-triage resp
+ (format "Keyword %s updated!" updated)))))
+
+(defun mastodon-views--filters-triage (resp msg-str)
+ "Triage filter action response RESP, reload filters, message MSG-STR."
+ (mastodon-http--triage
+ resp
+ (lambda (_resp)
+ (when (mastodon-tl--buffer-type-eq 'filters)
+ (mastodon-views--view-filters))
+ (message msg-str))))
+
+(defun mastodon-views--add-filter-kw ()
+ "Add a keyword to filter at point."
+ (interactive)
+ (if (not (eq 'filter (mastodon-tl--property 'item-type)))
+ (user-error "No filter at point?")
+ (let* ((kw (read-string "Keyword: "))
+ (id (mastodon-tl--property 'item-id :no-move))
+ (whole-word (if (y-or-n-p "Match whole words only? ")
+ "true"
+ "false"))
+ (params `(("keyword" . ,kw)
+ ("whole_word" . ,whole-word)))
+ (url (mastodon-http--api-v2 (format "filters/%s/keywords" id)))
+ (resp (mastodon-http--post url params)))
+ (mastodon-views--filters-triage resp
+ (format "Keyword %s added!" kw)))))
+
+(defun mastodon-views--remove-filter-kw ()
+ "Remove keyword from filter at point."
+ (interactive)
+ (if (not (eq 'filter (mastodon-tl--property 'item-type)))
+ (user-error "No filter at point?")
+ (let* ((kws (alist-get 'keywords
+ (mastodon-tl--property 'item-json :no-move)))
+ (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws))
+ (choice (completing-read "Remove keyword: " alist))
+ (id (cdr (assoc choice alist #'equal)))
+ (url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
+ (resp (mastodon-http--delete url)))
+ (mastodon-views--filters-triage resp (format "Keyword %s removed!" choice)))))
;;; FOLLOW SUGGESTIONS
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 02:13:33 +0000