X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-address.el;h=d168f5254e77a6cafca8d3a312ca53b08ee4d262;hb=c20fb61cd99f50dd4eb03aa29a40b44c802efe17;hp=13751c6fede2e5ed2049914f9bce459091766285;hpb=f3d35a20272dce997e602909c9ab8f87f576dfeb;p=elisp%2Fwanderlust.git diff --git a/wl/wl-address.el b/wl/wl-address.el index 13751c6..d168f52 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -37,12 +37,16 @@ (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) "" @@ -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)) @@ -288,31 +289,33 @@ Matched address lists are append to CL." (setq addr-tuple (car address-list)) (setq cl (cons - (cons (nth 0 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)">"))) + (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) - (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)">"))) + (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) @@ -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))) @@ -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))))