X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-address.el;h=d168f5254e77a6cafca8d3a312ca53b08ee4d262;hb=5e44d39db70452a18d1d67d20ffefe979720b4e9;hp=19dcb26354c7ca0598aeee63613fa4647d543dc0;hpb=50e87247bc89cd4eead8633be07a758798831042;p=elisp%2Fwanderlust.git diff --git a/wl/wl-address.el b/wl/wl-address.el index 19dcb26..d168f52 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -1,4 +1,4 @@ -;;; wl-address.el -- Tiny address management for Wanderlust. +;;; wl-address.el --- Tiny address management for Wanderlust. ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Copyright (C) 1998,1999,2000 Shun-ichi GOTO @@ -28,21 +28,25 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'wl-util) (require 'wl-vars) (require 'std11) -(defvar wl-address-complete-header-regexp "^\\(To\\|From\\|Cc\\|Bcc\\|Mail-Followup-To\\|Reply-To\\|Return-Receipt-To\\):") +(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. (defvar wl-newsgroups-complete-header-regexp "^\\(Newsgroups\\|Followup-To\\):") -(defvar wl-folder-complete-header-regexp "^\\(FCC\\):") +(defvar wl-folder-complete-header-regexp "^\\(Fcc\\):") (defvar wl-address-list nil) (defvar wl-address-completion-list nil) (defvar wl-address-petname-hash nil) +(defvar wl-address-enable-strict-loading t) (defvar wl-address-ldap-search-hash nil) @@ -83,7 +87,7 @@ If level 3 is required for uniqness with other candidates, (defconst wl-ldap-alias-sep "/") (defconst wl-ldap-search-attribute-type-list - '("sn" "cn" "mail")) + '("sn" "cn" "mail" "email")) (defun wl-ldap-get-value (type entry) "" @@ -96,7 +100,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,11 +108,11 @@ 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=" wl-ldap-objectclass ")(|" + (concat "(|" (mapconcat (lambda (x) (format "(%s=%s*)" x pat)) ; fixed format type-list "") - "))")) + ")")) (defun wl-ldap-make-matched-value-list (regexp type-list entry) "Correct matching WORD with value of TYPE-LIST in ENTRY. @@ -121,8 +125,6 @@ Returns matched uniq string list." (cdr (car entry))) values (elmo-flatten values) entry (cdr entry)) - (if (string-match "::?$" type) - (setq type (substring type 0 (match-beginning 0)))) (if (member type type-list) (while values (setq val (car values) @@ -136,7 +138,7 @@ Returns matched uniq string list." "Modify STR for alias. Replace space/tab in STR into '_' char. Replace '@' in STR into list of mailbox and sub-domains." - (while (string-match "[^_a-zA-Z0-9+@%.!\\-/]+" str) + (while (string-match "[ \t]+" str) (setq str (concat (substring str 0 (match-beginning 0)) "_" (substring str (match-end 0))))) @@ -200,9 +202,9 @@ Matched address lists are append to CL." (let ((pat (if (string-match wl-ldap-alias-sep pattern) (substring pattern 0 (match-beginning 0)) pattern)) - (ldap-default-host wl-ldap-server) - (ldap-default-port (or wl-ldap-port 389)) - (ldap-default-base wl-ldap-base) + (ldap-default-host (or wl-ldap-server ldap-default-host "localhost")) + (ldap-default-port (or wl-ldap-port ldap-default-port 389)) + (ldap-default-base (or wl-ldap-base ldap-default-base)) (dnhash (elmo-make-hash)) cache len sym tmpl regexp entries ent values dn dnstr alias result cn mails) @@ -220,17 +222,14 @@ Matched address lists are append to CL." ;; get matched entries (if cache (setq entries (cdr cache)) - (condition-case nil - (progn - (message "Searching in LDAP...") - (setq entries (ldap-search-entries - (wl-ldap-make-filter - (concat pat "*") - wl-ldap-search-attribute-type-list) - nil wl-ldap-search-attribute-type-list nil t)) - (message "Searching in LDAP...done") - (elmo-set-hash-val pattern entries wl-address-ldap-search-hash)) - (error (message "")))) ; ignore error: No such object + (ignore-errors + (message "Searching in LDAP...") + (setq entries (ldap-search-entries + (wl-ldap-make-filter + pat wl-ldap-search-attribute-type-list) + nil wl-ldap-search-attribute-type-list nil t)) + (message "Searching in LDAP...done") + (elmo-set-hash-val pattern entries wl-address-ldap-search-hash))) ;; (setq tmpl entries) (while tmpl @@ -241,8 +240,10 @@ Matched address lists are append to CL." (while entries (setq ent (cdar entries) values (wl-ldap-make-matched-value-list - regexp '("mail" "sn" "cn") ent) - mails (wl-ldap-get-value-list "mail" ent) + regexp wl-ldap-search-attribute-type-list + ent) + mails (or (wl-ldap-get-value-list "mail" ent) + (wl-ldap-get-value-list "email" ent)) cn (wl-ldap-get-value "cn" ent) dn (car (car entries)) dnstr (elmo-get-hash-val (upcase dn) dnhash)) @@ -280,39 +281,41 @@ Matched address lists are append to CL." (completing-read "To: " cl) (read-string "To: ")))) -(defconst wl-address-specials-regexp "[]\"(),.:;<>@[\\]") - -(defun wl-address-quote-specials (word) - "Make quoted string of WORD if needed." - (if (string-match wl-address-specials-regexp 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) (while address-list (setq addr-tuple (car address-list)) (setq cl - (cons - (cons (nth 0 addr-tuple) - (concat - (wl-address-quote-specials - (nth 2 addr-tuple)) " <"(nth 0 addr-tuple)">")) - cl)) + (cons + (wl-address-make-completion-entry 0 addr-tuple) + cl)) ;; nickname completion. - (unless (or (equal (nth 1 addr-tuple) (nth 0 addr-tuple)) - ;; already exists - (assoc (nth 1 addr-tuple) cl)) + (if wl-address-enable-strict-loading + (unless (or (equal (nth 1 addr-tuple) (nth 0 addr-tuple)) + ;; already exists + (assoc (nth 1 addr-tuple) cl)) + (setq cl + (cons + (wl-address-make-completion-entry 1 addr-tuple) + cl))) (setq cl (cons - (cons (nth 1 addr-tuple) - (concat - (wl-address-quote-specials - (nth 2 addr-tuple)) " <"(nth 0 addr-tuple)">")) + (wl-address-make-completion-entry 1 addr-tuple) cl))) (setq address-list (cdr address-list))) cl)) +(defun wl-address-make-completion-entry (index addr-tuple) + (cons (nth index addr-tuple) + (if (or (string= (nth 2 addr-tuple) "") + (string-match ".*:.*;$" (nth 0 addr-tuple))) + (nth 0 addr-tuple) + (concat + (wl-address-quote-specials + (nth 2 addr-tuple)) " <"(nth 0 addr-tuple)">")))) + (defun wl-complete-field-body-or-tab () (interactive) (let ((case-fold-search t) @@ -365,7 +368,7 @@ Matched address lists are append to CL." (with-output-to-temp-buffer wl-completion-buf-name (display-completion-list all)) - (message "Making completion list... done"))) + (message "Making completion list...done"))) (defun wl-complete-window-delete () (let (comp-buf comp-win) @@ -385,8 +388,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 @@ -431,6 +434,7 @@ Matched address lists are append to CL." (completion) (pattern (buffer-substring start end)) (len (length pattern)) + (completion-ignore-case t) (cl completion-list)) (when use-ldap (setq cl (wl-address-ldap-search pattern cl))) @@ -493,24 +497,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 @@ -520,7 +524,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) @@ -541,13 +545,13 @@ Refresh `wl-address-list', `wl-address-completion-list', and (if (looking-at "^\\([^#\n][^ \t\n]+\\)[ \t]+\\(\".*\"\\)[ \t]+\\(\".*\"\\)[ \t]*.*$") (setq ret - (wl-append-element - ret + (cons (list (wl-match-buffer 1) (read (wl-match-buffer 2)) - (read (wl-match-buffer 3)))))) + (read (wl-match-buffer 3))) + ret))) (forward-line)) - ret)))) + (nreverse ret))))) (defun wl-address-get-petname-1 (string) (let ((address (downcase (wl-address-header-extract-address string)))) @@ -572,18 +576,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