;;; cmail-nicknameb.el --- Look up a nickname with BBDB.

;; Author: Keisuke ICHIHASHI <ksuke@tky2.3web.ne.jp>
;; Keywords: mail
;; Create date: 2000-08-09
;; $Id: cmail-nicknameb.el,v 1.3 2002/09/07 15:13:42 tmp Exp $

;;; Code:
(require 'cmail-bbdb)
(eval-when-compile (require 'cmail-vars)
		   (require 'advice))

;;; user variables
(cmail-i18n-defcustom cmail-nickname-bbdb-prop 'nickname
  ((ja_JP . "*BBDB におけるニックネームプロパティの名前。")
   (en_US . "*The name of nickname's property in BBDB."))
  :type 'sexp
  :group 'cmail-all-variables
  :group 'cmail-use-nickname-group)

;;; internal variables
(defvar cmail-nickname-nickname-alist nil)
(defvar cmail-nickname-no-nickname-list nil)

;;;
(if cmail-summarize-format
    (save-excursion
      (let ((buf (get-buffer-create " *cmail-temp*")))
	(set-buffer buf)
	(delete-region (point-min) (point-max))
	(insert "(setq cmail-summarize-format \"" cmail-summarize-format "\")")
	(goto-char (point-min))
	(while (re-search-forward "%[-0-9]*n" nil t)
	  (delete-char -1)
	  (insert "e"))
	(eval-buffer)
	(kill-buffer buf)))
  (setq cmail-summarize-format "%d [%-17e] %I%j\n"))

(mapcar 'cmail-add-resource
	'((ask-nickname
	   ("Japanese" . "%s のニックネームは? ")
	   (t . "Nickname of %s ? "))
	  (nickname-ask-make-summary
	   ("Japanese" . "新しいニックネームでサマリを再表示しますか? ")
	   (t . "Redisplay summary with updated nickname? "))))

(defun cmail-nickname-get-nickname (addr)
  (cdr (assoc addr cmail-nickname-nickname-alist)))

(defun cmail-nickname-remove-nickname (addr)
  (let ((record (bbdb-search-simple nil addr))
	al)
    (if record
	(setq al (bbdb-record-net record))
      (setq al (list addr)))
    (while al
      (del-alist (car al) cmail-nickname-nickname-alist)
      (setq al (cdr al)))))

(defun cmail-nickname-add-nickname (addr nick)
  (let ((record (bbdb-search-simple nil addr))
	al)
    (if record
	(setq al (bbdb-record-net record))
      (setq al (list addr)))
    (while al
      (put-alist (car al) nick cmail-nickname-nickname-alist)
      (setq al (cdr al)))))

(defun cmail-nickname-add-no-nickname (addr)
  (let ((record (bbdb-search-simple nil addr))
	al)
    (if record
	(setq al (bbdb-record-net record))
      (setq al (list addr)))
    (or (member (car al) cmail-nickname-no-nickname-list)
	(setq cmail-nickname-no-nickname-list (append al cmail-nickname-no-nickname-list)))))

(defun cmail-nickname-remove-no-nickname (addr)
  (let ((record (bbdb-search-simple nil addr))
	al)
    (if record
	(setq al (bbdb-record-net record))
      (setq al (list addr)))
    (while al
      (setq cmail-nickname-no-nickname-list (delete (car al) cmail-nickname-no-nickname-list))
      (setq al (cdr al)))))

(defun cmail-nicknameb ()
  (let ((addr (cmail-summary-fp-value ?a)))
    (if (member addr cmail-nickname-no-nickname-list)
	(cmail-summary-fp-value ?n)
      (or (cmail-nickname-look-up-nickname addr)
	  (cmail-summary-fp-value ?n)))))

(defun cmail-nickname-look-up-nickname (addr)
  "Look up a nickname with BBDB."
  (let ((nick (cmail-nickname-get-nickname addr)))
    (if (null nick)
	(let ((record (bbdb-search-simple nil addr)))
	  (if record
	      (setq nick (or (bbdb-record-getprop record cmail-nickname-bbdb-prop)
			     (bbdb-record-name record))))
	  (if nick
	      (cmail-nickname-add-nickname addr nick)
	    (cmail-nickname-add-no-nickname addr))))
    nick))

(defun cmail-nickname-set-bbdb (from addr nick)
  "Add a nickname to BBDB."
  (let ((bbdb-notice-hook nil)
	(bbdb-elided-display nil)
	(record (bbdb-annotate-message-sender from t t t)))
    (if record
	(progn
	  (bbdb-record-putprop record cmail-nickname-bbdb-prop nick)
	  (bbdb-change-record record nil))))
  (cmail-nickname-add-nickname addr nick)
  (cmail-nickname-remove-no-nickname addr))

(defun cmail-nickname-remove-bbdb (addr)
  "Remove a nickname from BBDB."
  (let ((bbdb-notice-hook nil)
	(bbdb-elided-display nil)
	(record (bbdb-search-simple nil addr)))
    (if record
	(progn
	  (bbdb-record-putprop record cmail-nickname-bbdb-prop nil)
	  (bbdb-change-record record nil)
	  (and (get-buffer bbdb-buffer-name)
	       (set-buffer bbdb-buffer-name)
	       (bbdb-redisplay-one-record record)))))
  ;; update cache by deleting it and then looking it up 
  (cmail-nickname-remove-nickname addr)
  (cmail-nickname-look-up-nickname addr))

(defun cmail-nickname-register ()
  "Register a nickname.
If the nickname is empty string, then remove a nickname.
It prompts for redisplay summary after update."
  (interactive)
  (save-excursion
    (let ((inhibit-read-only t)
	  from addr nickname)
      (bbdb/cmail-open-header)
      (setq from (mail-extract-address-components (mail-fetch-field "From")))
      (when from
	(setq addr (car (cdr from)))
	(setq nickname (read-string
			(cmail-format-resource1 'ask-nickname addr)))
	(if (string-equal nickname "")
	    (cmail-nickname-remove-bbdb addr)
	  (cmail-nickname-set-bbdb from addr nickname)))))
  (if (y-or-n-p (cmail-get-resource 'nickname-ask-make-summary))
      (cmail-disp-summary)))

(defun cmail-nickname-bbdb-after-change-hook (record)
  "Update nickname cache when BBDB record has been changed"
  (let ((net (bbdb-record-net record))
	(nick-in-bbdb (or (bbdb-record-getprop record cmail-nickname-bbdb-prop)
			  (bbdb-record-name record)))
	nick-in-cache)
    (if nick-in-bbdb
	(cmail-nickname-remove-no-nickname (car net)))
    (setq nick-in-cache (cmail-nickname-get-nickname (car net)))
    (if (not (and (stringp nick-in-bbdb)
		  (stringp nick-in-cache)
		  (string= nick-in-bbdb nick-in-cache)))
	(cmail-nickname-remove-nickname (car net)))))

(add-hook 'bbdb-after-change-hook 'cmail-nickname-bbdb-after-change-hook)

;;;
(provide 'cmail-nicknameb)

;;; cmail-nicknameb.el ends here
