diff options
Diffstat (limited to 'lisp/mastodon-views.el')
| -rw-r--r-- | lisp/mastodon-views.el | 263 |
1 files changed, 206 insertions, 57 deletions
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 |