cgit.sxemacs.org Git - packages/blob - xemacs-packages/erc/erc-bbdb.el

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