aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/erc/erc-bbdb.el
diff options
context:
space:
mode:
authorAmin Bandali2020-09-09 23:20:34 -0400
committerAmin Bandali2020-09-10 00:19:37 -0400
commitdcab4d0f0c3e480846c4337ff231dc55eb26124f (patch)
tree93ce6abef96b136410391da1e0044b16aaf8e2e5 /lisp/erc/erc-bbdb.el
parent931b9f5953013c1e8844d0c723411b87ccfedb1a (diff)
downloademacs-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.el269
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.
60Leaving this at nil is a good idea, but you can turn it
61on 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.
67Leaving this at nil is a good idea, but you can turn it
68on 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.
74Leaving this at nil is a good idea, but you can turn it
75on 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
81or the person who has just joined a channel.
82
83If set to 'visible, the BBDB buffer only pops up when someone was WHOISed
84or a person joined a channel visible on any frame.
85
86If 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.
109This is the name that a bitlbee (AIM/MSN/ICQ) contact provides as
110their \"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.
211This function typically gets called on a successful server connect.
212The 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
215counterparts `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