X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/61181450bc063b30e5d0208661d0b9f541119f4b..f67381a06e5483b88876d9d1855bc5b71fe4e88d:/dot/ercrc.el diff --git a/dot/ercrc.el b/dot/ercrc.el index a84d63f..a539010 100644 --- a/dot/ercrc.el +++ b/dot/ercrc.el @@ -46,18 +46,53 @@ matches SERVER-REGEXP.") "*Alist of (SERVER-REGEXP ACCT PASSWD). Login details for claiming server admin rights.") +(defun mdw-remprop-nondestructive (indic plist) + "Return a plist like PLIST, only without the first entry for INDIC. +The PLIST is not itself modified." + (if (getf plist indic) + (let* ((head (cons nil nil)) + (tail head)) + (while (and plist (not (eq (car plist) indic))) + (let* ((i (pop plist)) (v (pop plist)) + (vv (cons v nil)) (ii (cons i vv))) + (rplacd tail ii) + (setq tail vv))) + (rplacd tail (cddr plist)) + (cdr head)) + plist)) + +(defmacro* mdw-pushnew-replace + (item place &rest keys &key (key '#'identity) &allow-other-keys) + "Add ITEM to the list PLACE, replacing any existing matching item. +Specifically, any item in the list satisfying the test are removed +\(nondestructively), and then the new ITEM is added to the front. + +Evaluation order for the keywords is a bit screwy: don't rely on it." + ;; `cl-setf-do-modify' returns a list (LETS STORE FETCH). + (let ((setf-things (cl-setf-do-modify place (cons 'list keys))) + (keyfn (gensym "key")) + (itemvar (gensym "item"))) + `(let ((,keyfn ,key) + (,itemvar ,item) + ,@(car setf-things)) + ,(cl-setf-do-store (cadr setf-things) + `(cons ,itemvar + (remove* (funcall ,keyfn ,itemvar) + ,(caddr setf-things) + :key ,keyfn + ,@(mdw-remprop-nondestructive + :key keys))))))) + (defun mdw-define-bot-greeting (server bot greeting) "Define a new bot greeting." - (setq mdw-erc-auto-greet-bots-alist - (cons (list server bot greeting) - (remove* server mdw-erc-auto-greet-bots-alist - :test #'string= :key #'car)))) + (mdw-pushnew-replace (list server bot greeting) + mdw-erc-auto-greet-bots-alist + :test #'string= :key #'car)) (defun mdw-add-ircop-credentials (server acct passwd) "Define a new set of `ircop' credentials." - (setq mdw-erc-ircop-alist - (cons (list server acct passwd) - (remove* server mdw-erc-ircop-alist - :test #'string= :key #'car))))) + (mdw-pushnew-replace (list server acct passwd) + mdw-erc-ircop-alist + :test #'string= :key #'car)) (load "~/.erc-auth.el") (defun mdw-assoc-regexp (regexp alist)