From 4f5528c337be9eb2f1841ef8ce623308d8272561 Mon Sep 17 00:00:00 2001 From: teranisi Date: Thu, 15 Jun 2000 00:21:54 +0000 Subject: [PATCH] * wl-vars.el (wl-ldap-port): New user option. * wl-address.el (wl-address-ldap-search): Renamed from wl-ldap-search. Rewite whole implementation. (wl-complete-field-body): Fixed. --- wl/ChangeLog | 8 +++++ wl/wl-address.el | 106 ++++++++++++++++++++++++------------------------------ wl/wl-vars.el | 8 ++++- 3 files changed, 61 insertions(+), 61 deletions(-) diff --git a/wl/ChangeLog b/wl/ChangeLog index 3e11448..0955d1c 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,11 @@ +2000-06-15 Yuuichi Teranishi + + * wl-vars.el (wl-ldap-port): New user option. + + * wl-address.el (wl-address-ldap-search): Renamed from wl-ldap-search. + Rewite whole implementation. + (wl-complete-field-body): Fixed. + 2000-06-14 Yuuichi Teranishi * wl-address.el (wl-ldap-search-internal): Renamed to `wl-ldap-search'. diff --git a/wl/wl-address.el b/wl/wl-address.el index a43d598..3e3fd3a 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -4,7 +4,7 @@ ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news -;; Time-stamp: <00/06/14 10:56:07 teranisi> +;; Time-stamp: <00/06/15 00:38:44 teranisi> ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). @@ -41,60 +41,48 @@ (defvar wl-address-completion-list nil) (defvar wl-address-petname-hash nil) -(static-if (and (featurep 'xemacs) - (fboundp 'ldap-open)) -;; LDAP is built-in feature. -(defun wl-ldap-search (pat &optional cl) - "make completion-list by ldap search (use build-in ldap feature)" - (let ((ldap-pat (concat "mail=" pat "*")) - (ret cl) - hdl - search-ret - addr) - (setq hdl (ldap-open wl-ldap-server)) - (setq search-ret - (ldap-search-basic hdl ldap-pat wl-ldap-base 'subtree '("mail"))) - (ldap-close hdl) - (while search-ret - (if (listp search-ret) - (progn - (setq addr (car search-ret)) - (setq search-ret (cdr search-ret)) - (if (listp addr) - (progn - (setq addr (car addr)) - (if (listp addr) - (progn - (setq addr (cdr addr)) - (if (listp addr) - (progn - (setq addr (car addr)) - (setq addr (cons addr addr)) - (if ret - (setq ret (append ret (list addr))) - (setq ret (list addr)))))))))) - (setq search-ret nil))) - ret)) -;; LDAP is not built-in feature. -(defun wl-ldap-search (pat &optional cl) - "make completion-list by ldap search" - (let ((ldap-pat (concat "mail=" pat "*")) - (ret cl) - addr) - (with-temp-buffer - (call-process "ldapsearch" nil (current-buffer) - t "-L" "-b" wl-ldap-base - "-h" wl-ldap-server ldap-pat "mail") - (goto-char (point-min)) - (while (re-search-forward "^\\(mail: \\)\\(.*\\)$" nil t) - (progn - (setq addr (match-string 2)) - (setq addr (cons addr addr)) - (if ret - (setq ret (append ret (list addr))) - (setq ret (list addr)))))) - ret)) -) +(defvar wl-address-ldap-search-hash nil) + +(eval-when-compile (require 'pldap)) + +(defun wl-address-ldap-search (pattern cl) + "Make address completion-list matched for PATTERN by LDAP search. +Matched address lists are append to CL." + (require 'pldap) + (unless wl-address-ldap-search-hash + (setq wl-address-ldap-search-hash (elmo-make-hash))) + (let ((hit (catch 'found + (mapatoms (lambda (atom) + (if (string-match + (concat "^" (symbol-name atom) ".*") + pattern) + (throw 'found (symbol-value atom)))) + wl-address-ldap-search-hash))) + (ldap-default-host wl-ldap-server) + (ldap-default-port (or wl-ldap-port 389)) + (ldap-default-base wl-ldap-base) + result cn mails) + (if hit + (setq result hit) + (setq result (ldap-search-entries (concat "mail=" pattern "*") + nil '("mail" "cn"))) + (elmo-set-hash-val pattern result wl-address-ldap-search-hash)) + (while result + (setq mails (cdr (assoc "mail" (car result)))) + (setq cn nil) + (while mails + (if (and (null (assoc (car mails) cl)) ; Not already in cl. + (string-match pattern (car mails))) + (setq cl (cons (cons (car mails) + (concat + (or cn + (setq cn + (cadr (assoc "cn" (car result))))) + " <" (car mails) ">")) + cl))) + (setq mails (cdr mails))) + (setq result (cdr result))) + cl)) (defun wl-complete-field-to () (interactive) @@ -222,10 +210,8 @@ (pattern (buffer-substring start end)) (len (length pattern)) (cl completion-list)) - (if use-ldap - (progn - (setq completion-list (wl-ldap-search pattern cl)) - (setq cl completion-list))) + (when use-ldap + (setq cl (wl-address-ldap-search pattern cl))) (if (null cl) (if use-ldap (progn @@ -233,7 +219,7 @@ (ding))) (setq completion (try-completion pattern cl)) (cond ((eq completion t) - (wl-complete-insert start end pattern completion-list) + (wl-complete-insert start end pattern cl) (wl-complete-window-delete) (message "Sole completion")) ((and epand-char diff --git a/wl/wl-vars.el b/wl/wl-vars.el index b5e43dd..d207074 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -4,7 +4,7 @@ ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news -;; Time-stamp: <00/06/12 13:43:58 teranisi> +;; Time-stamp: <00/06/14 23:38:57 teranisi> ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). @@ -591,6 +591,12 @@ Default is for 'reply-to-all'." :type '(string :tag "Server") :group 'wl) +(defcustom wl-ldap-port nil + "*LDAP port." + :type '(choice (const :tag "Default port" nil) + integer) + :group 'wl) + (defcustom wl-ldap-base "c=US" "*LDAP base." :type '(string :tag "Base") -- 1.7.10.4