;;; erc-bbdb.el --- Integrating the BBDB into ERC

;; Copyright (C) 2001, 2002, 2004, 2005, 2006,
;;   2007 Free Software Foundation, Inc.

;; Author: Andreas Fuchs <asf@void.at>
;; Maintainer: Mario Lang <mlang@delysid.org>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; This mode connects the BBDB to ERC.  Whenever a known nick
;; connects, the corresponding BBDB record pops up.  To identify
;; users, use the irc-nick field.  Define it, if BBDB asks you about
;; that.  When you use /WHOIS on a known nick, the corresponding
;; record will be updated.

;;; History

;; Andreas Fuchs <asf@void.at> wrote zenirc-bbdb-whois.el, which was
;; adapted for ERC by Mario Lang <mlang@delysid.org>.

;; Changes by Edgar Gonçalves <edgar.goncalves@inesc-id.pt>
;; May 31 2005:
;;     - new variable: erc-bbdb-bitlbee-name-field - the field name for the
;;       msn/icq/etc nick
;;     - nick doesn't go the the name. now it asks for an existing record to
;;       merge with. If none, then create a new one with the nick as name.

;;; Code:

(require 'erc)
(require 'bbdb)
(require 'bbdb-com)
(require 'bbdb-gui)
(require 'bbdb-hooks)

(defgroup erc-bbdb nil
  "Variables related to BBDB usage."
  :group 'erc)

(defcustom erc-bbdb-auto-create-on-whois-p nil
  "*If nil, don't create bbdb records automatically when a WHOIS is done.
Leaving this at nil is a good idea, but you can turn it
on if you want to have lots of People named \"John Doe\" in your BBDB."
  :group 'erc-bbdb
  :type 'boolean)

(defcustom erc-bbdb-auto-create-on-join-p nil
  "*If nil, don't create bbdb records automatically when a person joins a channel.
Leaving this at nil is a good idea, but you can turn it
on if you want to have lots of People named \"John Doe\" in your BBDB."
  :group 'erc-bbdb
  :type 'boolean)

(defcustom erc-bbdb-auto-create-on-nick-p nil
  "*If nil, don't create bbdb records automatically when a person changes her nick.
Leaving this at nil is a good idea, but you can turn it
on if you want to have lots of People named \"John Doe\" in your BBDB."
  :group 'erc-bbdb
  :type 'boolean)

(defcustom erc-bbdb-popup-type 'visible
  "*If t, pop up a BBDB buffer showing the record of a WHOISed person
or the person who has just joined a channel.

If set to 'visible, the BBDB buffer only pops up when someone was WHOISed
or a person joined a channel visible on any frame.

If set to nil, never pop up a BBDD buffer."
  :group 'erc-bbdb
  :type '(choice (const :tag "When visible" visible)
		 (const :tag "When joining" t)
		 (const :tag "Never" nil)))

(defcustom erc-bbdb-irc-nick-field 'irc-nick
  "The notes field name to use for annotating IRC nicknames."
  :group 'erc-bbdb
  :type 'symbol)

(defcustom erc-bbdb-irc-channel-field 'irc-channel
  "The notes field name to use for annotating IRC channels."
  :group 'erc-bbdb
  :type 'symbol)

(defcustom erc-bbdb-irc-highlight-field 'irc-highlight
  "The notes field name to use for highlighting a person's messages."
  :group 'erc-bbdb
  :type 'symbol)

(defcustom erc-bbdb-bitlbee-name-field 'bitlbee-name
  "The notes field name to use for annotating bitlbee displayed name.
This is the name that a bitlbee (AIM/MSN/ICQ) contact provides as
their \"displayed name\"."
  :group 'erc-bbdb
  :type 'symbol)

(defcustom erc-bbdb-elide-display nil
  "*If t, show BBDB popup buffer elided."
  :group 'erc-bbdb
  :type 'boolean)

(defcustom erc-bbdb-electric-p nil
  "*If t, BBDB popup buffer is electric."
  :group 'erc-bbdb
  :type 'boolean)

(defun erc-bbdb-search-name-and-create (create-p name nick finger-host silent)
  (let* ((ircnick (cons erc-bbdb-irc-nick-field (concat "^"
							(regexp-quote nick))))
	 (finger (cons bbdb-finger-host-field (regexp-quote finger-host)))
	 (record (or (bbdb-search (bbdb-records) nil nil nil ircnick)
		     (and name (bbdb-search-simple name nil))
		     (bbdb-search (bbdb-records) nil nil nil finger)
		     (unless silent
		       (bbdb-completing-read-one-record
			"Merge using record of (C-g to skip, RET for new): "))
		     (when create-p
		       (bbdb-create-internal (or name
						 "John Doe")
					     nil nil nil nil nil)))))
    ;; sometimes, the record will be a list. I don't know why.
    (if (listp record)
	(car record)
      record)))

(defun erc-bbdb-show-entry (record channel proc)
  (let ((bbdb-display-layout (bbdb-grovel-elide-arg erc-bbdb-elide-display))
	(bbdb-electric-p erc-bbdb-electric-p))
    (when (and record (or (eq erc-bbdb-popup-type t)
			  (and (eq erc-bbdb-popup-type 'visible)
			       (and channel
				    (or (eq channel t)
					(get-buffer-window (erc-get-buffer
							    channel proc)
							   'visible))))))
      (bbdb-display-records (list record)))))

(defun erc-bbdb-insinuate-and-show-entry-1 (create-p proc nick name finger-host silent &optional chan new-nick)
  (let ((record (erc-bbdb-search-name-and-create
		 create-p nil nick finger-host silent))) ;; don't search for a name
    (when record
      (bbdb-annotate-notes record (or new-nick nick) erc-bbdb-irc-nick-field)
      (bbdb-annotate-notes record finger-host bbdb-finger-host-field)
      (and name
	   (bbdb-annotate-notes record name erc-bbdb-bitlbee-name-field t))
      (and chan
	   (not (eq chan t))
	   (bbdb-annotate-notes record chan erc-bbdb-irc-channel-field))
      (erc-bbdb-highlight-record record)
      (erc-bbdb-show-entry record chan proc))))

(defun erc-bbdb-insinuate-and-show-entry (create-p proc nick name finger-host silent &optional chan new-nick)
  ;; run this outside of the IRC filter process, to avoid an annoying
  ;; error when the user hits C-g
  (run-at-time nil nil
	       #'erc-bbdb-insinuate-and-show-entry-1
	       create-p proc nick name finger-host silent chan new-nick))

(defun erc-bbdb-whois (proc parsed)
  (let (; We could use server name too, probably
	(nick (second (erc-response.command-args parsed)))
	(name (erc-response.contents parsed))
	(finger-host (concat (third (erc-response.command-args parsed))
			     "@"
			     (fourth (erc-response.command-args parsed)))))
    (erc-bbdb-insinuate-and-show-entry erc-bbdb-auto-create-on-whois-p proc
				       nick name finger-host nil t)))

(defun erc-bbdb-JOIN (proc parsed)
  (let* ((sender (erc-parse-user (erc-response.sender parsed)))
	 (nick (nth 0 sender)))
    (unless (string= nick (erc-current-nick))
      (let* ((channel (erc-response.contents parsed))
	     (finger-host (concat (nth 1 sender) "@" (nth 2 sender))))
	  (erc-bbdb-insinuate-and-show-entry
	   erc-bbdb-auto-create-on-join-p proc
	   nick nil finger-host t channel)))))

(defun erc-bbdb-NICK (proc parsed)
  "Annotate new nick name to a record in case it already exists."
  (let* ((sender (erc-parse-user (erc-response.sender parsed)))
	 (nick (nth 0 sender)))
    (unless (string= nick (erc-current-nick))
      (let* ((finger-host (concat (nth 1 sender) "@" (nth 2 sender))))
	(erc-bbdb-insinuate-and-show-entry
	 erc-bbdb-auto-create-on-nick-p proc
	 nick nil finger-host t nil (erc-response.contents parsed))))))

(defun erc-bbdb-init-highlighting-hook-fun (proc parsed)
  (erc-bbdb-init-highlighting))

(defun erc-bbdb-init-highlighting ()
  "Initialize the highlighting based on BBDB fields.
This function typically gets called on a successful server connect.
The field name in the BBDB which controls highlighting is specified by
`erc-bbdb-irc-highlight-field'. Fill in either \"pal\"
\"dangerous-host\" or \"fool\". They work exactly like their
counterparts `erc-pals', `erc-dangerous-hosts' and `erc-fools'."
  (let* ((irc-highlight (cons erc-bbdb-irc-highlight-field
			      ".+"))
	(matching-records (bbdb-search (bbdb-records)
				       nil nil nil irc-highlight)))
    (mapcar 'erc-bbdb-highlight-record matching-records)))

(defun erc-bbdb-highlight-record (record)
  (let* ((notes (bbdb-record-raw-notes record))
	 (highlight-field (assoc erc-bbdb-irc-highlight-field notes))
	 (nick-field      (assoc erc-bbdb-irc-nick-field notes)))
    (if (and highlight-field
	     nick-field)
	(let ((highlight-types (split-string (cdr highlight-field)
					     bbdb-notes-default-separator))
	      (nick-names (split-string (cdr nick-field)
					(concat "\\(\n\\|"
						bbdb-notes-default-separator
						"\\)"))))
	  (mapcar
	   (lambda (highlight-type)
	     (mapcar
	      (lambda (nick-name)
		(if (member highlight-type
			    '("pal" "dangerous-host" "fool"))
		    (add-to-list (intern (concat "erc-" highlight-type "s"))
				 (regexp-quote nick-name))
		  (error (format "\"%s\" (in \"%s\") is not a valid highlight type!"
				 highlight-type nick-name))))
	      nick-names))
	   highlight-types)))))

;;;###autoload (autoload 'erc-bbdb-mode "erc-bbdb")
(define-erc-module bbdb nil
  "In ERC BBDB mode, you can directly interact with your BBDB."
  ((add-hook 'erc-server-311-functions 'erc-bbdb-whois t)
   (add-hook 'erc-server-JOIN-functions 'erc-bbdb-JOIN t)
   (add-hook 'erc-server-NICK-functions 'erc-bbdb-NICK t)
   (add-hook 'erc-server-376-functions 'erc-bbdb-init-highlighting-hook-fun t))
  ((remove-hook 'erc-server-311-functions 'erc-bbdb-whois)
   (remove-hook 'erc-server-JOIN-functions 'erc-bbdb-JOIN)
   (remove-hook 'erc-server-NICK-functions 'erc-bbdb-NICK)
   (remove-hook 'erc-server-376-functions 'erc-bbdb-init-highlighting-hook-fun)))

(provide 'erc-bbdb)

;;; erc-bbdb.el ends here
;;
;; Local Variables:
;; indent-tabs-mode: t
;; tab-width: 8
;; End:

;; arch-tag: 1edf3729-cd49-47dc-aced-70fcfc28c815