X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=wl%2Fwl-address.el;h=a0dfc1bda47f9fad28ae94bcdeb0d44ae0d0a43c;hb=00c94704e49ec8e966bcf83807f821c3b654bbdc;hp=16082f93d79a6a9ddd6bce9f49d72fe5ad26114a;hpb=830e9b8741357e15b6caa55089426784ca4b2620;p=elisp%2Fwanderlust.git diff --git a/wl/wl-address.el b/wl/wl-address.el index 16082f9..a0dfc1b 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -36,8 +36,9 @@ (require 'wl-util) (require 'wl-vars) (require 'std11) +(eval-when-compile (require 'cl)) -(defvar wl-address-complete-header-list +(defvar wl-address-complete-header-list '("To:" "From:" "Cc:" "Bcc:" "Mail-Followup-To:" "Reply-To:" "Return-Receipt-To:")) (defvar wl-address-complete-header-regexp nil) ; auto-generated. @@ -364,8 +365,7 @@ Matched address lists are append to CL." (if (and (get-buffer-window wl-completion-buf-name) (equal wl-complete-candidates all)) (let ((win (get-buffer-window wl-completion-buf-name))) - (save-excursion - (set-buffer wl-completion-buf-name) + (with-current-buffer wl-completion-buf-name (if (pos-visible-in-window-p (point-max) win) (set-window-start win 1) (scroll-other-window)))) @@ -454,7 +454,8 @@ Matched address lists are append to CL." (message "Sole completion")) ((and epand-char (> len 0) - (char-equal (aref pattern (1- len)) epand-char) + (or (char-equal (aref pattern (1- len)) epand-char) + (char-equal (aref pattern (1- len)) (string-to-char " "))) (assoc (substring pattern 0 (1- len)) cl)) (wl-complete-insert start end @@ -523,7 +524,7 @@ Refresh `wl-address-list', `wl-address-completion-list', and (wl-address-expand-aliases alist (1+ nest-count)))))) (defun wl-address-make-alist-from-alias-file (file) - (elmo-set-work-buf + (with-temp-buffer (let ((case-fold-search t) alias expn alist) (insert-file-contents file) @@ -541,39 +542,24 @@ Refresh `wl-address-list', `wl-address-completion-list', and ))) (defun wl-address-make-address-list (path) - (if (and path (file-readable-p path)) - (elmo-set-work-buf - (let (ret - (coding-system-for-read wl-cs-autoconv)) - (insert-file-contents path) - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at - "^\\([^#\n][^ \t\n]+\\)[ \t]+\\(\".*\"\\)[ \t]+\\(\".*\"\\)[ \t]*.*$") - (setq ret - (cons - (list (wl-match-buffer 1) - (read (wl-match-buffer 2)) - (read (wl-match-buffer 3))) - ret))) - (forward-line)) - (nreverse ret))))) - -(defun wl-address-get-petname-1 (string) - (let ((address (downcase (wl-address-header-extract-address string)))) - (elmo-get-hash-val address wl-address-petname-hash))) - -(defsubst wl-address-get-petname (string) - (or (wl-address-get-petname-1 string) - string)) + (when (and path (file-readable-p path)) + (with-temp-buffer + (let (ret + (coding-system-for-read wl-cs-autoconv)) + (insert-file-contents path) + (goto-char (point-min)) + (while (not (eobp)) + (if (looking-at "\ +^\\([^#\n][^ \t\n]+\\)[ \t]+\\(\".*\"\\)[ \t]+\\(\".*\"\\)[ \t]*.*$") + (setq ret + (cons + (list (wl-match-buffer 1) + (read (wl-match-buffer 2)) + (read (wl-match-buffer 3))) + ret))) + (forward-line)) + (nreverse ret))))) -(defsubst wl-address-user-mail-address-p (address) - "Judge whether ADDRESS is user's or not." - (member (downcase (wl-address-header-extract-address address)) - (or (mapcar 'downcase wl-user-mail-address-list) - (list (downcase - (wl-address-header-extract-address - wl-from)))))) (defsubst wl-address-header-extract-address (str) "Extracts a real e-mail address from STR and return it. @@ -595,14 +581,52 @@ e.g. \"Mr. bar \" (wl-match-string 1 str)) (t ""))) + +(defun wl-address-get-petname-1 (string) + (let ((address (downcase (wl-address-header-extract-address string)))) + (elmo-get-hash-val address wl-address-petname-hash))) + +(defsubst wl-address-get-petname (string) + (or (wl-address-get-petname-1 string) + string)) + +(defun wl-address-user-mail-address-p (address) + "Judge whether ADDRESS is user's or not." + (if wl-user-mail-address-regexp + (string-match wl-user-mail-address-regexp + (wl-address-header-extract-address address)) + (member (downcase (wl-address-header-extract-address address)) + (or (mapcar 'downcase wl-user-mail-address-list) + (list (downcase + (wl-address-header-extract-address + wl-from))))))) + +(defun wl-address-delete-user-mail-addresses (address-list) + "Delete user mail addresses from list by side effect. +Deletion is done by using `elmo-list-delete'." + (if wl-user-mail-address-regexp + (elmo-list-delete (list wl-user-mail-address-regexp) address-list + (lambda (elem list) + (elmo-delete-if + (lambda (item) (string-match elem item)) + list))) + (let ((myself (or wl-user-mail-address-list + (list (wl-address-header-extract-address wl-from))))) + (elmo-list-delete myself address-list + (lambda (elem list) + (elmo-delete-if + (lambda (item) (string= (downcase elem) + (downcase item))) + list)))))) + (defmacro wl-address-concat-token (string token) - (` (cond - ((eq 'quoted-string (car (, token))) - (concat (, string) "\"" (cdr (, token)) "\"")) - ((eq 'comment (car (, token))) - (concat (, string) "(" (cdr (, token)) ")")) - (t - (concat (, string) (cdr (, token))))))) + `(cond + ((eq 'quoted-string (car ,token)) + (concat ,string "\"" (cdr ,token) "\"")) + ((eq 'comment (car ,token)) + (concat ,string "(" (cdr ,token) ")")) + (t + (concat ,string (cdr ,token))))) (defun wl-address-string-without-group-list-contents (sequence) "Return address string from lexical analyzed list SEQUENCE. @@ -647,7 +671,7 @@ Group list contents is not included." (with-temp-buffer (message "Deleting Address...") (insert-file-contents wl-address-file) - (delete-matching-lines (concat "^[ \t]*" the-email)) + (delete-matching-lines (concat "^[ \t]*" the-email "[ \t]+\".*\"[ \t]+\".*\"$")) (write-region (point-min) (point-max) wl-address-file nil 'no-msg) ;; Delete entries. @@ -671,9 +695,16 @@ If already registerd, change it." the-realname))) (when change-address (setq new-addr (read-from-minibuffer "E-Mail: " address)) - (if (and (not (string= address new-addr)) - (assoc new-addr wl-address-list)) - (error "'%s' already exists" new-addr))) + (cond + ((or (not (stringp new-addr)) + (string-match "^[ \t]*$" new-addr)) + (error "empty address")) + ((and (not (string= address new-addr)) + (assoc new-addr wl-address-list)) + (error "'%s' already exists" new-addr)) + (t + ;; do nothing + ))) ;; writing to ~/.address (let ((output-coding-system (mime-charset-to-coding-system wl-mime-charset))) @@ -689,10 +720,7 @@ If already registerd, change it." (insert "\n"))) ;; override (while (re-search-forward (concat "^[ \t]*" address) nil t) - (delete-region (save-excursion (beginning-of-line) - (point)) - (save-excursion (end-of-line) - (+ 1 (point)))))) + (delete-region (point-at-bol) (1+ (point-at-eol))))) (insert (format "%s\t%s\t%s\n" (or new-addr address) (prin1-to-string the-petname) @@ -702,6 +730,31 @@ If already registerd, change it." (wl-address-init) (list (or new-addr address) the-petname the-realname))))) +;; Read addresses from minibuffer with completion. +(defvar wl-address-minibuffer-history nil) +(defvar wl-address-minibuffer-local-map nil + "Keymap to use when reading address from the minibuffer.") + +(unless wl-address-minibuffer-local-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "\C-i" + (lambda () + (interactive) + (wl-complete-field-body wl-address-completion-list + ?@ nil wl-use-ldap))) + (setq wl-address-minibuffer-local-map map))) + +(defun wl-address-read-from-minibuffer (prompt &optional + initial-contents + default-value) + (read-from-minibuffer prompt + initial-contents + wl-address-minibuffer-local-map + nil + 'wl-address-minibuffer-history + default-value)) + (require 'product) (product-provide (provide 'wl-address) (require 'wl-version))