| ;; -*- lexical-binding: t; -*-
|
|
|
| (defvar erc-x-hide-tree nil "Erc network-channel trie specifying messages types to hide")
|
|
|
| (defun erc-x--hide-current-network ()
|
| "Return the name of the current network."
|
| (or (and (erc-network) (erc-network-name))
|
| (erc-shorten-server-name
|
| (or erc-server-announced-name
|
| erc-session-server))))
|
|
|
| (defun erc-x-hide-tree-p (command &optional channel network)
|
| "Query ERC-X-HIDE-TREE"
|
| (setq network (or network (erc-x--hide-current-network)))
|
| (setq channel (or channel (buffer-name)))
|
| (if-let* ((network-node (assoc network erc-x-hide-tree))
|
| (channel-node (assoc channel (cdr network-node))))
|
| (and (member command (cdr channel-node)) command)))
|
|
|
| (defun erc-x-hide-tree-message-p (parsed)
|
| "Query ERC-X-HIDE-TREE whether to hide a recieved message."
|
| (erc-x-hide-tree-p (erc-response.command parsed) (car (erc-response.command-args parsed))))
|
|
|
| (advice-add 'erc-hide-current-message-p :after-until 'erc-x-hide-tree-message-p)
|
|
|
| (defun erc-x--hide-JOIN (obj) (oset obj value (erc-x-hide-tree-p "JOIN")))
|
| (defun erc-x--hide-PART (obj) (oset obj value (erc-x-hide-tree-p "PART")))
|
| (defun erc-x--hide-KICK (obj) (oset obj value (erc-x-hide-tree-p "KICK")))
|
| (defun erc-x--hide-QUIT (obj) (oset obj value (when-let* ((network (erc-x--hide-current-network))
|
| (node (assoc network erc-network-hide-list)))
|
| (member "QUIT" (cdr node)))))
|
|
|
| (transient-define-prefix erc-x-hide ()
|
| "Transient to hide message types in the current channel"
|
| [:class transient-row "Channel"
|
| ("J" "JOIN" "JOIN" :init-value erc-x--hide-JOIN)
|
| ("K" "KICK" "KICK" :init-value erc-x--hide-KICK)
|
| ("P" "PART" "PART" :init-value erc-x--hide-PART)]
|
| [:class transient-row "Network"
|
| ("Q" "QUIT" "QUIT" :init-value erc-x--hide-QUIT)]
|
| [("RET" "Apply" erc-x-hide-apply)])
|
|
|
| (defun erc-x-hide-apply (&optional args)
|
| "Hide the given message types in the current channel."
|
| (interactive (list (transient-args 'erc-x-hide)))
|
| (when-let* ((network (erc-x--hide-current-network)))
|
| (let* ((selection (member "QUIT" args))
|
| (network-node (or (assoc network erc-network-hide-list)
|
| (and args (let ((entry (list network)))
|
| (push entry erc-network-hide-list)
|
| entry))))
|
| (current (member "QUIT" (cdr network-node))))
|
| (cond
|
| ((and selection (not current))
|
| (push "QUIT" (cdr network-node)))
|
| ((and (not selection) current)
|
| (setf (cdr network-node) (delete "QUIT" (cdr network-node)))))
|
| (when selection
|
| (setq args (delete "QUIT" args)))
|
| (when (and network-node (not (cdr network-node)))
|
| (setq erc-network-hide-list (delete network-node erc-network-hide-list))))
|
| (let* ((network-node (or (assoc network erc-x-hide-tree)
|
| (and args (let ((entry (list network)))
|
| (push entry erc-x-hide-tree)
|
| entry))))
|
| (channel-node (or (assoc (buffer-name) (cdr network-node))
|
| (and args (let ((entry (list (buffer-name))))
|
| (push entry (cdr network-node))
|
| entry)))))
|
| (when channel-node
|
| (setf (cdr channel-node) args))
|
| (when (and channel-node (not (cdr channel-node)))
|
| (setf (cdr network-node) (delete channel-node (cdr network-node))))
|
| (when (and network-node (not (cdr network-node)))
|
| (setq erc-x-hide-tree (delete network-node erc-x-hide-tree))))))
|