-;;; wl-addrmgr.el -- Address manager for Wanderlust.
+;;; wl-addrmgr.el --- Address manager for Wanderlust.
;; Copyright (C) 2001 Kitamoto Tsuyoshi <tsuyoshi.kitamoto@city.sapporo.jp>
;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
;;
;;; Commentary:
-;; Edit To:, Cc:, Bcc: fields interactively from E-Mail address list
+;; Edit To:, Cc:, Bcc: fields interactively from E-Mail address list
;; on ~/.address file.
;;; Code:
(require 'wl-address)
(require 'wl-draft)
+(eval-when-compile (require 'cl))
;; Variables
(defgroup wl-addrmgr nil
:group 'wl-addrmgr)
(defcustom wl-addrmgr-default-method 'local
- "Default access method for address entries.
-Defined by `wl-addrmgr-method-alist'."
+ "Default access method for address entries."
:type 'symbol
:group 'wl-addrmgr)
(defvar wl-addrmgr-buffer-name "Address")
(defvar wl-addrmgr-mode-map nil)
-
-(defvar wl-addrmgr-method-alist
- '((local . (wl-addrmgr-local-list ; list address entries
- wl-addrmgr-local-add ; add address entry
- wl-addrmgr-local-edit ; edit address entry
- wl-addrmgr-local-delete ; delete address entry
- ))))
+(defvar wl-addrmgr-method-list '(local))
;; buffer local variable.
(defvar wl-addrmgr-draft-buffer nil)
(define-key wl-addrmgr-mode-map "\C-c\C-k" 'wl-addrmgr-quit)
(define-key wl-addrmgr-mode-map "C" 'wl-addrmgr-change-method)
-
+
(define-key wl-addrmgr-mode-map "Z" 'wl-addrmgr-reload)
(define-key wl-addrmgr-mode-map "\C-c\C-l" 'wl-addrmgr-redraw))
"Major mode for Wanderlust address management.
See info under Wanderlust for full documentation.
-\\{wl-addrmgr-mode}"
+\\{wl-addrmgr-mode-map}"
(kill-all-local-variables)
(setq mode-name "Address"
major-mode 'wl-addrmgr-mode)
"Return address list."
(mapcar
(lambda (addr)
- (cons (nth 1 (std11-extract-address-components addr))
- addr))
+ (nth 1 (std11-extract-address-components addr)))
(wl-parse-addresses
- (mapconcat 'identity (elmo-multiple-fields-body-list (list field)) ","))))
+ (mapconcat
+ 'identity
+ (elmo-multiple-fields-body-list (list field) mail-header-separator)
+ ","))))
+
+(defun wl-addrmgr-pickup-entry-list (buffer)
+ "Return a list of address entiry from BUFFER."
+ (when buffer
+ (with-current-buffer buffer
+ (mapcar
+ (lambda (addr)
+ (let ((structure (std11-extract-address-components addr)))
+ (list (cadr structure)
+ (or (car structure) "")
+ (or (car structure) ""))))
+ (wl-parse-addresses
+ (mapconcat
+ 'identity
+ (elmo-multiple-fields-body-list '("to" "cc" "bcc")
+ mail-header-separator)
+ ","))))))
+
+(defun wl-addrmgr-merge-entries (base-list append-list)
+ "Return a merged list of address entiry."
+ (dolist (entry append-list)
+ (unless (assoc (car entry) base-list)
+ (setq base-list (nconc base-list (list entry)))))
+ base-list)
;;;###autoload
(defun wl-addrmgr ()
(if (eq major-mode 'wl-draft-mode)
(if (get-buffer-window wl-addrmgr-buffer-name)
nil
- (split-window (selected-window)
+ (split-window (selected-window)
(- (window-height (selected-window))
wl-addrmgr-buffer-lines))
(select-window (next-window))
(switch-to-buffer (get-buffer-create wl-addrmgr-buffer-name)))
(set-buffer wl-addrmgr-buffer-name)
(wl-addrmgr-mode)
- (unless wl-addrmgr-method
+ (unless wl-addrmgr-method
(setq wl-addrmgr-method wl-addrmgr-default-method
wl-addrmgr-method-name (symbol-name wl-addrmgr-default-method)))
(unless wl-addrmgr-sort-key
(unless wl-addrmgr-sort-order
(setq wl-addrmgr-sort-order wl-addrmgr-default-sort-order))
(setq wl-addrmgr-draft-buffer buffer)
- (setq wl-addrmgr-list (wl-addrmgr-list))
+ (setq wl-addrmgr-list
+ (wl-addrmgr-merge-entries (wl-addrmgr-list)
+ (wl-addrmgr-pickup-entry-list buffer)))
(wl-addrmgr-draw already-list)
(setq wl-addrmgr-unknown-list already-list)
(wl-addrmgr-goto-top)))
(interactive)
(goto-char (point-min))
(forward-line 2)
- (forward-char 4))
+ (condition-case nil
+ (forward-char 4)
+ (error)))
(defun wl-addrmgr-goto-bottom ()
(interactive)
(put-text-property 0 (length addr) 'face
wl-addrmgr-address-face
addr)
- (insert
+ (insert
(wl-set-string-width
(- wl-addrmgr-line-width 4)
(concat real " " pet " " addr)))
list field addrs beg real pet addr)
(erase-buffer)
(goto-char (point-min))
- (insert
+ (insert
"Mark "
(wl-set-string-width wl-addrmgr-realname-width
"Realname")
" "
(make-string wl-addrmgr-petname-width ?-)
" ---------------")
+ (unless wl-addrmgr-list (insert "\n"))
(dolist (entry (wl-addrmgr-sort-list wl-addrmgr-sort-key
(copy-sequence wl-addrmgr-list)
wl-addrmgr-sort-order))
addrs (cdr list))
(while addrs
(goto-char (point-min))
- (when (wl-addrmgr-search-forward-address (car (car addrs)))
+ (when (wl-addrmgr-search-forward-address (car addrs))
(wl-addrmgr-mark-write field)
(setcdr list (delq (car addrs) (cdr list))))
(setq addrs (cdr addrs)))
(setq already-list (cdr already-list))))))
-
+
(defun wl-addrmgr-next ()
"Move cursor next line."
(interactive)
(forward-char 4)))))
(defun wl-addrmgr-quit-yes ()
- (if (and wl-addrmgr-draft-buffer
- (buffer-live-p wl-addrmgr-draft-buffer)
- (null (get-buffer-window wl-addrmgr-draft-buffer)))
- (switch-to-buffer wl-addrmgr-draft-buffer)
- (unless (one-window-p)
- (delete-window)))
- (kill-buffer wl-addrmgr-buffer-name))
+ (let ((draft-buffer wl-addrmgr-draft-buffer))
+ (if (and draft-buffer
+ (buffer-live-p draft-buffer)
+ (null (get-buffer-window draft-buffer 'visible)))
+ (switch-to-buffer draft-buffer)
+ (unless (one-window-p)
+ (delete-window)))
+ (kill-buffer wl-addrmgr-buffer-name)
+ (if (and draft-buffer (not (one-window-p)))
+ (switch-to-buffer-other-window draft-buffer))))
(defun wl-addrmgr-quit ()
"Exit from electric reference mode without inserting reference."
(let ((entry (wl-addrmgr-address-entry))
buffer-read-only)
(save-excursion
- (beginning-of-line)
- (delete-region (point) (progn (end-of-line)(point)))
+ (delete-region (point-at-bol) (point-at-eol))
(wl-addrmgr-insert-line entry))
(set-buffer-modified-p nil)
(wl-addrmgr-next)))
(defun wl-addrmgr-sort ()
"Sort address entry."
(interactive)
- (setq wl-addrmgr-sort-key (intern
- (completing-read
+ (setq wl-addrmgr-sort-key (intern
+ (completing-read
(format "Sort By (%s): "
(symbol-name wl-addrmgr-sort-key))
'(("address")("realname")("petname")("none"))
(symbol-name wl-addrmgr-sort-key))))
(if (eq wl-addrmgr-sort-key 'none)
(wl-addrmgr-reload)
- (setq wl-addrmgr-sort-order (intern
- (completing-read
+ (setq wl-addrmgr-sort-order (intern
+ (completing-read
(format "Sort Order (%s): "
(symbol-name wl-addrmgr-sort-order))
'(("ascending") ("descending"))
(defun wl-addrmgr-change-method ()
(interactive)
- (setq wl-addrmgr-method (intern
+ (setq wl-addrmgr-method (intern
(setq wl-addrmgr-method-name
- (completing-read
+ (completing-read
(format "Method (%s): "
(symbol-name wl-addrmgr-method))
- (mapcar (lambda (pair)
- (list (symbol-name (car pair))))
- wl-addrmgr-method-alist)
+ (mapcar (lambda (method)
+ (list (symbol-name method)))
+ wl-addrmgr-method-list)
nil t nil nil
(symbol-name wl-addrmgr-method)))))
(wl-addrmgr-redraw))
;;; Operations.
(defun wl-addrmgr-address-entry ()
- (save-excursion
- (end-of-line)
- (get-text-property (previous-single-property-change
- (point) 'wl-addrmgr-entry nil
- (progn
- (beginning-of-line)
- (point)))
- 'wl-addrmgr-entry)))
+ (get-text-property (previous-single-property-change
+ (point-at-eol) 'wl-addrmgr-entry nil
+ (point-at-bol))
+ 'wl-addrmgr-entry))
(defun wl-addrmgr-mark-write (&optional mark)
"Set MARK to the current address entry."
- (save-excursion
- (end-of-line)
- (unless (< (count-lines (point-min) (point)) 3)
+ (save-excursion
+ (unless (< (count-lines (point-min) (point-at-eol)) 3)
(let ((buffer-read-only nil) beg end)
(beginning-of-line)
(delete-char 4)
(cc "Cc: ")
(bcc "Bcc:")
(t " ")))
- (insert (make-string (- 4 (current-column)) ? ))
- (beginning-of-line)
- (setq beg (point))
- (setq end (progn (end-of-line)
- (point)))
+ (insert (make-string (- 4 (current-column)) (string-to-char " ")))
+ (setq beg (point-at-bol))
+ (setq end (point-at-eol))
(put-text-property beg end 'face nil)
(wl-highlight-message beg end nil))
- (set-buffer-modified-p nil)
- (beginning-of-line)
- (forward-char 4))))
+ (set-buffer-modified-p nil))))
(defun wl-addrmgr-apply ()
(interactive)
(setq realname (nth 2 (wl-addrmgr-address-entry)))
(cond
((string= mark "To:")
- (setq to-list (cons (if full (concat
- (wl-address-quote-specials realname)
- " <" addr">")
- addr)
- to-list)))
+ (setq to-list (cons
+ (if (and full
+ (not (or (string= realname "")
+ (string-match ".*:.*;$" addr))))
+ (concat
+ (wl-address-quote-specials realname)
+ " <" addr">")
+ addr)
+ to-list)))
((string= mark "Cc:")
- (setq cc-list (cons (if full (concat
- (wl-address-quote-specials realname)
- " <" addr">")
- addr)
- cc-list)))
+ (setq cc-list (cons
+ (if (and full
+ (not (or (string= realname "")
+ (string-match ".*:.*;$" addr))))
+ (concat
+ (wl-address-quote-specials realname)
+ " <" addr">")
+ addr)
+ cc-list)))
((string= mark "Bcc:")
- (setq bcc-list (cons (if full (concat
- (wl-address-quote-specials realname)
- " <" addr">")
- addr)
- bcc-list)))))
+ (setq bcc-list (cons
+ (if (and full
+ (not (or (string= realname "")
+ (string-match ".*:.*;$" addr))))
+ (concat
+ (wl-address-quote-specials realname)
+ " <" addr">")
+ addr)
+ bcc-list)))))
(list to-list cc-list bcc-list))))
(defun wl-addrmgr-apply-exec (rcpt)
- (let ((to (nconc (nth 0 rcpt) (mapcar
- 'cdr
- (cdr (assq 'to wl-addrmgr-unknown-list)))))
- (cc (nconc (nth 1 rcpt) (mapcar
- 'cdr
- (cdr (assq 'cc wl-addrmgr-unknown-list)))))
- (bcc (nconc (nth 2 rcpt) (mapcar
- 'cdr
- (cdr (assq 'bcc wl-addrmgr-unknown-list)))))
+ (let ((to (nconc (nth 0 rcpt) (cdr (assq 'to wl-addrmgr-unknown-list))))
+ (cc (nconc (nth 1 rcpt) (cdr (assq 'cc wl-addrmgr-unknown-list))))
+ (bcc (nconc (nth 2 rcpt) (cdr (assq 'bcc wl-addrmgr-unknown-list))))
from clist)
(setq clist (list (cons "Bcc" (if bcc (mapconcat 'identity bcc ",\n\t")))
(cons "Cc" (if cc (mapconcat 'identity cc ",\n\t")))
(when (or (null wl-addrmgr-draft-buffer)
(not (buffer-live-p wl-addrmgr-draft-buffer)))
(setq wl-addrmgr-draft-buffer (save-window-excursion
- (wl-draft)
- (current-buffer))))
+ (call-interactively 'wl-draft)
+ (current-buffer))))
(with-current-buffer wl-addrmgr-draft-buffer
(setq from (std11-field-body "From"))
(if from
(while (re-search-forward (concat "^" (regexp-quote field) ":") nil t)
;; delete field
(progn
- (save-excursion
- (beginning-of-line)
- (setq beg (point)))
+ (setq beg (point-at-bol))
(re-search-forward "^[^ \t]" nil 'move)
- (beginning-of-line)
- (delete-region beg (point))))
+ (delete-region beg (point-at-bol))
+ (beginning-of-line)))
(when content
;; add field to top.
(goto-char (point-min))
(put-text-property beg end 'face nil)
(wl-highlight-message beg end t))))
-;; beginning of the end
(require 'product)
-(product-provide
- (provide 'wl-addrmgr)
- (require 'wl-version))
+(product-provide (provide 'wl-addrmgr) (require 'wl-version))
;;; wl-addrmgr.el ends here
projects / elisp / wanderlust.git / blobdiff