;;; cmail-bbdb-pre2_34.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-pre2_34.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 'cmail)

(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)

(defun bbdb/cmail-update-record (&optional offer-to-create)
  "Returns the record 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."
  (if bbdb-use-pop-up
      (bbdb/cmail-pop-up-bbdb-buffer offer-to-create)
    (save-excursion
      (let (from addr (inhibit-read-only t))
	(bbdb/cmail-open-header)
	(setq from (mail-fetch-field "From"))
	(if from
	    (setq addr (car (cdr (mail-extract-address-components from)))))
	(if (or (null from)
		(null addr)
		(string-match (bbdb-user-mail-names) addr))
	    (setq from (or (mail-fetch-field "To")
			   from)))
	(if from
	    (bbdb-annotate-message-sender from t 
					  (or (bbdb-invoke-hook-for-value
					       bbdb/mail-auto-create-p)
					      offer-to-create)
					  offer-to-create))))))

(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-sender ()
  "Display the contents of the BBDB for the sender of this message.
This buffer will be in bbdb-mode, with associated keybindings."
  (interactive)
  (let ((record (bbdb/cmail-update-record t)))
    (if record
	(bbdb-display-records (list record))
      (error "unperson"))))

(defun bbdb/cmail-pop-up-bbdb-buffer (&optional offer-to-create)
  "Make the *BBDB* buffer be displayed along with the cmail windows,
displaying the record corresponding to the sender of the current message."
  (let ((framepop (eq temp-buffer-show-function 'framepop-display-buffer)))
    (or framepop
        (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)))))))
    (let ((bbdb-gag-messages t)
          (bbdb-use-pop-up nil)
          (bbdb-electric-p nil))
      (let ((record (bbdb/cmail-update-record offer-to-create))
            (bbdb-elided-display (bbdb-pop-up-elided-display))
            (b (current-buffer)))
        (if framepop
            (if record
                (bbdb-display-records (list record))
              (framepop-banish))
	  (if record
	      (bbdb-display-records (list record))
	    (delete-window (get-buffer-window bbdb-buffer-name))))
        (set-buffer b)
        record))))

(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))
    (bbdb/cmail-mode)))

(defun bbdb/cmail-mode ()
  "Major mode for parsing header fields in BBDB."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'bbdb/cmail-mode)
  (setq mode-name "BBDB-cmail")
  (run-hooks 'bbdb/cmail-mode-hook)
  (set-buffer-modified-p nil)
  (setq buffer-read-only t))

(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-update-record '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-pre2_34)

;;; cmail-bbdb-pre2_34.el ends here.
