mdw@git.distorted.org.uk Git - profile/blob - dot/ercrc.el

   1 ;;; -*-emacs-lisp-*-
   2 ;;;
   3 ;;; ERC configuration
   4
   5 (setq erc-nick "mdw"
   6       erc-user-full-name "Mark Wooding")
   7
   8 (dolist (module '(replace truncate))
   9   (if (not (memq module erc-modules))
  10       (setq erc-modules (cons module erc-modules))))
  11
  12 (setq erc-fill-column 76
  13       erc-timestamp-right-column 68
  14       erc-fill-prefix "   "
  15       erc-max-buffer-size (* 60 3000))
  16
  17 ;; Filter out emoji, which cause severe display confusion.
  18 (defun mdw-replace-wide-characters (string)
  19   (with-output-to-string
  20     (let ((i 0)
  21           (state nil))
  22       (while (< i (length string))
  23         (let ((ch (aref string i)))
  24           (cond ((and (= (char-width ch) 1)
  25                       (not (or (<= #x1f200 ch #x1ffff))))
  26                  (when state (princ "*]") (setf state nil))
  27                  (write-char ch))
  28                 (t
  29                  (princ (if state "*" "[*"))
  30                  (princ (format "#x%x" ch))
  31                  (setf state t))))
  32         (setq i (1+ i)))
  33       (when state (princ "*]")))))
  34
  35 (setq erc-replace-alist
  36       '(("[[:nonascii:]+]" . mdw-replace-wide-characters)))
  37
  38 (setq erc-track-exclude-types '("NICK" "JOIN" "PART"))
  39
  40 (setq erc-auto-query 'buffer)
  41
  42 (defun mdw-erc-turn-off-truncate-lines ()
  43   (setq truncate-lines nil
  44         truncate-partial-with-windows nil
  45         word-wrap t
  46         wrap-prefix (concat (propertize "    " 'face 'erc-prompt-face)
  47                             " ")))
  48 (add-hook 'erc-mode-hook 'mdw-erc-turn-off-truncate-lines)
  49
  50 (setq erc-autojoin t
  51       erc-autojoin-domain-only nil
  52       erc-autojoin-channels-alist
  53       '(("chiark.greenend.org.uk" "#chiark")
  54         ("irc.distorted.org.uk" "#distorted" "#jukebox")
  55         ("irc.hstg.corp.good.com" "#hstg")))
  56 (erc-autojoin-mode 1)
  57
  58 (defvar mdw-erc-auto-greet-bots-alist nil
  59   "*Alist of (SERVER-REGEXP BOT-NICK MESSAGE-FORM).
  60 Evaluate MESSAGE-FORM and sent to BOT-NICK when connected to a server which
  61 matches SERVER-REGEXP.")
  62
  63 (defvar mdw-erc-ircop-alist nil
  64   "*Alist of (SERVER-REGEXP ACCT PASSWD).
  65 Login details for claiming server admin rights.")
  66
  67 (defun mdw-remprop-nondestructive (indic plist)
  68   "Return a plist like PLIST, only without the first entry for INDIC.
  69 The PLIST is not itself modified."
  70   (if (getf plist indic)
  71       (let* ((head (cons nil nil))
  72              (tail head))
  73         (while (and plist (not (eq (car plist) indic)))
  74           (let* ((i (pop plist)) (v (pop plist))
  75                  (vv (cons v nil)) (ii (cons i vv)))
  76             (rplacd tail ii)
  77             (setq tail vv)))
  78         (rplacd tail (cddr plist))
  79         (cdr head))
  80     plist))
  81
  82 (defun* mdw-cons-replace
  83     (item list &rest keys &key (key '#'identity) &allow-other-keys)
  84   "Return LIST, with ITEM at the start, replacing any existing matching item.
  85 Specifically, any item in the list satisfying the test are removed
  86 \(nondestructively), and then the new ITEM is added to the front."
  87   (cons item (apply #'remove* (funcall key item) list :key key
  88                     (mdw-remprop-nondestructive :key keys))))
  89
  90 (defmacro* mdw-pushnew-replace (item place &rest keys)
  91   "Add ITEM to the list PLACE, replacing any existing matching item.
  92 Specifically, any item in the list satisfying the test are removed
  93 \(nondestructively), and then the new ITEM is added to the front.
  94
  95 Evaluation order for the keywords is a bit screwy: don't rely on it."
  96   (cond ((fboundp 'cl-callf2)
  97          `(cl-callf2 mdw-cons-replace ,item ,place ,@keys))
  98         ((fboundp 'cl-setf-do-modify)
  99          ;; `cl-setf-do-modify' returns a list (LETS STORE FETCH).
 100          (let ((setf-things (cl-setf-do-modify place (cons 'list keys))))
 101            `(let (,@(car setf-things))
 102               ,(cl-setf-do-store (cadr setf-things)
 103                                  `(mdw-cons-replace ,item ,place
 104                                                     ,@keys)))))
 105         (t (error "Don't know how to hack places on this Emacs."))))
 106
 107 (defun mdw-define-bot-greeting (server bot greeting)
 108   "Define a new bot greeting."
 109   (mdw-pushnew-replace (list server bot greeting)
 110                        mdw-erc-auto-greet-bots-alist
 111                        :test #'string= :key #'car))
 112 (defun mdw-add-ircop-credentials (server acct passwd)
 113   "Define a new set of `ircop' credentials."
 114   (mdw-pushnew-replace (list server acct passwd)
 115                        mdw-erc-ircop-alist
 116                        :test #'string= :key #'car))
 117
 118 (defun mdw-assoc-regexp (regexp alist)
 119   "Return the association in ALIST whose car matches REGEXP."
 120   (let ((answer nil))
 121     (dolist (l alist)
 122       (when (string-match (car l) regexp)
 123         (setq answer l)))
 124     answer))
 125
 126 (defun mdw-erc-auto-greet-bots (server nick)
 127   "Send greeting message to bots."
 128   (let ((a (mdw-assoc-regexp server mdw-erc-auto-greet-bots-alist)))
 129     (when a
 130       (let ((bot (cadr a))
 131             (message (caddr a)))
 132         (erc-server-send (concat "PRIVMSG " bot " :" message))))))
 133 (add-hook 'erc-after-connect 'mdw-erc-auto-greet-bots)
 134
 135 (defun erc-cmd-GREET ()
 136   "Send greeting messages, according to `mdw-erc-auto-greet-bots-alist'."
 137   (mdw-erc-auto-greet-bots erc-session-server (erc-current-nick)))
 138
 139 (defun erc-cmd-IRCOP ()
 140   "Claim `ircop' privileges."
 141   (let ((a (mdw-assoc-regexp erc-session-server mdw-erc-ircop-alist)))
 142     (when a
 143       (let ((acct (cadr a))
 144             (passwd (caddr a)))
 145         (erc-server-send (concat "OPER " acct " " passwd))))))
 146
 147 (load "~/.erc-auth.el")
 148 (load "~/.erc-local.el")