;;; cmail-nicknamef.el --- Look up a nickname with file.

;; Author: Keisuke ICHIHASHI <ksuke@tky2.3web.ne.jp>
;; Keywords: mail
;; Create date: 2000-08-09
;; $Id: cmail-nicknamef.el,v 1.2 2002/07/20 23:09:58 tmp Exp $

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

;;; user variables
(cmail-i18n-defcustom cmail-nickname-file "~/.cmail-nickname.el"
  ((ja_JP . "*ニックネームを保存するファイル名。")
   (en_US . "*The name of the user environment file of cmail nickname."))
  :type 'file
  :group 'cmail-all-variables
  :group 'cmail-use-nickname-group)

(cmail-i18n-defcustom cmail-nickname-file-modes 384
  ((ja_JP . "*`cmail-nickname-file' のパーミッション。")
   (en_US . "*File permission mode for `cmail-nickname-file'."))
  :type 'integer
  :group 'cmail-all-variables
  :group 'cmail-use-nickname-group)

(defvar cmail-nickname-file-coding-system (cond ((>= emacs-major-version 20) 'ctext)
						 (t '*ctext*))
  "*File coding system for `cmail-nickname-file'.")

;;; internal variables
(defvar cmail-nickname-symbol 'cmail-nickname-alist
  "The name of the variable to register nicknames.")

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

(let ((ja '((ask-nickname . "%s のニックネームは? ")
	    (nickname-ask-make-summary
	     . "新しいニックネームでサマリを再表示しますか? ")))
      (en '((ask-nickname . "Nickname of %s ? ")
	    (nickname-ask-make-summary
	     . "Redisplay summary with updated nickname? "))))
  (or (and cmail-i18n-message
	   (boundp 'current-language-environment)
	   (or (featurep 'xemacs)
	       (and (boundp 'emacs-major-version)
		    (boundp 'emacs-minor-version)
		    (or (>= emacs-major-version 21)
			(and (eq emacs-major-version 20) (>= emacs-minor-version 3)))))
	   (cond ((equal current-language-environment "Japanese")
		  (setq cmail-resource-alist (append ja cmail-resource-alist)))
		 (t
		  (setq cmail-resource-alist (append en cmail-resource-alist)))))
      (setq cmail-resource-alist (append en cmail-resource-alist))))

;; (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-load-nickname-file ()
  "Load `cmail-nickname-file'."
  (if (file-readable-p cmail-nickname-file)
      (save-excursion
	(let ((buf (get-buffer-create " *cmail-temp*")))
	  (set-buffer buf)
	  (set-buffer-file-coding-system cmail-nickname-file-coding-system)
	  (insert-file-contents cmail-nickname-file)
	  (let ((exp (read (current-buffer))))
	    (or (eq (car (cdr exp)) cmail-nickname-symbol)
		(setcar (cdr exp) cmail-nickname-symbol))
	    (eval exp))
	  (kill-buffer buf)))
    (eval (list 'setq cmail-nickname-symbol nil))))

(defun cmail-nickname-save-nickname-file ()
  "Save `cmail-nickname-file'."
  (save-excursion
    (let ((buf (get-buffer-create " *cmail-temp*")))
      (set-buffer buf)
      (set-buffer-file-coding-system cmail-nickname-file-coding-system)
      (insert ";;; " (file-name-nondirectory cmail-nickname-file) "\n")
      (insert ";;; This file is generated automatically by cmail-" cmail-version ".\n\n")
      (insert "(setq "
	      (symbol-name cmail-nickname-symbol)
	      "\n      '(")
      (insert (mapconcat
	       (function
		(lambda (elem)
		  (format "%s" (prin1-to-string elem))))
	       (symbol-value cmail-nickname-symbol) "\n        "))
      (insert "\n        ))\n\n")
      (insert ";;; "
	      (file-name-nondirectory cmail-nickname-file)
	      " ends here.\n")
      (write-file cmail-nickname-file)
      (kill-buffer buf)))
  (set-file-modes cmail-nickname-file cmail-nickname-file-modes))

(defsubst cmail-nickname-get-nickname-entry (addr)
  ;; return value
  ;; (NICKNAME ADDRESS1 ADDRESS2...) or nil
  (let ((nal (symbol-value cmail-nickname-symbol))
	ret)
    (while (and (not ret) nal)
      (if (member addr (cdr (car nal)))
	  (setq ret (car nal))
	(setq nal (cdr nal))))
    ret))

(defun cmail-nicknamef ()
  (or (cmail-nickname-look-up-nickname (cmail-summary-fp-value ?a))
      (cmail-summary-fp-value ?n)))

(defun cmail-nickname-look-up-nickname (addr)
  "Look up a nickname."
  (car (cmail-nickname-get-nickname-entry addr)))

(defun cmail-nickname-register ()
  "Register a nickname.
If the nickname is empty string, then remove a nickname."
  (interactive)
  (let* ((addr (cmail-name-and-address cmail-current-folder (cmail-get-page-number-from-summary) t))
	 (nickname (read-string (cmail-format-resource1 'ask-nickname addr)))
	 entry)
    (setq entry (cmail-nickname-get-nickname-entry addr))
    (when entry
	(setq entry (delete addr entry))
	(if (null (cdr entry))
	    (set cmail-nickname-symbol (delete entry (symbol-value cmail-nickname-symbol)))))
    (unless (string-equal nickname "")
      (setq entry (assoc nickname (symbol-value cmail-nickname-symbol)))
      (if entry
	  (setcdr entry (append (list addr) (cdr entry)))
	(set cmail-nickname-symbol (cons (list nickname addr) (symbol-value cmail-nickname-symbol))))))
  (cmail-nickname-save-nickname-file)
  (if (y-or-n-p (cmail-get-resource 'nickname-ask-make-summary))
      (cmail-disp-summary)))

;;; 
(cmail-nickname-load-nickname-file)
(provide 'cmail-nicknamef)

;;; cmail-nicknamef.el ends here
