diff options
| author | Amin Bandali | 2020-09-09 23:20:34 -0400 |
|---|---|---|
| committer | Amin Bandali | 2020-09-10 00:19:37 -0400 |
| commit | dcab4d0f0c3e480846c4337ff231dc55eb26124f (patch) | |
| tree | 93ce6abef96b136410391da1e0044b16aaf8e2e5 /lisp/erc/erc-bbdb.el | |
| parent | 931b9f5953013c1e8844d0c723411b87ccfedb1a (diff) | |
| download | emacs-scratch/erc-oldies.tar.gz emacs-scratch/erc-oldies.zip | |
Import erc-bbdb.el, erc-chess.el, erc-nicklist.el, and erc-speak.elscratch/erc-oldies
* lisp/erc/erc-bbdb.el, lisp/erc/erc-chess.el,
lisp/erc/erc-nicklist.el, lisp/erc/erc-speak.el: Import these files
from commit 9497cc92bf1feb63c24425c46b1e033265c2cea9 of
https://git.savannah.gnu.org/cgit/erc.git, the old ERC repository
outside the GNU Emacs source tree. These FSF-copyrighted files were
part of ERC before erc.git was (for the most part) folded into
emacs.git, but they were left out largely due to depending on packages
outside Emacs. It is worth noting that their dependencies are all
free software, and bbdb and chess are actually available on GNU ELPA.
Diffstat (limited to 'lisp/erc/erc-bbdb.el')
| -rw-r--r-- | lisp/erc/erc-bbdb.el | 269 |
1 files changed, 269 insertions, 0 deletions
diff --git a/lisp/erc/erc-bbdb.el b/lisp/erc/erc-bbdb.el new file mode 100644 index 00000000000..7d27f7f4868 --- /dev/null +++ b/lisp/erc/erc-bbdb.el | |||
| @@ -0,0 +1,269 @@ | |||
| 1 | ;;; erc-bbdb.el --- Integrating the BBDB into ERC | ||
| 2 | |||
| 3 | ;; Copyright (C) 2001, 2002, 2004, 2005, 2006, 2007 | ||
| 4 | ;; 2008, 2009 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Andreas Fuchs <asf@void.at> | ||
| 7 | ;; Maintainer: Mario Lang <mlang@delysid.org> | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 14 | ;; any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 24 | ;; Boston, MA 02110-1301, USA. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | |||
| 28 | ;; This mode connects the BBDB to ERC. Whenever a known nick | ||
| 29 | ;; connects, the corresponding BBDB record pops up. To identify | ||
| 30 | ;; users, use the irc-nick field. Define it, if BBDB asks you about | ||
| 31 | ;; that. When you use /WHOIS on a known nick, the corresponding | ||
| 32 | ;; record will be updated. | ||
| 33 | |||
| 34 | ;;; History | ||
| 35 | |||
| 36 | ;; Andreas Fuchs <asf@void.at> wrote zenirc-bbdb-whois.el, which was | ||
| 37 | ;; adapted for ERC by Mario Lang <mlang@delysid.org>. | ||
| 38 | |||
| 39 | ;; Changes by Edgar Gonçalves <edgar.goncalves@inesc-id.pt> | ||
| 40 | ;; May 31 2005: | ||
| 41 | ;; - new variable: erc-bbdb-bitlbee-name-field - the field name for the | ||
| 42 | ;; msn/icq/etc nick | ||
| 43 | ;; - nick doesn't go the the name. now it asks for an existing record to | ||
| 44 | ;; merge with. If none, then create a new one with the nick as name. | ||
| 45 | |||
| 46 | ;;; Code: | ||
| 47 | |||
| 48 | (require 'erc) | ||
| 49 | (require 'bbdb) | ||
| 50 | (require 'bbdb-com) | ||
| 51 | (require 'bbdb-gui) | ||
| 52 | (require 'bbdb-hooks) | ||
| 53 | |||
| 54 | (defgroup erc-bbdb nil | ||
| 55 | "Variables related to BBDB usage." | ||
| 56 | :group 'erc) | ||
| 57 | |||
| 58 | (defcustom erc-bbdb-auto-create-on-whois-p nil | ||
| 59 | "*If nil, don't create bbdb records automatically when a WHOIS is done. | ||
| 60 | Leaving this at nil is a good idea, but you can turn it | ||
| 61 | on if you want to have lots of People named \"John Doe\" in your BBDB." | ||
| 62 | :group 'erc-bbdb | ||
| 63 | :type 'boolean) | ||
| 64 | |||
| 65 | (defcustom erc-bbdb-auto-create-on-join-p nil | ||
| 66 | "*If nil, don't create bbdb records automatically when a person joins a channel. | ||
| 67 | Leaving this at nil is a good idea, but you can turn it | ||
| 68 | on if you want to have lots of People named \"John Doe\" in your BBDB." | ||
| 69 | :group 'erc-bbdb | ||
| 70 | :type 'boolean) | ||
| 71 | |||
| 72 | (defcustom erc-bbdb-auto-create-on-nick-p nil | ||
| 73 | "*If nil, don't create bbdb records automatically when a person changes her nick. | ||
| 74 | Leaving this at nil is a good idea, but you can turn it | ||
| 75 | on if you want to have lots of People named \"John Doe\" in your BBDB." | ||
| 76 | :group 'erc-bbdb | ||
| 77 | :type 'boolean) | ||
| 78 | |||
| 79 | (defcustom erc-bbdb-popup-type 'visible | ||
| 80 | "*If t, pop up a BBDB buffer showing the record of a WHOISed person | ||
| 81 | or the person who has just joined a channel. | ||
| 82 | |||
| 83 | If set to 'visible, the BBDB buffer only pops up when someone was WHOISed | ||
| 84 | or a person joined a channel visible on any frame. | ||
| 85 | |||
| 86 | If set to nil, never pop up a BBDD buffer." | ||
| 87 | :group 'erc-bbdb | ||
| 88 | :type '(choice (const :tag "When visible" visible) | ||
| 89 | (const :tag "When joining" t) | ||
| 90 | (const :tag "Never" nil))) | ||
| 91 | |||
| 92 | (defcustom erc-bbdb-irc-nick-field 'irc-nick | ||
| 93 | "The notes field name to use for annotating IRC nicknames." | ||
| 94 | :group 'erc-bbdb | ||
| 95 | :type 'symbol) | ||
| 96 | |||
| 97 | (defcustom erc-bbdb-irc-channel-field 'irc-channel | ||
| 98 | "The notes field name to use for annotating IRC channels." | ||
| 99 | :group 'erc-bbdb | ||
| 100 | :type 'symbol) | ||
| 101 | |||
| 102 | (defcustom erc-bbdb-irc-highlight-field 'irc-highlight | ||
| 103 | "The notes field name to use for highlighting a person's messages." | ||
| 104 | :group 'erc-bbdb | ||
| 105 | :type 'symbol) | ||
| 106 | |||
| 107 | (defcustom erc-bbdb-bitlbee-name-field 'bitlbee-name | ||
| 108 | "The notes field name to use for annotating bitlbee displayed name. | ||
| 109 | This is the name that a bitlbee (AIM/MSN/ICQ) contact provides as | ||
| 110 | their \"displayed name\"." | ||
| 111 | :group 'erc-bbdb | ||
| 112 | :type 'symbol) | ||
| 113 | |||
| 114 | (defcustom erc-bbdb-elide-display nil | ||
| 115 | "*If t, show BBDB popup buffer elided." | ||
| 116 | :group 'erc-bbdb | ||
| 117 | :type 'boolean) | ||
| 118 | |||
| 119 | (defcustom erc-bbdb-electric-p nil | ||
| 120 | "*If t, BBDB popup buffer is electric." | ||
| 121 | :group 'erc-bbdb | ||
| 122 | :type 'boolean) | ||
| 123 | |||
| 124 | (defun erc-bbdb-search-name-and-create (create-p name nick finger-host silent) | ||
| 125 | (let* ((ircnick (cons erc-bbdb-irc-nick-field (concat "^" | ||
| 126 | (regexp-quote nick)))) | ||
| 127 | (finger (cons bbdb-finger-host-field (regexp-quote finger-host))) | ||
| 128 | (record (or (bbdb-search (bbdb-records) nil nil nil ircnick) | ||
| 129 | (and name (bbdb-search-simple name nil)) | ||
| 130 | (bbdb-search (bbdb-records) nil nil nil finger) | ||
| 131 | (unless silent | ||
| 132 | (bbdb-completing-read-one-record | ||
| 133 | "Merge using record of (C-g to skip, RET for new): ")) | ||
| 134 | (when create-p | ||
| 135 | (bbdb-create-internal (or name | ||
| 136 | "John Doe") | ||
| 137 | nil nil nil nil nil))))) | ||
| 138 | ;; sometimes, the record will be a list. I don't know why. | ||
| 139 | (if (listp record) | ||
| 140 | (car record) | ||
| 141 | record))) | ||
| 142 | |||
| 143 | (defun erc-bbdb-show-entry (record channel proc) | ||
| 144 | (let ((bbdb-display-layout (bbdb-grovel-elide-arg erc-bbdb-elide-display)) | ||
| 145 | (bbdb-electric-p erc-bbdb-electric-p)) | ||
| 146 | (when (and record (or (eq erc-bbdb-popup-type t) | ||
| 147 | (and (eq erc-bbdb-popup-type 'visible) | ||
| 148 | (and channel | ||
| 149 | (or (eq channel t) | ||
| 150 | (get-buffer-window (erc-get-buffer | ||
| 151 | channel proc) | ||
| 152 | 'visible)))))) | ||
| 153 | (bbdb-display-records (list record))))) | ||
| 154 | |||
| 155 | (defun erc-bbdb-insinuate-and-show-entry-1 (create-p proc nick name finger-host silent &optional chan new-nick) | ||
| 156 | (let ((record (erc-bbdb-search-name-and-create | ||
| 157 | create-p nil nick finger-host silent))) ;; don't search for a name | ||
| 158 | (when record | ||
| 159 | (bbdb-annotate-notes record (or new-nick nick) erc-bbdb-irc-nick-field) | ||
| 160 | (bbdb-annotate-notes record finger-host bbdb-finger-host-field) | ||
| 161 | (and name | ||
| 162 | (bbdb-annotate-notes record name erc-bbdb-bitlbee-name-field t)) | ||
| 163 | (and chan | ||
| 164 | (not (eq chan t)) | ||
| 165 | (bbdb-annotate-notes record chan erc-bbdb-irc-channel-field)) | ||
| 166 | (erc-bbdb-highlight-record record) | ||
| 167 | (erc-bbdb-show-entry record chan proc)))) | ||
| 168 | |||
| 169 | (defun erc-bbdb-insinuate-and-show-entry (create-p proc nick name finger-host silent &optional chan new-nick) | ||
| 170 | ;; run this outside of the IRC filter process, to avoid an annoying | ||
| 171 | ;; error when the user hits C-g | ||
| 172 | (run-at-time 0.1 nil | ||
| 173 | #'erc-bbdb-insinuate-and-show-entry-1 | ||
| 174 | create-p proc nick name finger-host silent chan new-nick)) | ||
| 175 | |||
| 176 | (defun erc-bbdb-whois (proc parsed) | ||
| 177 | (let (; We could use server name too, probably | ||
| 178 | (nick (second (erc-response.command-args parsed))) | ||
| 179 | (name (erc-response.contents parsed)) | ||
| 180 | (finger-host (concat (third (erc-response.command-args parsed)) | ||
| 181 | "@" | ||
| 182 | (fourth (erc-response.command-args parsed))))) | ||
| 183 | (erc-bbdb-insinuate-and-show-entry erc-bbdb-auto-create-on-whois-p proc | ||
| 184 | nick name finger-host nil t))) | ||
| 185 | |||
| 186 | (defun erc-bbdb-JOIN (proc parsed) | ||
| 187 | (let* ((sender (erc-parse-user (erc-response.sender parsed))) | ||
| 188 | (nick (nth 0 sender))) | ||
| 189 | (unless (string= nick (erc-current-nick)) | ||
| 190 | (let* ((channel (erc-response.contents parsed)) | ||
| 191 | (finger-host (concat (nth 1 sender) "@" (nth 2 sender)))) | ||
| 192 | (erc-bbdb-insinuate-and-show-entry | ||
| 193 | erc-bbdb-auto-create-on-join-p proc | ||
| 194 | nick nil finger-host t channel))))) | ||
| 195 | |||
| 196 | (defun erc-bbdb-NICK (proc parsed) | ||
| 197 | "Annotate new nick name to a record in case it already exists." | ||
| 198 | (let* ((sender (erc-parse-user (erc-response.sender parsed))) | ||
| 199 | (nick (nth 0 sender))) | ||
| 200 | (unless (string= nick (erc-current-nick)) | ||
| 201 | (let* ((finger-host (concat (nth 1 sender) "@" (nth 2 sender)))) | ||
| 202 | (erc-bbdb-insinuate-and-show-entry | ||
| 203 | erc-bbdb-auto-create-on-nick-p proc | ||
| 204 | nick nil finger-host t nil (erc-response.contents parsed)))))) | ||
| 205 | |||
| 206 | (defun erc-bbdb-init-highlighting-hook-fun (proc parsed) | ||
| 207 | (erc-bbdb-init-highlighting)) | ||
| 208 | |||
| 209 | (defun erc-bbdb-init-highlighting () | ||
| 210 | "Initialize the highlighting based on BBDB fields. | ||
| 211 | This function typically gets called on a successful server connect. | ||
| 212 | The field name in the BBDB which controls highlighting is specified by | ||
| 213 | `erc-bbdb-irc-highlight-field'. Fill in either \"pal\" | ||
| 214 | \"dangerous-host\" or \"fool\". They work exactly like their | ||
| 215 | counterparts `erc-pals', `erc-dangerous-hosts' and `erc-fools'." | ||
| 216 | (let* ((irc-highlight (cons erc-bbdb-irc-highlight-field | ||
| 217 | ".+")) | ||
| 218 | (matching-records (bbdb-search (bbdb-records) | ||
| 219 | nil nil nil irc-highlight))) | ||
| 220 | (mapcar 'erc-bbdb-highlight-record matching-records))) | ||
| 221 | |||
| 222 | (defun erc-bbdb-highlight-record (record) | ||
| 223 | (let* ((notes (bbdb-record-raw-notes record)) | ||
| 224 | (highlight-field (assoc erc-bbdb-irc-highlight-field notes)) | ||
| 225 | (nick-field (assoc erc-bbdb-irc-nick-field notes))) | ||
| 226 | (if (and highlight-field | ||
| 227 | nick-field) | ||
| 228 | (let ((highlight-types (split-string (cdr highlight-field) | ||
| 229 | bbdb-notes-default-separator)) | ||
| 230 | (nick-names (split-string (cdr nick-field) | ||
| 231 | (concat "\\(\n\\|" | ||
| 232 | bbdb-notes-default-separator | ||
| 233 | "\\)")))) | ||
| 234 | (mapcar | ||
| 235 | (lambda (highlight-type) | ||
| 236 | (mapcar | ||
| 237 | (lambda (nick-name) | ||
| 238 | (if (member highlight-type | ||
| 239 | '("pal" "dangerous-host" "fool")) | ||
| 240 | (add-to-list (intern (concat "erc-" highlight-type "s")) | ||
| 241 | (regexp-quote nick-name)) | ||
| 242 | (error (format "\"%s\" (in \"%s\") is not a valid highlight type!" | ||
| 243 | highlight-type nick-name)))) | ||
| 244 | nick-names)) | ||
| 245 | highlight-types))))) | ||
| 246 | |||
| 247 | ;;;###autoload (autoload 'erc-bbdb-mode "erc-bbdb") | ||
| 248 | (define-erc-module bbdb nil | ||
| 249 | "In ERC BBDB mode, you can directly interact with your BBDB." | ||
| 250 | ((add-hook 'erc-server-311-functions 'erc-bbdb-whois t) | ||
| 251 | (add-hook 'erc-server-JOIN-functions 'erc-bbdb-JOIN t) | ||
| 252 | (add-hook 'erc-server-NICK-functions 'erc-bbdb-NICK t) | ||
| 253 | (add-hook 'erc-server-376-functions 'erc-bbdb-init-highlighting-hook-fun t)) | ||
| 254 | ((remove-hook 'erc-server-311-functions 'erc-bbdb-whois) | ||
| 255 | (remove-hook 'erc-server-JOIN-functions 'erc-bbdb-JOIN) | ||
| 256 | (remove-hook 'erc-server-NICK-functions 'erc-bbdb-NICK) | ||
| 257 | (remove-hook 'erc-server-376-functions 'erc-bbdb-init-highlighting-hook-fun))) | ||
| 258 | |||
| 259 | (provide 'erc-bbdb) | ||
| 260 | |||
| 261 | ;;; erc-bbdb.el ends here | ||
| 262 | ;; | ||
| 263 | ;; Local Variables: | ||
| 264 | ;; indent-tabs-mode: t | ||
| 265 | ;; tab-width: 8 | ||
| 266 | ;; coding: utf-8 | ||
| 267 | ;; End: | ||
| 268 | |||
| 269 | ;; arch-tag: 1edf3729-cd49-47dc-aced-70fcfc28c815 | ||