X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-address.el;h=a2651a959cd3e31a209c6f2a89fc05c57b0aa18b;hb=36ac88ff2e3ef1701174641f5b085f1041fe4b66;hp=02957b8e6366c222d4ccddb2ac3b984040abf3b5;hpb=12486e286f2e8098a18078919ee9f29074f737c2;p=elisp%2Fwanderlust.git diff --git a/wl/wl-address.el b/wl/wl-address.el index 02957b8..a2651a9 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -1,8 +1,8 @@ -;;; wl-address.el -- Tiny address management for Wanderlust. +;;; wl-address.el --- Tiny address management for Wanderlust. -;; Copyright 1998,1999,2000 Yuuichi Teranishi -;; Shun-ichi GOTO -;; Takeshi Chiba +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Shun-ichi GOTO +;; Copyright (C) 1998,1999,2000 Takeshi Chiba ;; Author: Yuuichi Teranishi ;; Shun-ichi GOTO @@ -28,10 +28,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'wl-util) (require 'wl-vars) @@ -96,7 +96,7 @@ If level 3 is required for uniqness with other candidates, values nil) (setq values (cdr values))))) ret)) - + (defun wl-ldap-get-value-list (type entry) "" (cdr (assoc type entry))) @@ -104,7 +104,7 @@ If level 3 is required for uniqness with other candidates, (defun wl-ldap-make-filter (pat type-list) "Make RFC1558 quiery filter for PAT from ATTR-LIST. Each are \"OR\" combination, and PAT is beginning-match." - (concat "(&(objectclass=person)(|" + (concat "(&(objectclass=" wl-ldap-objectclass ")(|" (mapconcat (lambda (x) (format "(%s=%s*)" x pat)) ; fixed format type-list "") @@ -119,6 +119,7 @@ Returns matched uniq string list." (setq type (car (car entry)) values (mapcar (function wl-ldap-alias-safe-string) (cdr (car entry))) + values (elmo-flatten values) entry (cdr entry)) (if (string-match "::?$" type) (setq type (substring type 0 (match-beginning 0)))) @@ -134,15 +135,13 @@ Returns matched uniq string list." (defun wl-ldap-alias-safe-string (str) "Modify STR for alias. Replace space/tab in STR into '_' char. -Replace '@' in STR into '/' char." +Replace '@' in STR into list of mailbox and sub-domains." (while (string-match "[^_a-zA-Z0-9+@%.!\\-/]+" str) (setq str (concat (substring str 0 (match-beginning 0)) "_" (substring str (match-end 0))))) (if (string-match "\\(@\\)[^/@]+" str) - (setq str (concat (substring str 0 (match-beginning 1)) - "/" - (substring str (match-end 1))))) + (setq str (split-string str "[@\\.]"))) str) (defun wl-ldap-register-dn-string (hash dn &optional str dn-list) @@ -158,7 +157,8 @@ Replace '@' in STR into '/' char." (if (string-match "[a-z]+=\\(.*\\)" str) (wl-ldap-alias-safe-string (wl-match-string 1 str)))) - (split-string dn ","))))) + (split-string dn "[ \t]*,[ \t]*"))))) + (setq dn-list (elmo-flatten dn-list)) ;; prepare candidate for uniq str (if str (setq str (concat str wl-ldap-alias-sep (car dn-list)) @@ -280,11 +280,7 @@ Matched address lists are append to CL." (completing-read "To: " cl) (read-string "To: ")))) -(defun wl-address-quote-specials (word) - "Make quoted string of WORD if needed." - (if (assq 'specials (std11-lexical-analyze word)) - (prin1-to-string word) - word)) +(defalias 'wl-address-quote-specials 'elmo-address-quote-specials) (defun wl-address-make-completion-list (address-list) (let (addr-tuple cl) @@ -383,8 +379,8 @@ Matched address lists are append to CL." (if (null cl) nil (setq completion - (let ((completion-ignore-case t)) - (try-completion pattern cl))) + (let ((completion-ignore-case t)) + (try-completion pattern cl))) (cond ((eq completion t) (let ((alias (assoc pattern cl))) (if alias @@ -458,11 +454,11 @@ Matched address lists are append to CL." (let ((list (sort (all-completions pattern cl) 'string<))) (wl-complete-window-show list))))))) -(defvar wl-address-init-func 'wl-local-address-init) +(defvar wl-address-init-function 'wl-local-address-init) (defun wl-address-init () - "Call `wl-address-init-func'." - (funcall wl-address-init-func)) + "Call `wl-address-init-function'." + (funcall wl-address-init-function)) (defun wl-local-address-init () "Reload `wl-address-file'. @@ -491,24 +487,24 @@ Refresh `wl-address-list', `wl-address-completion-list', and (when (< nest-count 5) (let (expn-str new-expn-str expn new-expn(n 0) (expanded nil)) (while (setq expn-str (cdr (nth n alist))) - (setq new-expn-str nil) - (while (string-match "^[ \t]*\\([^,]+\\)" expn-str) - (setq expn (elmo-match-string 1 expn-str)) + (setq new-expn-str nil) + (while (string-match "^[ \t]*\\([^,]+\\)" expn-str) + (setq expn (elmo-match-string 1 expn-str)) (setq expn-str (wl-string-delete-match expn-str 0)) - (if (string-match "^[ \t,]+" expn-str) + (if (string-match "^[ \t,]+" expn-str) (setq expn-str (wl-string-delete-match expn-str 0))) - (if (string-match "[ \t,]+$" expn) + (if (string-match "[ \t,]+$" expn) (setq expn (wl-string-delete-match expn 0))) - (setq new-expn (cdr (assoc expn alist))) - (if new-expn - (setq expanded t)) - (setq new-expn-str (concat new-expn-str (and new-expn-str ", ") - (or new-expn expn)))) - (when new-expn-str - (setcdr (nth n alist) new-expn-str)) - (setq n (1+ n))) + (setq new-expn (cdr (assoc expn alist))) + (if new-expn + (setq expanded t)) + (setq new-expn-str (concat new-expn-str (and new-expn-str ", ") + (or new-expn expn)))) + (when new-expn-str + (setcdr (nth n alist) new-expn-str)) + (setq n (1+ n))) (and expanded - (wl-address-expand-aliases alist (1+ nest-count)))))) + (wl-address-expand-aliases alist (1+ nest-count)))))) (defun wl-address-make-alist-from-alias-file (file) (elmo-set-work-buf @@ -518,7 +514,7 @@ Refresh `wl-address-list', `wl-address-completion-list', and (while (re-search-forward ",$" nil t) (end-of-line) (forward-char 1) - (delete-backward-char 1)) + (delete-backward-char 1)) (goto-char (point-min)) (while (re-search-forward "^\\([^#;\n][^:]+\\):[ \t]*\\(.*\\)$" nil t) (setq alias (wl-match-buffer 1) @@ -527,27 +523,27 @@ Refresh `wl-address-list', `wl-address-completion-list', and (wl-address-expand-aliases alist 0) (nreverse alist) ; return value ))) - + (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 - (wl-append-element - ret - (list (wl-match-buffer 1) - (wl-match-buffer 2) - (wl-match-buffer 3))))) - (forward-line)) - ret)))) - -(defsubst wl-address-get-petname-1 (string) + (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 + (wl-append-element + ret + (list (wl-match-buffer 1) + (read (wl-match-buffer 2)) + (read (wl-match-buffer 3)))))) + (forward-line)) + 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))) @@ -570,18 +566,18 @@ e.g. \"Mine Sakurai \" e.g. \"m-sakura@ccs.mt.nec.co.jp (Mine Sakurai)\" -> \"m-sakura@ccs.mt.nec.co.jp\"." (cond ((string-match ".*<\\([^>]*\\)>" str) ; .* to extract last <> - (wl-match-string 1 str)) - ((string-match "\\([^ \t\n]*@[^ \t\n]*\\)" str) (wl-match-string 1 str)) - (t str))) + ((string-match "\\([^ \t\n]*@[^ \t\n]*\\)" str) + (wl-match-string 1 str)) + (t str))) (defsubst wl-address-header-extract-realname (str) "Extracts a real name from STR and return it. e.g. \"Mr. bar \" -> \"Mr. bar\"." (cond ((string-match "\\(.*[^ \t]\\)[ \t]*<[^>]*>" str) - (wl-match-string 1 str)) - (t ""))) + (wl-match-string 1 str)) + (t ""))) (defmacro wl-address-concat-token (string token) (` (cond @@ -628,70 +624,67 @@ Group list contents is not included." (setq sequence (cdr sequence))))) address-string)) -(defun wl-address-petname-delete (the-email) - "Delete petname in `wl-address-file'." - (let* ( (tmp-buf (get-buffer-create " *wl-petname-tmp*")) - (output-coding-system - (mime-charset-to-coding-system wl-mime-charset))) - (set-buffer tmp-buf) - (message "Deleting Petname...") - (erase-buffer) - (insert-file-contents wl-address-file) - (delete-matching-lines (concat "^[ \t]*" the-email)) - (write-region (point-min) (point-max) - wl-address-file nil 'no-msg) - (message "Deleting Petname...done") - (kill-buffer tmp-buf))) - - -(defun wl-address-petname-add-or-change (the-email - default-petname - default-realname - &optional change-petname) - "Add petname to `wl-address-file', if not registerd. +(defun wl-address-delete (the-email) + "Delete address entry in the `wl-address-file'." + (let ((output-coding-system + (mime-charset-to-coding-system wl-mime-charset))) + (with-temp-buffer + (message "Deleting Address...") + (insert-file-contents wl-address-file) + (delete-matching-lines (concat "^[ \t]*" the-email)) + (write-region (point-min) (point-max) + wl-address-file nil 'no-msg) + ;; Delete entries. + (dolist (entry (elmo-string-assoc-all the-email wl-address-list)) + (setq wl-address-list (delete entry wl-address-list))) + (elmo-set-hash-val the-email nil wl-address-petname-hash) + (message "Deleting Address...done")))) + +(defun wl-address-add-or-change (address + &optional default-realname + change-address) + "Add address entry to `wl-address-file', if not registerd. If already registerd, change it." - (let (the-realname the-petname) - - ;; setup output "petname" - ;; if null petname'd, let default-petname be the petname. - (setq the-petname - (read-from-minibuffer (format "Petname: ") default-petname)) - (if (string= the-petname "") - (setq the-petname (or default-petname the-email))) - - ;; setup output "realname" + (let ((entry (assoc address wl-address-list)) + the-realname the-petname new-addr addr-changed) (setq the-realname - (read-from-minibuffer (format "Real Name: ") default-realname)) -;;; (if (string= the-realname "") -;;; (setq the-realname default-petname)) - + (read-from-minibuffer "Real Name: " (or default-realname + (nth 2 entry)))) + (setq the-petname (read-from-minibuffer "Petname: " + (or (nth 1 entry) + 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))) ;; writing to ~/.address - (let ( (tmp-buf (get-buffer-create " *wl-petname-tmp*")) - (output-coding-system (mime-charset-to-coding-system wl-mime-charset))) - (set-buffer tmp-buf) - (message "Adding Petname...") - (erase-buffer) - (if (file-exists-p wl-address-file) - (insert-file-contents wl-address-file)) - (if (not change-petname) - ;; if only add - (progn - (goto-char (point-max)) - (if (and (> (buffer-size) 0) - (not (eq (char-after (1- (point-max))) ?\n))) - (insert "\n"))) - ;; if change - (if (re-search-forward (concat "^[ \t]*" the-email) nil t) + (let ((output-coding-system + (mime-charset-to-coding-system wl-mime-charset))) + (with-temp-buffer + (if (file-exists-p wl-address-file) + (insert-file-contents wl-address-file)) + (if (null entry) + ;; add + (progn + (goto-char (point-max)) + (if (and (> (buffer-size) 0) + (not (eq (char-after (1- (point-max))) ?\n))) + (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)))))) - (insert (format "%s\t\"%s\"\t\"%s\"\n" - the-email the-petname the-realname)) - (write-region (point-min) (point-max) - wl-address-file nil 'no-msg) - (message "Adding Petname...done") - (kill-buffer tmp-buf)))) + (insert (format "%s\t%s\t%s\n" + (or new-addr address) + (prin1-to-string the-petname) + (prin1-to-string the-realname))) + (write-region (point-min) (point-max) + wl-address-file nil 'no-msg) + (wl-address-init) + (list (or new-addr address) the-petname the-realname))))) (require 'product) (product-provide (provide 'wl-address) (require 'wl-version))