;;; cmail-bbdb-curver.el --- BBDB interface to cmail

;; Copyright (C) 1991, 1992 Jamie Zawinski
;; Copyright (C) 1996 Shuhei KOBAYASHI
;; Copyright (C) 1999 Kazuhiro Ohta

;; Author: Jamie Zawinski <jwz@netscape.com>
;;         Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
;;         Kazuhiro Ohta <ohta@ele.cst.nihon-u.ac.jp>
;; Created: 1996/09/26
;; Version: 
;;     $Id: cmail-bbdb-curver.el,v 1.1 2002/09/07 15:13:42 tmp Exp $
;; Keywords: mail, BBDB

;; This file is not part of BBDB (Insidious Big Brother Database).

;; This program 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.

;; This program 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 this program; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Installation:
;; 
;; Turn on cmail-use-bbdb from Customize, or insert the following line
;; in your ~/.emacs:
;;
;;       (setq cmail-use-bbdb t)
;;

;;; Codes:

(require 'bbdb)
(require 'bbdb-snarf)
(require 'cmail)

(eval-and-compile
  (require 'bbdb-com)
  (require 'rfc822))

(defvar bbdb/cmail-buffer "*BBDB-cmail*")

(defvar signature-separator "-- \n"
  "*String to separate contents and signature.")

(defvar bbdb/cmail-signature-limit nil
   "Provide a limit to what is considered a signature.
If it is a number, no signature may not be longer (in characters) than
that number.  If it is a floating point number, no signature may be
longer (in lines) than that number.  If it is a function, the function
will be called without any parameters, and if it returns nil, there is
no signature in the buffer.  If it is a string, it will be used as a
regexp.  If it matches, the text in question is not a signature.")

(autoload 'bbdb-snarf-region "bbdb-snarf" "\
snarf up a bbdb record in the current region.  See `bbdb-snarf' for
more details." t nil)

(defvar bbdb/cmail-update-records-mode 'annotating
  "Controls how `bbdb/cmail-update-records' processes email addresses.
Set this to an expression which evaluates either to 'searching or
'annotating.  When set to 'annotating email addresses will be fed to
`bbdb-annotate-message-sender' in order to update existing records or create
new ones.  A value of 'searching will search just for existing records having
the right net.

annotating = annotating all messages
searching = annotating no messages")

(defun bbdb/cmail-update-record (&optional offer-to-create)
  (let* ((bbdb-get-only-first-address-p t)
         (records (bbdb/cmail-update-records offer-to-create)))
    (if records (car records) nil)))

(defun bbdb/cmail-update-records (&optional offer-to-create)
  "Return the records corresponding to the current cmail message, creating
or modifying it as necessary.  A record will be created if
bbdb/mail-auto-create-p is non-nil or if OFFER-TO-CREATE is true
and the user confirms the creation.

The variable `bbdb/cmail-update-records-mode' controls what actions
are performed and it might override `bbdb-update-records-mode'.

When hitting C-g once you will not be asked anymore for new people listed
in this message, but it will search only for existing records.  When hitting
C-g again it will stop scanning."
  (let ((bbdb/cmail-offer-to-create offer-to-create)
        msg-id records cache)
    (save-excursion
      (bbdb/cmail-open-header)
      (setq msg-id (mail-fetch-field "Message-ID"))
      (if (and msg-id (not bbdb/cmail-offer-to-create))
          (setq cache (bbdb-message-cache-lookup msg-id)))

      (if cache
          (setq records (if bbdb-get-only-first-address-p
                            (list (car cache))
                          cache))

        (let ((bbdb-update-records-mode (or bbdb/cmail-update-records-mode
                                            bbdb-update-records-mode)))
          (setq records (bbdb-update-records
                         (bbdb-get-addresses
                          bbdb-get-only-first-address-p
			  bbdb-user-mail-names
                          'mail-fetch-field)
                         bbdb/mail-auto-create-p
                         offer-to-create)))
        (if (and bbdb-message-caching-enabled msg-id)
            (bbdb-encache-message msg-id records))))
    records))

(defun bbdb/cmail-annotate-sender (string &optional replace)
  "Add a line to the end of the Notes field of the BBDB record 
corresponding to the sender of this message.  If REPLACE is non-nil,
replace the existing notes entry (if any)."
  (interactive (list (if bbdb-readonly-p
			 (error "The Insidious Big Brother Database is read-only.")
		       (read-string "Comments: "))))
  (bbdb-annotate-notes (bbdb/cmail-update-record t) string 'notes replace))

(defun bbdb/cmail-edit-notes (&optional arg)
  "Edit the notes field or (with a prefix arg) a user-defined field
of the BBDB record corresponding to the sender of this message."
  (interactive "P")
  (let ((record (or (bbdb/cmail-update-record t) (error ""))))
    (bbdb-display-records (list record))
    (if arg
	(bbdb-record-edit-property record nil t)
      (bbdb-record-edit-notes record t))))

(defun bbdb/cmail-show-records (&optional address-class)
  "Display the contents of the BBDB for all addresses of this message.
This buffer will be in `bbdb-mode', with associated keybindings."
  (interactive)
  (cmail-select-buffer *cmail-summary-buffer)
  (let ((bbdb-get-addresses-headers
         (if address-class
             (list (assoc address-class bbdb-get-addresses-headers))
           bbdb-get-addresses-headers))
        (bbdb/cmail-update-records-mode 'annotating)
        (bbdb-message-cache nil)
        (bbdb-user-mail-names nil)
        records)
    (setq records (bbdb/cmail-update-records t))
    (if records
        (bbdb-display-records records)
      (bbdb-undisplay-records))
    records))

(defun bbdb/cmail-show-all-recipients ()
  "Show all recipients of this message. 
Counterpart to `bbdb/cmail-show-sender'."
  (interactive)
  (let ((bbdb-get-only-first-address-p nil))
    (bbdb/cmail-show-records 'recipients)))

(defun bbdb/cmail-show-sender (&optional show-recipients)
  "Display the contents of the BBDB for the senders of this message.
With a prefix argument show the recipients instead,
with two prefix arguments show all records.
This buffer will be in `bbdb-mode', with associated keybindings."
  (interactive "p")
  (cond ((= 4 show-recipients)
         (bbdb/cmail-show-all-recipients))
        ((= 16 show-recipients)
         (let ((bbdb-get-only-first-address-p nil))
           (bbdb/cmail-show-records)))
        (t
         (if (null (bbdb/cmail-show-records 'authors))
             (bbdb/cmail-show-all-recipients)))))

(defun bbdb/cmail-pop-up-bbdb-buffer (&optional offer-to-create)
  (save-excursion
    (let ((bbdb-gag-messages t)
          (bbdb-electric-p nil)
          (records (bbdb/cmail-update-records offer-to-create))
          (bbdb-buffer-name bbdb-buffer-name))

      (when (and bbdb-use-pop-up records)
        (bbdb-pop-up-bbdb-buffer
         (function (lambda (w)
                     (let ((b (current-buffer)))
                       (set-buffer (window-buffer w))
                       (prog1 (eq major-mode 'cmail-readmail-mode)
                         (set-buffer b))))))

        ;; Always update the records; if there are no records, empty the
        ;; BBDB window. This should be generic, not cmail-specific.
        (bbdb-display-records records bbdb-pop-up-display-layout))

      (when (not records)
        (bbdb-undisplay-records)
        (if (get-buffer-window bbdb-buffer-name)
            (delete-window (get-buffer-window bbdb-buffer-name)))))))

(defun bbdb/cmail-open-header ()
  "Open header fields to `bbdb/cmail-buffer'."
  (let ((num (cmail-get-page-number-from-summary)) beg end)
    (save-excursion
      (set-buffer (cmail-folder-buffer cmail-current-folder))
      (setq beg (cmail-n-page num))
      (setq end (cmail-head-max)))
    (set-buffer (get-buffer-create bbdb/cmail-buffer))
    (erase-buffer)
    (insert-buffer-substring (cmail-folder-buffer cmail-current-folder)
			     beg end)
    (goto-char (point-min))))

(defun bbdb/cmail-quit ()
  "Quit cmail-bbdb."
  (let ((buf (get-buffer bbdb/cmail-buffer)))
    (if buf (kill-buffer buf))))

(defun bbdb-insinuate-cmail ()
  "Call this function to hook BBDB into cmail."
  (add-hook 'cmail-show-contents-after-hook 'bbdb/cmail-pop-up-bbdb-buffer 'append)
  (add-hook 'cmail-quit-hook 'bbdb/cmail-quit)
  (define-key cmail-summary-mode-map ":" 'bbdb/cmail-show-sender)
  (define-key cmail-summary-mode-map ";" 'bbdb/cmail-edit-notes)
  )

(defun bbdb/cmail-snarf-signature ()
  "Snarf signature from the corresponding folder buffer."
  (interactive)
  (save-excursion
    (set-buffer (cmail-folder-buffer cmail-current-folder))
    (save-restriction
      (widen)
      (or (bbdb/cmail-narrow-to-signature) (error "No signature!"))
      (with-temp-buffer
	(insert-buffer (cmail-folder-buffer cmail-current-folder))
	(let ((code (detect-coding-region (point-min) (point-max))))
	  (if (listp code) (setq code (car code)))
	  (decode-coding-region (point-min) (point-max) code))
	(bbdb-snarf-region (point-min) (point-max))))))

(defun bbdb/cmail-narrow-to-signature ()
  "Narrow to the signature; return t if a signature is found, else nil."
  (when (bbdb/cmail-search-signature)
    (forward-line 1)
    ;; Check whether we have some limits to what we consider
    ;; to be a signature.
    (let ((limits (if (listp bbdb/cmail-signature-limit) 
		      bbdb/cmail-signature-limit
		    (list bbdb/cmail-signature-limit)))
	  limit limited)
      (while (setq limit (pop limits))
	(if (or (and (integerp limit)
		     (< (- (cmail-page-max) (point)) limit))
		(and (floatp limit)
		     (< (count-lines (point) (cmail-page-max)) limit))
		(and (functionp limit)
		     (funcall limit))
		(and (stringp limit)
		     (not (re-search-forward limit (cmail-page-max) t))))
	    ()				; This limit did not succeed.
	  (setq limited t
		limits nil)))
      (unless limited
	(narrow-to-region (point) (cmail-page-max))
	t))))

(defun bbdb/cmail-search-signature ()
  "Search the current buffer for the signature separator.
Put point at the beginning of the signature separator."
  (let ((cur (point)) beg num)
    (save-excursion
      (set-buffer *cmail-summary-buffer)
      (setq num (cmail-get-page-number-from-summary)))
    (cmail-n-page num)
    (setq beg (point))
    (goto-char (cmail-page-max))
    (if (if (stringp signature-separator)
	    (re-search-backward signature-separator beg t))
	t
      (goto-char cur)
      nil)))

(defun bbdb/cmail-get-address-list ()
  "Get network address list from BBDB. "
  (let (elem nets records comp-list)
    (setq records (bbdb-records))
    (while records
      (setq elem (car records))
      (setq nets (elt elem 6))	; get list of network address
      (while nets 
	(setq comp-list (cons (list (car nets)) comp-list))
	(setq nets (cdr nets)))
      (setq records (cdr records)))
    comp-list))

(provide 'cmail-bbdb-curver)

;;; cmail-curver.el ends here.
