*** empty log message ***

10 files changed, 3742 insertions, 0 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 543eb3e5960..01bd57f25c9 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
 2000-01-12  Gerd Moellmann  <gerd@gnu.org>
 
+	* net/eudc-bob.el, net/eudc-export.el, net/eudc-hotlist.el,
+	net/eudc-vars.el, net/eudc.el, net/eudcb-bbdb.el,
+	net/eudcb-ldap.el, net/eudcb-ph.el, net/ldap.el: New files.
+	
 	* add-log.el (add-change-log-entry): Fix error trying an `(insert
 	nil)'.
 
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
new file mode 100644
index 00000000000..f2bd4eb62eb
--- /dev/null
+++ b/lisp/net/eudc-bob.el
@@ -0,0 +1,329 @@
+;;; eudc-bob.el --- Binary Objects Support for EUDC
+
+;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <oscar@xemacs.org>
+;; Maintainer: Oscar Figueiredo <oscar@xemacs.org>
+;; Keywords: help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Usage:
+;;    See the corresponding info file
+
+;;; Code:
+
+(require 'eudc)
+
+(defvar eudc-bob-generic-keymap nil
+  "Keymap for multimedia objects.")
+
+(defvar eudc-bob-image-keymap nil
+  "Keymap for inline images.")
+
+(defvar eudc-bob-sound-keymap nil
+  "Keymap for inline images.")
+
+(defvar eudc-bob-url-keymap nil
+  "Keymap for inline images.")
+
+(defconst eudc-bob-generic-menu
+  '("EUDC Binary Object Menu"
+    ["---" nil nil]
+    ["Pipe to external program" eudc-bob-pipe-object-to-external-program t]
+    ["Save object" eudc-bob-save-object t]))
+
+(defconst eudc-bob-image-menu
+  `("EUDC Image Menu"
+    ["---" nil nil]
+    ["Toggle inline display" eudc-bob-toggle-inline-display
+     (eudc-bob-can-display-inline-images)]
+    ,@(cdr (cdr eudc-bob-generic-menu))))
+ 
+(defconst eudc-bob-sound-menu
+  `("EUDC Sound Menu"
+    ["---" nil nil]
+    ["Play sound" eudc-bob-play-sound-at-point 
+     (fboundp 'play-sound)]
+    ,@(cdr (cdr eudc-bob-generic-menu))))
+ 
+(defun eudc-jump-to-event (event)
+  "Jump to the window and point where EVENT occurred."
+  (if eudc-xemacs-p
+      (goto-char (event-closest-point event))
+    (set-buffer (window-buffer (posn-window (event-start event))))
+    (goto-char (posn-point (event-start event)))))
+
+(defun eudc-bob-get-overlay-prop (prop)
+  "Get property PROP from one of the overlays around."
+  (let ((overlays (append (overlays-at (1- (point)))
+			  (overlays-at (point))))
+	overlay value
+	(notfound t))
+    (while (and notfound
+		(setq overlay (car overlays)))
+      (if (setq value (overlay-get overlay prop))
+	  (setq notfound nil))
+      (setq overlays (cdr overlays)))
+    value))
+
+(defun eudc-bob-can-display-inline-images ()
+  "Return non-nil if we can display images inline."
+  (and eudc-xemacs-p
+       (memq (console-type) 
+	     '(x mswindows))
+       (fboundp 'make-glyph)))
+
+(defun eudc-bob-make-button (label keymap &optional menu plist)
+  "Create a button with LABEL.
+Attach KEYMAP, MENU and properties from PLIST to a new overlay covering 
+LABEL."
+  (let (overlay
+	(p (point))
+	prop val)
+    (insert label)
+    (put-text-property p (point) 'face 'bold)    
+    (setq overlay (make-overlay p (point)))
+    (overlay-put overlay 'mouse-face 'highlight)
+    (overlay-put overlay 'keymap keymap)
+    (overlay-put overlay 'local-map keymap)
+    (overlay-put overlay 'menu menu)
+    (while plist
+      (setq prop (car plist)
+	    plist (cdr plist)
+	    val (car plist)
+	    plist (cdr plist))
+      (overlay-put overlay prop val))))
+
+(defun eudc-bob-display-jpeg (data inline)
+  "Display the JPEG DATA at point.
+if INLINE is non-nil, try to inline the image otherwise simply 
+display a button."
+  (let ((glyph (if (eudc-bob-can-display-inline-images)
+		   (make-glyph (list (vector 'jpeg :data data) 
+				     [string :data "[JPEG Picture]"])))))
+    (eudc-bob-make-button "[JPEG Picture]"
+			  eudc-bob-image-keymap
+			  eudc-bob-image-menu
+			  (list 'glyph glyph
+				'end-glyph (if inline glyph)
+				'duplicable t
+				'invisible inline
+				'start-open t
+				'end-open t
+				'object-data data))))
+
+(defun eudc-bob-toggle-inline-display ()
+  "Toggle inline display of an image."
+  (interactive)
+  (if (eudc-bob-can-display-inline-images)
+      (let ((overlays (append (overlays-at (1- (point)))
+			      (overlays-at (point))))
+	    overlay glyph)
+	(setq overlay (car overlays))
+	(while (and overlay
+		    (not (setq glyph (overlay-get overlay 'glyph))))
+	  (setq overlays (cdr overlays))
+	  (setq overlay (car overlays)))
+	(if overlay
+	    (if (overlay-get overlay 'end-glyph)
+		(progn
+		  (overlay-put overlay 'end-glyph nil)
+		  (overlay-put overlay 'invisible nil))
+	      (overlay-put overlay 'end-glyph glyph)
+	      (overlay-put overlay 'invisible t))))))
+
+(defun eudc-bob-display-audio (data)
+  "Display a button for audio DATA."
+  (eudc-bob-make-button "[Audio Sound]"
+			eudc-bob-sound-keymap
+			eudc-bob-sound-menu
+			(list 'duplicable t
+			      'start-open t
+			      'end-open t
+			      'object-data data)))
+
+
+(defun eudc-bob-display-generic-binary (data)
+  "Display a button for unidentified binary DATA."
+  (eudc-bob-make-button "[Binary Data]"
+			eudc-bob-generic-keymap
+			eudc-bob-generic-menu
+			(list 'duplicable t
+			      'start-open t
+			      'end-open t
+			      'object-data data)))
+
+(defun eudc-bob-play-sound-at-point ()
+  "Play the sound data contained in the button at point."
+  (interactive)
+  (let (sound)
+    (if (null (setq sound (eudc-bob-get-overlay-prop 'object-data)))
+	(error "No sound data available here")
+      (if (not (and (boundp 'sound-alist)
+		    sound-alist))
+	  (error "Don't know how to play sound on this Emacs version")
+	(setq sound-alist 
+	      (cons (list 'eudc-sound 
+			  :sound sound)
+		    sound-alist))
+	(condition-case nil
+	    (play-sound 'eudc-sound)
+	  (t 
+	   (setq sound-alist (cdr sound-alist))))))))
+  
+
+(defun eudc-bob-play-sound-at-mouse (event)
+  "Play the sound data contained in the button where EVENT occurred."
+  (interactive "e")
+  (save-excursion
+    (eudc-jump-to-event event)
+    (eudc-bob-play-sound-at-point)))
+  
+
+(defun eudc-bob-save-object ()
+  "Save the object data of the button at point."
+  (interactive)
+  (let ((data (eudc-bob-get-overlay-prop 'object-data))
+	(buffer (generate-new-buffer "*eudc-tmp*")))
+    (save-excursion
+      (if (fboundp 'set-buffer-file-coding-system)
+	  (set-buffer-file-coding-system 'binary))
+      (set-buffer buffer)
+      (insert data)
+      (save-buffer))
+    (kill-buffer buffer)))
+
+(defun eudc-bob-pipe-object-to-external-program ()
+  "Pipe the object data of the button at point to an external program."
+  (interactive)
+  (let ((data (eudc-bob-get-overlay-prop 'object-data))
+	(buffer (generate-new-buffer "*eudc-tmp*"))
+	program
+	viewer)
+    (condition-case nil
+	(save-excursion
+	  (if (fboundp 'set-buffer-file-coding-system)
+	      (set-buffer-file-coding-system 'binary))
+	  (set-buffer buffer)
+	  (insert data)
+	  (setq program (completing-read "Viewer: " eudc-external-viewers))
+	  (if (setq viewer (assoc program eudc-external-viewers))
+	      (call-process-region (point-min) (point-max) 
+				   (car (cdr viewer)) 
+				   (cdr (cdr viewer)))
+	    (call-process-region (point-min) (point-max) program)))
+      (t
+       (kill-buffer buffer)))))
+
+(defun eudc-bob-menu ()
+  "Retrieve the menu attached to a binary object."
+  (eudc-bob-get-overlay-prop 'menu))
+  
+(defun eudc-bob-popup-menu (event)
+  "Pop-up a menu of EUDC multimedia commands."
+  (interactive "@e")
+  (run-hooks 'activate-menubar-hook)
+  (eudc-jump-to-event event)
+  (if eudc-xemacs-p
+      (progn 
+	(run-hooks 'activate-popup-menu-hook)
+	(popup-menu (eudc-bob-menu)))
+    (let ((result (x-popup-menu t (eudc-bob-menu)))
+	  command)
+      (if result
+	  (progn
+	    (setq command (lookup-key (eudc-bob-menu)
+				      (apply 'vector result)))
+	    (command-execute command))))))
+
+(setq eudc-bob-generic-keymap
+      (let ((map (make-sparse-keymap)))
+	(define-key map "s" 'eudc-bob-save-object)
+	(define-key map (if eudc-xemacs-p
+			    [button3]
+			  [down-mouse-3]) 'eudc-bob-popup-menu)
+	map))
+
+(setq eudc-bob-image-keymap
+      (let ((map (make-sparse-keymap)))
+	(define-key map "t" 'eudc-bob-toggle-inline-display)
+	map))
+
+(setq eudc-bob-sound-keymap
+      (let ((map (make-sparse-keymap)))
+	(define-key map [return] 'eudc-bob-play-sound-at-point)
+	(define-key map (if eudc-xemacs-p
+			    [button2]
+			  [down-mouse-2]) 'eudc-bob-play-sound-at-mouse)
+	map))
+
+(setq eudc-bob-url-keymap
+      (let ((map (make-sparse-keymap)))
+	(define-key map [return] 'browse-url-at-point)
+	(define-key map (if eudc-xemacs-p
+			    [button2]
+			  [down-mouse-2]) 'browse-url-at-mouse)
+	map))
+
+(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap)
+(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap)
+
+    
+(if eudc-emacs-p
+    (progn
+      (easy-menu-define eudc-bob-generic-menu 
+			eudc-bob-generic-keymap
+			""
+			eudc-bob-generic-menu)
+      (easy-menu-define eudc-bob-image-menu 
+			eudc-bob-image-keymap
+			""
+			eudc-bob-image-menu)
+      (easy-menu-define eudc-bob-sound-menu 
+			eudc-bob-sound-keymap
+			""
+			eudc-bob-sound-menu)))
+
+;;;###autoload
+(defun eudc-display-generic-binary (data)
+  "Display a button for unidentified binary DATA."
+  (eudc-bob-display-generic-binary data))
+
+;;;###autoload
+(defun eudc-display-url (url)
+  "Display URL and make it clickable."
+  (require 'browse-url)
+  (eudc-bob-make-button url eudc-bob-url-keymap))
+
+;;;###autoload
+(defun eudc-display-sound (data)
+  "Display a button to play the sound DATA."
+  (eudc-bob-display-audio data))
+
+;;;###autoload
+(defun eudc-display-jpeg-inline (data)
+  "Display the JPEG DATA inline at point if possible."
+  (eudc-bob-display-jpeg data (eudc-bob-can-display-inline-images)))
+
+;;;###autoload
+(defun eudc-display-jpeg-as-button (data)
+  "Display a button for the JPEG DATA."
+  (eudc-bob-display-jpeg data nil))
+    
+;;; eudc-bob.el ends here
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
new file mode 100644
index 00000000000..641b26ce1c7
--- /dev/null
+++ b/lisp/net/eudc-export.el
@@ -0,0 +1,218 @@
+;;; eudc-export.el --- Functions to export EUDC qeuery results
+
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <oscar@xemacs.org>
+;; Maintainer: Oscar Figueiredo <oscar@xemacs.org>
+;; Keywords: help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Usage:
+;;    See the corresponding info file
+
+;;; Code:
+
+(require 'eudc)
+
+(if (not (featurep 'bbdb))
+    (load-library "bbdb"))
+(if (not (featurep 'bbdb-com))
+    (load-library "bbdb-com"))
+
+(defun eudc-create-bbdb-record (record &optional silent)
+  "Create a BBDB record using the RECORD alist.
+RECORD is an alist of (KEY . VALUE) where KEY is a directory attribute name
+symbol and VALUE is the corresponding value for the record.
+If SILENT is non-nil then the created BBDB record is not displayed."
+  ;; This function runs in a special context where lisp symbols corresponding
+  ;; to field names in record are bound to the corresponding values
+  (eval 
+   `(let* (,@(mapcar '(lambda (c)
+			(list (car c) (if (listp (cdr c))
+					  (list 'quote (cdr c))
+					(cdr c))))
+		     record)
+	     bbdb-name
+	     bbdb-company
+	     bbdb-net
+	     bbdb-address
+	     bbdb-phones
+	     bbdb-notes
+	     spec
+	     bbdb-record
+	     value
+	     (conversion-alist (symbol-value eudc-bbdb-conversion-alist)))
+
+      ;; BBDB standard fields
+      (setq bbdb-name (eudc-parse-spec (cdr (assq 'name conversion-alist)) record nil)
+	    bbdb-company (eudc-parse-spec (cdr (assq 'company conversion-alist)) record nil)
+	    bbdb-net (eudc-parse-spec (cdr (assq 'net conversion-alist)) record nil)
+	    bbdb-notes (eudc-parse-spec (cdr (assq 'notes conversion-alist)) record nil))
+      (setq spec (cdr (assq 'address conversion-alist)))
+      (setq bbdb-address (delq nil (eudc-parse-spec (if (listp (car spec))
+						      spec
+						    (list spec))
+						  record t)))
+      (setq spec (cdr (assq 'phone conversion-alist)))
+      (setq bbdb-phones (delq nil (eudc-parse-spec (if (listp (car spec))
+						     spec
+						   (list spec))
+						 record t)))
+      ;; BBDB custom fields
+      (setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
+			       (mapcar (function
+					(lambda (mapping)
+					  (if (and (not (memq (car mapping)
+							      '(name company net address phone notes)))
+						   (setq value (eudc-parse-spec (cdr mapping) record nil)))
+					      (cons (car mapping) value))))
+				       conversion-alist)))
+      (setq bbdb-notes (delq nil bbdb-notes))
+      (setq bbdb-record (bbdb-create-internal bbdb-name 
+					      bbdb-company 
+					      bbdb-net
+					      bbdb-address
+					      bbdb-phones
+					      bbdb-notes))
+      (or silent
+	  (bbdb-display-records (list bbdb-record))))))
+
+(defun eudc-parse-spec (spec record recurse)
+  "Parse the conversion SPEC using RECORD.
+If RECURSE is non-nil then SPEC may be a list of atomic specs."
+  (cond 
+   ((or (stringp spec)
+	(symbolp spec)
+	(and (listp spec)
+	     (symbolp (car spec))
+	     (fboundp (car spec))))
+    (condition-case nil
+	(eval spec)
+      (void-variable nil)))
+   ((and recurse
+	 (listp spec))
+    (mapcar '(lambda (spec-elem)
+	       (eudc-parse-spec spec-elem record nil))
+	    spec))
+   (t
+    (error "Invalid specification for `%s' in `eudc-bbdb-conversion-alist'" spec))))
+
+(defun eudc-bbdbify-address (addr location)
+  "Parse ADDR into a vector compatible with BBDB.
+ADDR should be an address string of no more than four lines or a
+list of lines.
+The last two lines are searched for the zip code, city and state name.
+LOCATION is used as the address location for bbdb."
+  (let* ((addr-components (if (listp addr)
+			      (reverse addr)
+			    (reverse (split-string addr "\n"))))
+	 (last1 (pop addr-components))
+	 (last2 (pop addr-components))
+	 zip city state)
+    (setq addr-components (nreverse addr-components))
+    ;; If not containing the zip code the last line is supposed to contain a
+    ;; country name and the addres is supposed to be in european style
+    (if (not (string-match "[0-9][0-9][0-9]" last1))
+	(progn
+	  (setq state last1)
+	  (if (string-match "\\([0-9]+\\)[ \t]+\\(.*\\)" last2)
+	      (setq city (match-string 2 last2)
+		    zip (string-to-number (match-string 1 last2)))
+	    (error "Cannot parse the address")))
+      (cond
+       ;; American style
+       ((string-match "\\(\\w+\\)\\W*\\([A-Z][A-Z]\\)\\W*\\([0-9]+\\)" last1)
+	(setq city (match-string 1 last1)
+	      state (match-string 2 last1)
+	      zip (string-to-number (match-string 3 last1))))
+       ;; European style
+       ((string-match "\\([0-9]+\\)[ \t]+\\(.*\\)" last1)
+	(setq city (match-string 2 last1)
+	      zip (string-to-number (match-string 1 last1))))
+       (t
+	(error "Cannot parse the address"))))
+    (vector location 
+	    (or (nth 0 addr-components) "")
+	    (or (nth 1 addr-components) "")
+	    (or (nth 2 addr-components) "")
+	    (or city "")
+	    (or state "")
+	    zip)))
+
+(defun eudc-bbdbify-phone (phone location)
+  "Parse PHONE into a vector compatible with BBDB.
+PHONE is either a string supposedly containing a phone number or
+a list of such strings which are concatenated.
+LOCATION is used as the phone location for BBDB."
+  (cond 
+   ((stringp phone)
+    (let (phone-list)
+      (condition-case err
+	  (setq phone-list (bbdb-parse-phone-number phone))
+	(error
+	 (if (string= "phone number unparsable." (eudc-cadr err))
+	     (if (not (y-or-n-p (format "BBDB claims %S to be unparsable--insert anyway? " phone)))
+		 (error "Phone number unparsable")
+	       (setq phone-list (list (bbdb-string-trim phone))))
+	   (signal (car err) (cdr err)))))
+      (if (= 3 (length phone-list))
+	  (setq phone-list (append phone-list '(nil))))
+      (apply 'vector location phone-list)))
+   ((listp phone)
+    (vector location (mapconcat 'identity phone ", ")))
+   (t
+    (error "Invalid phone specification"))))
+      
+(defun eudc-batch-export-records-to-bbdb ()
+  "Insert all the records returned by a directory query into BBDB."
+  (interactive)
+  (goto-char (point-min))
+  (let ((nbrec 0)
+	record)
+    (while (eudc-move-to-next-record)
+      (and (overlays-at (point))
+	   (setq record (overlay-get (car (overlays-at (point))) 'eudc-record))
+	   (1+ nbrec)
+	   (eudc-create-bbdb-record record t)))
+    (message "%d records imported into BBDB" nbrec)))
+
+;;;###autoload
+(defun eudc-insert-record-at-point-into-bbdb ()
+  "Insert record at point into the BBDB database.
+This function can only be called from a directory query result buffer."
+  (interactive)
+  (let ((record (and (overlays-at (point))
+		     (overlay-get (car (overlays-at (point))) 'eudc-record))))
+    (if (null record)
+	(error "Point is not over a record")
+      (eudc-create-bbdb-record record))))
+
+;;;###autoload
+(defun eudc-try-bbdb-insert ()
+  "Call `eudc-insert-record-at-point-into-bbdb' if on a record."
+  (interactive)
+  (and (or (featurep 'bbdb)
+	   (prog1 (locate-library "bbdb") (message "")))
+       (overlays-at (point))
+       (overlay-get (car (overlays-at (point))) 'eudc-record)
+       (eudc-insert-record-at-point-into-bbdb)))
+
+;;; eudc-export.el ends here
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
new file mode 100644
index 00000000000..bd2962effd5
--- /dev/null
+++ b/lisp/net/eudc-hotlist.el
@@ -0,0 +1,197 @@
+;;; eudc-hotlist.el --- Hotlist Management for EUDC
+
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <oscar@xemacs.org>
+;; Maintainer: Oscar Figueiredo <oscar@xemacs.org>
+;; Keywords: help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Usage:
+;;    See the corresponding info file
+
+;;; Code:
+
+(require 'eudc)
+
+(defvar eudc-hotlist-menu nil)
+(defvar eudc-hotlist-mode-map nil)
+(defvar eudc-hotlist-list-beginning nil)
+
+(defun eudc-hotlist-mode ()
+  "Major mode used to edit the hotlist of servers.
+
+These are the special commands of this mode:
+    a -- Add a new server to the list.
+    d -- Delete the server at point from the list.
+    s -- Select the server at point.
+    t -- Transpose the server at point and the previous one
+    q -- Commit the changes and quit.
+    x -- Quit without commiting the changes."
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'eudc-hotlist-mode)
+  (setq mode-name "EUDC-Servers")
+  (use-local-map eudc-hotlist-mode-map)
+  (setq mode-popup-menu eudc-hotlist-menu)
+  (when (and eudc-xemacs-p
+	     (featurep 'menubar))
+    (set-buffer-menubar current-menubar)
+    (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu)))))
+  (setq buffer-read-only t))
+
+;;;###autoload
+(defun eudc-edit-hotlist ()
+  "Edit the hotlist of directory servers in a specialized buffer."
+  (interactive)
+  (let ((proto-col 0)
+	gap)
+    (switch-to-buffer (get-buffer-create "*EUDC Servers*"))
+    (setq buffer-read-only nil)
+    (erase-buffer)
+    (mapcar (function 
+	     (lambda (entry)
+	       (setq proto-col (max (length (car entry)) proto-col))))
+	    eudc-server-hotlist)
+    (setq proto-col (+ 3 proto-col))
+    (setq gap (make-string (- proto-col 6) ?\ ))
+    (insert "              EUDC Servers\n"
+	    "              ============\n"
+	    "\n"
+	    "Server" gap "Protocol\n"
+	    "------" gap "--------\n"
+	    "\n")
+    (setq eudc-hotlist-list-beginning (point))
+    (mapcar '(lambda (entry)
+	     (insert (car entry))
+	     (indent-to proto-col)
+	     (insert (symbol-name (cdr entry)) "\n"))
+	  eudc-server-hotlist)
+  (eudc-hotlist-mode)))
+
+(defun eudc-hotlist-add-server ()
+  "Add a new server to the list after current one."
+  (interactive)
+  (if (not (eq major-mode 'eudc-hotlist-mode))
+      (error "Not in a EUDC hotlist edit buffer"))
+  (let ((server (read-from-minibuffer "Server: "))
+	(protocol (completing-read "Protocol: "
+				   (mapcar '(lambda (elt)
+					      (cons (symbol-name elt)
+						    elt))
+					   eudc-known-protocols)))
+	(buffer-read-only nil))
+    (if (not (eobp))
+	(forward-line 1))
+    (insert server)
+    (indent-to 30)
+    (insert protocol "\n")))
+
+(defun eudc-hotlist-delete-server ()
+  "Delete the server at point from the list."
+  (interactive)
+  (if (not (eq major-mode 'eudc-hotlist-mode))
+      (error "Not in a EUDC hotlist edit buffer"))
+  (let ((buffer-read-only nil))
+    (save-excursion
+      (beginning-of-line)
+      (if (and (>= (point) eudc-hotlist-list-beginning)     
+	       (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
+	  (kill-line 1)
+	(error "No server on this line")))))
+
+(defun eudc-hotlist-quit-edit ()
+  "Quit the hotlist editing mode and save changes to the hotlist."
+  (interactive)
+  (if (not (eq major-mode 'eudc-hotlist-mode))
+      (error "Not in a EUDC hotlist edit buffer"))
+  (let (hotlist)
+    (goto-char eudc-hotlist-list-beginning)
+    (while (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")
+      (setq hotlist (cons (cons (match-string 1)
+				(intern (match-string 2)))
+			  hotlist))
+      (forward-line 1))
+    (if (not (looking-at "^[ \t]*$"))
+	(error "Malformed entry in hotlist, discarding edits")) 
+    (setq eudc-server-hotlist (nreverse hotlist))
+    (eudc-install-menu)
+    (eudc-save-options)
+    (kill-this-buffer)))
+
+(defun eudc-hotlist-select-server ()
+  "Select the server at point as the current server."
+  (interactive)
+  (if (not (eq major-mode 'eudc-hotlist-mode))
+      (error "Not in a EUDC hotlist edit buffer"))
+  (save-excursion
+    (beginning-of-line)
+    (if (and (>= (point) eudc-hotlist-list-beginning)
+	     (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
+	(progn
+	  (eudc-set-server (match-string 1) (intern (match-string 2)))
+	  (message "Current directory server is %s (%s)" eudc-server eudc-protocol))
+      (error "No server on this line"))))
+      
+(defun eudc-hotlist-transpose-servers ()
+  "Swap the order of the server with the previous one in the list."
+  (interactive)
+  (if (not (eq major-mode 'eudc-hotlist-mode))
+      (error "Not in a EUDC hotlist edit buffer"))
+  (let ((buffer-read-only nil))
+    (save-excursion
+      (beginning-of-line)
+      (if (and (>= (point) eudc-hotlist-list-beginning)
+	       (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")
+	       (progn 
+		 (forward-line -1)
+		 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")))
+	  (progn
+	    (forward-line 1)
+	    (transpose-lines 1))))))
+  
+(setq eudc-hotlist-mode-map
+      (let ((map (make-sparse-keymap)))
+	(define-key map "a" 'eudc-hotlist-add-server)
+	(define-key map "d" 'eudc-hotlist-delete-server)
+	(define-key map "s" 'eudc-hotlist-select-server)
+	(define-key map "t" 'eudc-hotlist-transpose-servers)
+	(define-key map "q" 'eudc-hotlist-quit-edit)
+	(define-key map "x" 'kill-this-buffer)
+	map))
+
+(defconst eudc-hotlist-menu
+  '("EUDC Hotlist Edit"
+    ["---" nil nil]
+    ["Add New Server" eudc-hotlist-add-server t]
+    ["Delete Server" eudc-hotlist-delete-server t]
+    ["Select Server" eudc-hotlist-select-server t]
+    ["Transpose Servers" eudc-hotlist-transpose-servers t]
+    ["Save and Quit" eudc-hotlist-quit-edit t]
+    ["Exit without Saving" kill-this-buffer t]))
+
+(if eudc-emacs-p
+    (easy-menu-define eudc-hotlist-emacs-menu 
+		      eudc-hotlist-mode-map
+		      ""
+		      eudc-hotlist-menu))
+
+;;; eudc-hotlist.el ends here
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
new file mode 100644
index 00000000000..c30f5b9acd4
--- /dev/null
+++ b/lisp/net/eudc-vars.el
@@ -0,0 +1,405 @@
+;;; eudc-vars.el --- Emacs Unified Directory Client
+
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <oscar@xemacs.org>
+;; Maintainer: Oscar Figueiredo <oscar@xemacs.org>
+;; Keywords: help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'custom)
+
+;;{{{      EUDC Main Custom Group
+
+(defgroup eudc nil 
+  "Emacs Unified Directory Client."
+  :group 'mail
+  :group 'comm)
+
+(defcustom eudc-server nil
+  "*The name or IP address of the directory server.
+A port number may be specified by appending a colon and a
+number to the name of the server.  Use `localhost' if the directory
+server resides on your computer (BBDB backend)."
+  :type  '(string :tag "Server")
+  :group 'eudc)
+
+;; Known protocols (used in completion)
+;; Not to be mistaken with `eudc-supported-protocols'
+(defvar eudc-known-protocols '(bbdb ph ldap))
+
+(defvar eudc-supported-protocols nil
+  "Protocols currently supported by EUDC.
+This variable is updated when protocol-specific libraries
+are loaded, *do not change manually*.")
+
+(defcustom eudc-protocol nil
+  "*The directory protocol to use to query the server.
+Supported protocols are specified by `eudc-supported-protocols'."
+  :type  `(choice :menu-tag "Protocol"
+		  ,@(mapcar (lambda (s) 
+			      (list 'const ':tag (symbol-name s) s))
+			    eudc-known-protocols))
+  :group 'eudc)
+
+
+(defcustom eudc-strict-return-matches t
+  "*Ignore or allow entries not containing all requested return attributes.
+If non-nil, such entries are ignored."
+  :type  'boolean
+  :group 'eudc)
+
+(defcustom eudc-default-return-attributes nil
+  "*A list of default attributes to extract from directory entries.
+If set to the symbol `all', return all attributes.
+A value of nil means return the default attributes as configured in the
+server."
+  :type  '(choice :menu-tag "Return Attributes"
+		  (const :menu-tag "Server defaults (nil)" nil)
+		  (const :menu-tag "All" all)
+		  (repeat :menu-tag "Attribute list" 
+			  :tag "Attribute name"
+			  :value (nil)
+			  (symbol :tag "Attribute name")))
+  :group 'eudc)
+
+(defcustom eudc-multiple-match-handling-method 'select
+  "*What to do when multiple entries match an inline expansion query.
+Possible values are: 
+`first' (equivalent to nil) which means keep the first match only,
+`select' pop-up a selection buffer,
+`all' expand to all matches,
+`abort' the operation is aborted, an error is signaled."
+  :type  '(choice :menu-tag "Method"
+		  (const :menu-tag "Use First" 
+			 :tag "Use First"  first)
+		  (const :menu-tag "Select Interactively" 
+			 :tag "Select Interactively" select)
+		  (const :menu-tag "Use All" 
+			 :tag "Use All"    all)
+		  (const :menu-tag "Abort Operation" 
+			 :tag "Abort Operation"  abort)
+		  (const :menu-tag "Default (Use First)" 
+			 :tag "Default (Use First)" nil))
+  :group 'eudc)
+
+(defcustom eudc-duplicate-attribute-handling-method '((email . duplicate))
+  "*A method to handle entries containing duplicate attributes.
+This is either an alist (ATTR . METHOD) or a symbol METHOD.
+The alist form of the variable associates a method to an individual attribute,
+the second form specifies a method applicable to all attributes.
+Available methods are:
+`list' or nil lets the value of the attribute be a list of values,
+`first' keeps the first value and discards the others,
+`concat' concatenates the values into a single multiline string,
+`duplicate' duplicates the entire entry into as many instances as 
+different values."
+  :type '(choice (const :menu-tag "List" list)
+		 (const :menu-tag "First" first)
+		 (const :menu-tag "Concat" concat)
+		 (const :menu-tag "Duplicate" duplicate)
+		 (repeat :menu-tag "Per Attribute Specification"
+			 :tag "Per Attribute Specification"
+			 (cons :tag "Attribute/Method"
+			       :value (nil . list)
+			       (symbol :tag "Attribute name")
+			       (choice :tag "Method"
+				       :menu-tag "Method"
+				       (const :menu-tag "List" list)
+				       (const :menu-tag "First" first)
+				       (const :menu-tag "Concat" concat)
+				       (const :menu-tag "Duplicate" duplicate)))))
+  :group 'eudc)
+
+(defcustom eudc-inline-query-format '((name) 
+				      (firstname name))
+  "*Format of an inline expansion query.
+This is a list of FORMATs.  A FORMAT is itself a list of one or more 
+EUDC attribute names.  A FORMAT applies if it contains as many attributes as
+there are individual words in the inline query string.
+If several FORMATs apply then they are tried in order until a match 
+is found.  
+If nil, all the words are mapped onto the default server or protocol 
+attribute name.
+
+The attribute names in FORMATs are not restricted to EUDC attribute names
+but can also be protocol/server specific names.  In this case, this variable
+must be set in a protocol/server-local fashion, see `eudc-server-set' and
+`eudc-protocol-set'."
+  :tag "Format of Inline Expansion Queries"
+  :type  '(repeat
+	   (repeat
+	    :menu-tag "Format"
+	    :tag "Format"
+	    (choice
+	     :tag "Attribute"
+	     (const :menu-tag "First Name" :tag "First Name" firstname)
+	     (const :menu-tag "Surname" :tag "Surname" name)
+	     (const :menu-tag "Email Address" :tag "Email Address" email)
+	     (const :menu-tag "Phone" :tag "Phone" phone)
+	     (symbol :menu-tag "Other" :tag "Attribute name"))))
+  :group 'eudc)
+
+(defcustom eudc-expansion-overwrites-query t
+  "*If non nil, expanding a query overwrites the query string."
+  :type  'boolean
+  :group 'eudc)
+
+(defcustom eudc-inline-expansion-format '("%s" email)
+  "*A list specifying the format of the expansion of inline queries.
+This variable controls what `eudc-expand-inline' actually inserts in
+the buffer.  First element is a string passed to `format'.  Remaining
+elements are symbols indicating attribute names; the corresponding values
+are passed as additional arguments to `format'."
+  :type  '(list 
+	   (string :tag "Format String")
+	   (repeat :inline t
+		   :tag "Attributes"
+		   (choice 
+		    :tag "Attribute"
+		    (const :menu-tag "First Name" :tag "First Name" firstname)
+		    (const :menu-tag "Surname" :tag "Surname" name)
+		    (const :menu-tag "Email Address" :tag "Email Address" email)
+		    (const :menu-tag "Phone" :tag "Phone" phone)
+		    (symbol :menu-tag "Other")
+		    (symbol :tag "Attribute name"))))
+  :group 'eudc)
+
+(defcustom eudc-inline-expansion-servers 'server-then-hotlist
+  "*Which servers to contact for the expansion of inline queries.
+Possible values are:
+  `current-server': the EUDC current server.
+  `hotlist': the servers of the hotlist in the order they appear,
+  `server-then-hotlist': the current server and then the servers of 
+  the hotlist."
+  :type '(choice :tag "Servers"
+		 :menu-tag "Servers"
+		 (const :menu-tag "Current server" current-server)
+		 (const :menu-tag "Servers in the hotlist" hotlist)
+		 (const :menu-tag "Current server then hotlist" server-then-hotlist))
+  :group 'eudc)
+
+(defcustom eudc-max-servers-to-query nil
+  "*Maximum number of servers to query for an inline expansion.
+If nil, query all servers available from `eudc-inline-expansion-servers'."
+  :tag "Max Number of Servers to Query"
+  :type '(choice :tag "Max. Servers"
+		 :menu-tag "Max. Servers"
+		 (const :menu-tag "No limit" nil)
+		 (const :menu-tag "1" 1)
+		 (const :menu-tag "2" 2)
+		 (const :menu-tag "3" 3)
+		 (const :menu-tag "4" 4)
+		 (const :menu-tag "5" 5)
+		 (integer :menu-tag "Set"))
+  :group 'eudc)
+
+(defcustom eudc-query-form-attributes '(name firstname email phone)
+  "*A list of attributes presented in the query form."
+  :tag   "Attributes in Query Forms"
+  :type  '(repeat 	   
+	   (choice
+	    :tag "Attribute"
+	    (const :menu-tag "First Name" :tag "First Name" firstname)
+	    (const :menu-tag "Surname" :tag "Surname" name)
+	    (const :menu-tag "Email Address" :tag "Email Address" email)
+	    (const :menu-tag "Phone" :tag "Phone" phone)
+	    (symbol :menu-tag "Other" :tag "Attribute name")))
+  :group 'eudc)
+
+(defcustom eudc-user-attribute-names-alist '((url . "URL")
+					     (callsign . "HAM Call Sign")
+					     (id . "ID")
+					     (email . "E-Mail")
+					     (firstname . "First Name")
+					     (cn . "Full Name")
+					     (sn . "Surname")
+					     (givenname . "First Name")
+					     (ou . "Unit")
+					     (labeledurl . "URL")
+					     (postaladdress . "Address")
+					     (postalcode . "Postal Code")
+					     (l . "Location")
+					     (c . "Country")
+					     (o . "Organization")
+					     (roomnumber . "Office")
+					     (telephonenumber . "Phone")
+					     (uniqueidentifier . "ID")
+					     (objectclass . "Object Class"))
+  "*Alist of user-defined names for directory attributes.
+These names are used as prompt strings in query/response forms 
+instead of the raw directory attribute names.
+Prompt strings for attributes that are not listed here
+are derived by splitting the attribute name
+at `_' characters and capitalizing the individual words."
+  :tag   "User-defined Names of Directory Attributes"
+  :type  '(repeat (cons :tag "Field"
+			(symbol :tag "Directory attribute")
+			(string :tag "User friendly name ")))
+  :group 'eudc)
+
+(defcustom eudc-use-raw-directory-names nil
+  "*If non-nil, use attributes names as defined in the directory.
+Otherwise, directory query/response forms display the user attribute
+names defined in `eudc-user-attribute-names-alist'."
+  :type  'boolean
+  :group 'eudc)
+
+(defcustom eudc-attribute-display-method-alist nil
+  "*An alist specifying methods to display attribute values.
+Each member of the list is of the form (NAME . FUNC) where NAME is a lowercased
+string naming a directory attribute (translated according to 
+`eudc-user-attribute-names-alist' if `eudc-use-raw-directory-names' is 
+non-nil) and FUNC a function that will be passed the corresponding 
+attribute values for display."
+  :tag "Attribute Decoding Functions"
+  :type '(repeat (cons :tag "Attribute"
+		       (symbol :tag "Name")
+		       (symbol :tag "Display Function")))
+  :group 'eudc)
+
+(defcustom eudc-external-viewers '(("XV" "xv" "-") 
+				   ("ImageMagick" "display" "-")
+				   ("ShowAudio" "showaudio"))
+  "*A list of viewer program specifications.
+Viewers are programs which can be piped a directory attribute value for
+display or arbitrary processing.  Each specification is a list whose 
+first element is a string naming the viewer.  The second element is the 
+executable program which should be invoked, and following elements are
+arguments that should be passed to the program."
+  :tag "External Viewer Programs"
+  :type '(repeat (list :tag "Viewer"
+		       (string :tag "Name")
+		       (string :tag "Executable program")
+		       (repeat
+			:tag "Arguments"
+			:inline t
+			(string :tag "Argument"))))
+  :group 'eudc)
+
+(defcustom eudc-options-file "~/.eudc-options"
+  "*A file where the `servers' hotlist is stored."
+  :type '(file :Tag "File Name:")
+  :group 'eudc)
+
+(defcustom eudc-mode-hook nil
+  "*Normal hook run on entry to EUDC mode."
+  :type '(repeat (sexp :tag "Hook definition"))
+  :group 'eudc)
+
+;;}}}
+
+;;{{{ PH Custom Group
+
+(defgroup eudc-ph nil 
+  "Emacs Unified Directory Client - CCSO PH/QI Backend."
+  :group 'eudc)
+
+(defcustom eudc-ph-bbdb-conversion-alist
+  '((name . name)
+    (net . email)
+    (address . (eudc-bbdbify-address address "Address"))
+    (phone . ((eudc-bbdbify-phone phone "Phone")
+	      (eudc-bbdbify-phone office_phone "Office Phone"))))
+  "*A mapping from BBDB to PH/QI fields.
+This is a list of cons cells (BBDB-FIELD . SPEC-OR-LIST) where
+BBDB-FIELD is the name of a field that must be defined in your BBDB
+environment (standard field names are `name', `company', `net', `phone',
+`address' and `notes').  SPEC-OR-LIST is either a single SPEC or a list
+of SPECs.  Lists of specs are valid only for the `phone' and `address'
+BBDB fields.  SPECs are sexps which are evaluated:
+  a string evaluates to itself,
+  a symbol evaluates to the symbol value.  Symbols naming PH/QI fields
+    present in the record evaluate to the value of the field in the record,
+  a form is evaluated as a function.  The argument list may contain PH/QI 
+    field names which eval to the corresponding values in the
+    record.  The form evaluation should return something appropriate for
+    the particular BBDB-FIELD (see `bbdb-create-internal').
+    `eudc-bbdbify-phone' and `eudc-bbdbify-address' are provided as convenience
+    functions to parse phones and addresses."
+  :tag "BBDB to PH Field Name Mapping"
+  :type '(repeat (cons :tag "Field Name"
+		       (symbol :tag "BBDB Field")
+		       (sexp :tag "Conversion Spec")))
+  :group 'eudc-ph)
+
+;;}}}
+
+;;{{{ LDAP Custom Group
+
+(defgroup eudc-ldap nil 
+  "Emacs Unified Directory Client - LDAP Backend."
+  :group 'eudc)
+
+(defcustom eudc-ldap-bbdb-conversion-alist
+  '((name . cn)
+    (net . mail)
+    (address . (eudc-bbdbify-address postaladdress "Address"))
+    (phone . ((eudc-bbdbify-phone telephonenumber "Phone"))))
+  "*A mapping from BBDB to LDAP attributes.
+This is a list of cons cells (BBDB-FIELD . SPEC-OR-LIST) where
+BBDB-FIELD is the name of a field that must be defined in your BBDB
+environment (standard field names are `name', `company', `net', `phone',
+`address' and `notes').  SPEC-OR-LIST is either a single SPEC or a list
+of SPECs.  Lists of specs are valid only for the `phone' and `address'
+BBDB fields.  SPECs are sexps which are evaluated:
+  a string evaluates to itself,
+  a symbol evaluates to the symbol value.  Symbols naming LDAP attributes
+    present in the record evaluate to the value of the field in the record,
+  a form is evaluated as a function.  The argument list may contain LDAP 
+    field names which eval to the corresponding values in the
+    record.  The form evaluation should return something appropriate for
+    the particular BBDB-FIELD (see `bbdb-create-internal').
+    `eudc-bbdbify-phone' and `eudc-bbdbify-address' are provided as convenience
+    functions to parse phones and addresses."
+  :tag "BBDB to LDAP Attribute Names Mapping"
+  :type '(repeat (cons :tag "Field Name"
+		       (symbol :tag "BBDB Field")
+		       (sexp :tag "Conversion Spec")))
+  :group 'eudc-ldap)
+
+;;}}}
+
+;;{{{ BBDB Custom Group
+
+(defgroup eudc-bbdb nil 
+  "Emacs Unified Directory Client - BBDB Backend."
+  :group 'eudc)
+
+(defcustom eudc-bbdb-use-locations-as-attribute-names t
+  "If non-nil, BBDB address and phone locations are used as attribute names.
+This has no effect on queries (you can't search for a specific location)
+but influences the way records are displayed"
+  :type 'boolean
+  :group 'eudc-bbdb)
+
+(defcustom eudc-bbdb-enable-substring-matches t
+  "If non-nil, authorize substring match in the same way BBDB does.
+Otherwise records must match queries exactly."
+  :type 'boolean
+  :group 'eudc-bbdb)
+
+;;}}}
+
+
+(provide 'eudc-vars)
+
+;;; eudc-vars.el ends here
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
new file mode 100644
index 00000000000..61d1d03272f
--- /dev/null
+++ b/lisp/net/eudc.el
@@ -0,0 +1,1277 @@
+;;; eudc.el --- Emacs Unified Directory Client
+
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <oscar@xemacs.org>
+;; Maintainer: Oscar Figueiredo <oscar@xemacs.org>
+;; Keywords: help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;    This package provides a common interface to query directory servers using
+;;    different protocols such as LDAP, CCSO PH/QI or BBDB.  Queries can be
+;;    made through an interactive form or inline. Inline query strings in
+;;    buffers are expanded with appropriately formatted query results
+;;    (especially used to expand email addresses in message buffers).  EUDC
+;;    also interfaces with the BBDB package to let you register query results
+;;    into your own BBDB database.
+
+;;; Usage:
+;;    EUDC comes with an extensive documentation, please refer to it.
+;;
+;;    The main entry points of EUDC are:
+;;      `eudc-query-form': Query a directory server from a query form
+;;      `eudc-expand-inline': Query a directory server for the e-mail address
+;;                            of the name before cursor and insert it in the 
+;;                            buffer
+;;      `eudc-get-phone': Get a phone number from a directory server
+;;      `eudc-get-email': Get an e-mail address from a directory server
+;;      `eudc-customize': Customize various aspects of EUDC
+
+;;; Code:
+
+(require 'wid-edit)
+
+(eval-and-compile
+  (if (not (fboundp 'make-overlay))
+      (require 'overlay))
+  (if (not (fboundp 'unless))
+      (require 'cl)))
+
+(unless (fboundp 'custom-menu-create)
+  (autoload 'custom-menu-create "cus-edit"))
+
+(require 'eudc-vars)
+
+
+
+;;{{{      Internal cooking
+
+;;{{{      Internal variables and compatibility tricks
+
+(defconst eudc-xemacs-p (string-match "XEmacs" emacs-version))
+(defconst eudc-emacs-p (not eudc-xemacs-p))
+(defconst eudc-xemacs-mule-p (and eudc-xemacs-p
+				  (featurep 'mule)))
+(defconst eudc-emacs-mule-p (and eudc-emacs-p
+				 (featurep 'mule)))
+
+(defvar eudc-form-widget-list nil)
+(defvar eudc-mode-map nil)
+;; Used by the selection insertion mechanism
+(defvar eudc-pre-select-window-configuration nil)
+(defvar eudc-insertion-marker nil)
+
+;; List of known servers
+;; Alist of (SERVER . PROTOCOL)
+(defvar eudc-server-hotlist nil)
+
+;; List of variables that have server- or protocol-local bindings
+(defvar eudc-local-vars nil)
+
+;; Protocol local. Query function 
+(defvar eudc-query-function nil)
+
+;; Protocol local.  A function that retrieves a list of valid attribute names
+(defvar eudc-list-attributes-function nil)
+
+;; Protocol local. A mapping between EUDC attribute names and corresponding
+;; protocol specific names.  The following names are defined by EUDC and may be
+;; included in that list: `name' , `firstname', `email', `phone'
+(defvar eudc-protocol-attributes-translation-alist nil)
+
+;; Protocol local. Mapping between protocol attribute names and BBDB field
+;; names
+(defvar eudc-bbdb-conversion-alist nil)
+
+;; Protocol/Server local. Hook called upon switching to that server
+(defvar eudc-switch-to-server-hook nil)
+
+;; Protocol/Server local. Hook called upon switching from that server
+(defvar eudc-switch-from-server-hook nil)
+
+;; Protocol local. Whether the protocol supports queries with no specified
+;; attribute name
+(defvar eudc-protocol-has-default-query-attributes nil)
+
+(defun eudc-cadr (obj)
+  (car (cdr obj)))
+
+(defun eudc-cdar (obj)
+  (cdr (car obj)))
+
+(defun eudc-caar (obj)
+  (car (car obj)))
+
+(defun eudc-cdaar (obj)
+  (cdr (car (car obj))))
+
+(defun eudc-plist-member (plist prop)
+  "Return t if PROP has a value specified in PLIST."
+  (if (not (= 0 (% (length plist) 2)))
+      (error "Malformed plist"))
+  (catch 'found
+    (while plist
+      (if (eq prop (car plist))
+	  (throw 'found t))
+      (setq plist (cdr (cdr plist))))
+    nil))
+
+;; Emacs' plist-get lacks third parameter
+(defun eudc-plist-get (plist prop &optional default)
+  "Extract a value from a property list.
+PLIST is a property list, which is a list of the form
+(PROP1 VALUE1 PROP2 VALUE2...).  This function returns the value
+corresponding to the given PROP, or DEFAULT if PROP is not
+one of the properties on the list."
+  (if (eudc-plist-member plist prop)
+      (plist-get plist prop)
+    default))
+
+(defun eudc-lax-plist-get (plist prop &optional default)
+  "Extract a value from a lax property list.
+
+PLIST is a lax property list, which is a list of the form (PROP1
+VALUE1 PROP2 VALUE2...), where comparisons between properties are done
+using `equal' instead of `eq'.  This function returns the value
+corresponding to PROP, or DEFAULT if PROP is not one of the
+properties on the list."
+  (if (not (= 0 (% (length plist) 2)))
+      (error "Malformed plist"))
+  (catch 'found
+    (while plist
+      (if (equal prop (car plist))
+	  (throw 'found (car (cdr plist))))
+      (setq plist (cdr (cdr plist))))
+    default))
+
+(if (not (fboundp 'split-string))
+    (defun split-string (string &optional pattern)
+      "Return a list of substrings of STRING which are separated by PATTERN.
+If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
+  (or pattern
+      (setq pattern "[ \f\t\n\r\v]+"))
+  (let (parts (start 0))
+    (when (string-match pattern string 0)
+      (if (> (match-beginning 0) 0)
+	  (setq parts (cons (substring string 0 (match-beginning 0)) nil)))
+      (setq start (match-end 0))
+      (while (and (string-match pattern string start)
+		  (> (match-end 0) start))
+	(setq parts (cons (substring string start (match-beginning 0)) parts)
+	      start (match-end 0))))
+    (nreverse (if (< start (length string))
+		  (cons (substring string start) parts)
+		parts)))))
+
+(defun eudc-replace-in-string (str regexp newtext)
+  "Replace all matches in STR for REGEXP with NEWTEXT.
+Value is the new string."
+  (let ((rtn-str "")
+	(start 0)
+	match prev-start)
+    (while (setq match (string-match regexp str start))
+      (setq prev-start start
+	    start (match-end 0)
+	    rtn-str
+	    (concat rtn-str
+		    (substring str prev-start match)
+		    newtext)))
+    (concat rtn-str (substring str start))))
+
+;;}}} 
+
+;;{{{ Server and Protocol Variable Routines
+
+(defun eudc-server-local-variable-p (var)
+  "Return non-nil if VAR has server-local bindings."
+  (eudc-plist-member (get var 'eudc-locals) 'server))
+
+(defun eudc-protocol-local-variable-p (var)
+  "Return non-nil if VAR has protocol-local bindings."
+  (eudc-plist-member (get var 'eudc-locals) 'protocol))
+
+(defun eudc-default-set (var val)
+  "Set the EUDC default value of VAR to VAL.
+The current binding of VAR is not changed."
+  (put var 'eudc-locals 
+       (plist-put (get var 'eudc-locals) 'default val))
+  (add-to-list 'eudc-local-vars var))
+
+(defun eudc-protocol-set (var val &optional protocol)
+  "Set the PROTOCOL-local binding of VAR to VAL.
+If omitted PROTOCOL defaults to the current value of `eudc-protocol'.
+The current binding of VAR is changed only if PROTOCOL is omitted."
+  (if (eq 'unbound (eudc-variable-default-value var))
+      (eudc-default-set var (symbol-value var)))
+  (let* ((eudc-locals (get var 'eudc-locals))
+	 (protocol-locals (eudc-plist-get eudc-locals 'protocol)))
+    (setq protocol-locals (plist-put protocol-locals (or protocol
+							 eudc-protocol) val))
+    (setq eudc-locals 
+	  (plist-put eudc-locals 'protocol protocol-locals))
+    (put var 'eudc-locals eudc-locals)
+    (add-to-list 'eudc-local-vars var)
+    (unless protocol
+      (eudc-update-variable var))))
+       
+(defun eudc-server-set (var val &optional server)
+  "Set the SERVER-local binding of VAR to VAL.
+If omitted SERVER defaults to the current value of `eudc-server'.
+The current binding of VAR is changed only if SERVER is omitted."
+  (if (eq 'unbound (eudc-variable-default-value var))
+      (eudc-default-set var (symbol-value var)))
+  (let* ((eudc-locals (get var 'eudc-locals))
+	 (server-locals (eudc-plist-get eudc-locals 'server)))
+    (setq server-locals (plist-put server-locals (or server
+						     eudc-server) val))
+    (setq eudc-locals 
+	  (plist-put eudc-locals 'server server-locals))
+    (put var 'eudc-locals eudc-locals)
+    (add-to-list 'eudc-local-vars var)
+    (unless server
+      (eudc-update-variable var))))
+
+
+(defun eudc-set (var val)
+  "Set the most local (server, protocol or default) binding of VAR to VAL.
+The current binding of VAR is also set to VAL"
+  (cond 
+   ((not (eq 'unbound (eudc-variable-server-value var)))
+    (eudc-server-set var val))
+   ((not (eq 'unbound (eudc-variable-protocol-value var)))
+    (eudc-protocol-set var val))
+   (t
+    (eudc-default-set var val)))
+  (set var val))
+
+(defun eudc-variable-default-value (var)
+  "Return the default binding of VAR.
+Return `unbound' if VAR has no EUDC default value."
+  (let ((eudc-locals (get var 'eudc-locals)))
+    (if (and (boundp var)
+	     eudc-locals)
+	(eudc-plist-get eudc-locals 'default 'unbound)
+      'unbound)))
+
+(defun eudc-variable-protocol-value (var &optional protocol)
+  "Return the value of VAR local to PROTOCOL.
+Return `unbound' if VAR has no value local to PROTOCOL.
+PROTOCOL defaults to `eudc-protocol'"
+  (let* ((eudc-locals (get var 'eudc-locals))
+	 protocol-locals)
+    (if (not (and  (boundp var)
+		   eudc-locals
+		   (eudc-plist-member eudc-locals 'protocol)))
+	'unbound
+      (setq protocol-locals (eudc-plist-get eudc-locals 'protocol))
+      (eudc-lax-plist-get protocol-locals 
+			  (or protocol
+			      eudc-protocol) 'unbound))))
+
+(defun eudc-variable-server-value (var &optional server)
+  "Return the value of VAR local to SERVER.
+Return `unbound' if VAR has no value local to SERVER.
+SERVER defaults to `eudc-server'"
+  (let* ((eudc-locals (get var 'eudc-locals))
+	 server-locals)
+    (if (not (and (boundp var)
+		  eudc-locals
+		  (eudc-plist-member eudc-locals 'server)))
+	'unbound
+      (setq server-locals (eudc-plist-get eudc-locals 'server))
+      (eudc-lax-plist-get server-locals 
+			  (or server
+			      eudc-server) 'unbound))))
+
+(defun eudc-update-variable (var)
+  "Set the value of VAR according to its locals.
+If the VAR has a server- or protocol-local value corresponding
+to the current `eudc-server' and `eudc-protocol' then it is set
+accordingly. Otherwise it is set to its EUDC default binding"
+  (let (val)
+    (cond 
+     ((not (eq 'unbound (setq val (eudc-variable-server-value var))))
+      (set var val))
+     ((not (eq 'unbound (setq val (eudc-variable-protocol-value var))))
+      (set var val))
+     ((not (eq 'unbound (setq val (eudc-variable-default-value var))))
+      (set var val)))))
+
+(defun eudc-update-local-variables ()
+  "Update all EUDC variables according to their local settings."
+  (interactive)
+  (mapcar 'eudc-update-variable eudc-local-vars))
+
+(eudc-default-set 'eudc-query-function nil)
+(eudc-default-set 'eudc-list-attributes-function nil)
+(eudc-default-set 'eudc-protocol-attributes-translation-alist nil)
+(eudc-default-set 'eudc-bbdb-conversion-alist nil)
+(eudc-default-set 'eudc-switch-to-server-hook nil)
+(eudc-default-set 'eudc-switch-from-server-hook nil)
+(eudc-default-set 'eudc-protocol-has-default-query-attributes nil)
+(eudc-default-set 'eudc-attribute-display-method-alist nil)
+
+;;}}}
+
+
+;; Add PROTOCOL to the list of supported protocols
+(defun eudc-register-protocol (protocol)
+  (unless (memq protocol eudc-supported-protocols)
+    (setq eudc-supported-protocols 
+	  (cons protocol eudc-supported-protocols))
+    (put 'eudc-protocol 'custom-type 
+	 `(choice :menu-tag "Protocol"
+		  ,@(mapcar (lambda (s) 
+			      (list 'string ':tag (symbol-name s)))
+			    eudc-supported-protocols))))
+  (or (memq protocol eudc-known-protocols)
+      (setq eudc-known-protocols
+	    (cons protocol eudc-known-protocols))))
+
+
+(defun eudc-translate-query (query)
+  "Translate attribute names of QUERY.
+The translation is done according to
+`eudc-protocol-attributes-translation-alist'."
+  (if eudc-protocol-attributes-translation-alist
+      (mapcar '(lambda (attribute)
+		 (let ((trans (assq (car attribute) 
+				    (symbol-value eudc-protocol-attributes-translation-alist))))
+		   (if trans
+		       (cons (cdr trans) (cdr attribute))
+		     attribute)))
+	      query)
+    query)) 
+
+(defun eudc-translate-attribute-list (list)
+  "Translate a list of attribute names LIST.
+The translation is done according to
+`eudc-protocol-attributes-translation-alist'."
+  (if eudc-protocol-attributes-translation-alist
+      (let (trans)
+	(mapcar '(lambda (attribute)
+		   (setq trans (assq attribute
+				     (symbol-value eudc-protocol-attributes-translation-alist)))
+		   (if trans
+		       (cdr trans)
+		     attribute))
+		list))
+    list))
+
+(defun eudc-select (choices)
+  "Choose one from CHOICES using a completion buffer."
+  (setq eudc-pre-select-window-configuration (current-window-configuration))
+  (setq eudc-insertion-marker (point-marker))
+  (with-output-to-temp-buffer "*EUDC Completions*"
+    (apply 'display-completion-list 
+	   choices 
+	   (if eudc-xemacs-p
+	       '(:activate-callback eudc-insert-selected)))))
+
+(defun eudc-insert-selected (event extent user)
+  "Insert a completion at the appropriate point."
+  (when eudc-insertion-marker
+    (set-buffer (marker-buffer eudc-insertion-marker))
+    (goto-char eudc-insertion-marker)
+    (insert (extent-string extent)))
+  (if eudc-pre-select-window-configuration
+      (set-window-configuration eudc-pre-select-window-configuration))
+  (setq eudc-pre-select-window-configuration nil
+	eudc-insertion-marker nil))
+
+(defun eudc-query (query &optional return-attributes no-translation)
+   "Query the current directory server with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE) where ATTR is an attribute
+name and VALUE the corresponding value.
+If NO-TRANSLATION is non-nil, ATTR is translated according to 
+`eudc-protocol-attributes-translation-alist'.
+RETURN-ATTRIBUTES is a list of attributes to return defaulting to 
+`eudc-default-return-attributes'."
+   (unless eudc-query-function
+     (error "Don't know how to perform the query"))
+   (if no-translation
+       (funcall eudc-query-function query (or return-attributes
+					      eudc-default-return-attributes))
+		
+     (funcall eudc-query-function 
+	      (eudc-translate-query query)
+	      (cond 
+	       (return-attributes
+		(eudc-translate-attribute-list return-attributes))
+	       ((listp eudc-default-return-attributes)
+		(eudc-translate-attribute-list eudc-default-return-attributes))
+	       (t
+		eudc-default-return-attributes)))))
+
+(defun eudc-format-attribute-name-for-display (attribute)
+  "Format a directory attribute name for display.
+ATTRIBUTE is looked up in `eudc-user-attribute-names-alist' and replaced 
+by the corresponding user name if any.  Otherwise it is capitalized and
+underscore characters are replaced by spaces."
+  (let ((match (assq attribute eudc-user-attribute-names-alist)))
+    (if match
+	(cdr match)
+      (capitalize 
+       (mapconcat 'identity 
+		  (split-string (symbol-name attribute) "_")
+		  " ")))))
+
+(defun eudc-print-attribute-value (field)
+  "Insert the value of the directory FIELD at point.
+The directory attribute name in car of FIELD is looked up in 
+`eudc-attribute-display-method-alist' and the corresponding method, 
+if any, is called to print the value in cdr of FIELD."
+  (let ((match (assoc (downcase (car field))
+		      eudc-attribute-display-method-alist))
+	(col (current-column))
+	(val (cdr field)))
+    (if match
+	(progn
+	  (eval (list (cdr match) val))
+	  (insert "\n"))
+      (mapcar
+       (function
+	(lambda (val-elem)
+	  (indent-to col)
+	  (insert val-elem "\n")))
+       (cond
+	((listp val) val)
+	((stringp val) (split-string val "\n"))
+	((null val) '(""))
+	(t (list val)))))))
+
+(defun eudc-print-record-field (field column-width)
+  "Print the record field FIELD.
+FIELD is a list (ATTR VALUE1 VALUE2 ...) or cons-cell (ATTR . VAL)
+COLUMN-WIDTH is the width of the first display column containing the 
+attribute name ATTR."
+  (let ((field-beg (point)))
+;; The record field that is passed to this function has already been processed
+;; by `eudc-format-attribute-name-for-display' so we don't need to call it
+;; again to display the attribute name
+    (insert (format (concat "%" (int-to-string column-width) "s: ") 
+		    (car field)))
+    (put-text-property field-beg (point) 'face 'bold)
+    (indent-to (+ 2 column-width))
+    (eudc-print-attribute-value field)))
+
+(defun eudc-display-records (records &optional raw-attr-names)
+  "Display the record list RECORDS in a formatted buffer. 
+If RAW-ATTR-NAMES is non-nil, the raw attribute names are displayed
+otherwise they are formatted according to `eudc-user-attribute-names-alist'."
+  (let ((buffer (get-buffer-create "*Directory Query Results*"))
+	inhibit-read-only
+	precords
+	(width 0)
+	beg
+	first-record
+	attribute-name)
+    (switch-to-buffer buffer)    
+    (setq buffer-read-only t)
+    (setq inhibit-read-only t)
+    (erase-buffer)
+    (insert "Directory Query Result\n")
+    (insert "======================\n\n\n")
+    (if (null records)
+	(insert "No match found.\n"
+		(if eudc-strict-return-matches
+		    "Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n"
+		  ""))
+      ;; Replace field names with user names, compute max width
+      (setq precords
+	    (mapcar 
+	     (function
+	      (lambda (record)
+		(mapcar 
+		 (function
+		  (lambda (field)
+		    (setq attribute-name 
+			  (if raw-attr-names
+			      (symbol-name (car field))
+			    (eudc-format-attribute-name-for-display (car field))))
+		    (if (> (length attribute-name) width)
+			(setq width (length attribute-name)))
+		    (cons attribute-name (cdr field))))
+		 record)))
+	     records))
+      ;; Display the records
+      (setq first-record (point))
+      (mapcar 
+       (function
+	(lambda (record)
+	  (setq beg (point))
+	  ;; Map over the record fields to print the attribute/value pairs
+	  (mapcar (function 
+		   (lambda (field)
+		     (eudc-print-record-field field width))) 
+		  record)
+	  ;; Store the record internal format in some convenient place
+	  (overlay-put (make-overlay beg (point))
+		       'eudc-record
+		       (car records))
+	  (setq records (cdr records))
+	  (insert "\n")))
+       precords))
+    (insert "\n")
+    (widget-create 'push-button
+		   :notify (lambda (&rest ignore)
+			     (eudc-query-form))
+		   "New query")
+    (widget-insert " ")
+    (widget-create 'push-button
+		   :notify (lambda (&rest ignore)
+			     (kill-this-buffer))
+		   "Quit")
+    (eudc-mode)
+    (widget-setup)
+    (if first-record
+	(goto-char first-record))))
+
+(defun eudc-process-form ()
+  "Process the query form in current buffer and display the results."
+  (let (query-alist
+	value)
+    (if (not (and (boundp 'eudc-form-widget-list)
+		  eudc-form-widget-list))
+	(error "Not in a directory query form buffer")
+      (mapcar (function 
+	       (lambda (wid-field)
+		 (setq value (widget-value (cdr wid-field)))
+		 (if (not (string= value ""))
+		     (setq query-alist (cons (cons (car wid-field) value)
+					     query-alist)))))
+	      eudc-form-widget-list)
+      (kill-buffer (current-buffer))
+      (eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names))))
+         
+           
+
+(defun eudc-filter-duplicate-attributes (record)
+  "Filter RECORD according to `eudc-duplicate-attribute-handling-method'."
+  (let ((rec record)
+	unique
+	duplicates
+	result)
+
+    ;; Search for multiple records
+    (while (and rec
+		(not (listp (eudc-cdar rec))))
+      (setq rec (cdr rec)))
+
+    (if (null (eudc-cdar rec))
+	(list record)			; No duplicate attrs in this record
+      (mapcar (function 
+	       (lambda (field)
+		 (if (listp (cdr field))
+		     (setq duplicates (cons field duplicates))
+		   (setq unique (cons field unique)))))
+	      record)
+      (setq result (list unique))
+      ;; Map over the record fields that have multiple values
+      (mapcar 
+       (function
+	(lambda (field)
+	  (let ((method (if (consp eudc-duplicate-attribute-handling-method)
+			    (cdr 
+			     (assq 
+			      (or 
+			       (car 
+				(rassq 
+				 (car field)
+				 (symbol-value 
+				  eudc-protocol-attributes-translation-alist)))
+			       (car field))
+			      eudc-duplicate-attribute-handling-method))
+			  eudc-duplicate-attribute-handling-method)))
+	    (cond
+	     ((or (null method) (eq 'list method))
+	      (setq result 
+		    (eudc-add-field-to-records field result)))
+	     ((eq 'first method)
+	      (setq result 
+		    (eudc-add-field-to-records (cons (car field) 
+						     (eudc-cadr field)) 
+					       result)))
+	     ((eq 'concat method)
+	      (setq result 
+		    (eudc-add-field-to-records (cons (car field)
+						     (mapconcat 
+						      'identity
+						      (cdr field)
+						      "\n")) result)))
+	     ((eq 'duplicate method)
+	      (setq result
+		    (eudc-distribute-field-on-records field result)))))))
+       duplicates)
+      result)))
+
+(defun eudc-filter-partial-records (records attrs)
+  "Eliminate records that do not caontain all ATTRS from RECORDS."
+  (delq nil 
+	(mapcar 
+	 (function 
+	  (lambda (rec)
+	    (if (eval (cons 'and 
+		       (mapcar 
+			(function 
+			 (lambda (attr)
+			   (consp (assq attr rec))))
+			attrs)))
+		rec)))
+	 records)))
+	   
+(defun eudc-add-field-to-records (field records)
+  "Add FIELD to each individual record in RECORDS and return the resulting list."
+  (mapcar (function
+	   (lambda (r)
+	     (cons field r)))
+	  records))
+
+(defun eudc-distribute-field-on-records (field records)
+  "Duplicate each individual record in RECORDS according to value of FIELD.
+Each copy is added a new field containing one of the values of FIELD."
+  (let (result
+	(values (cdr field)))
+    ;; Uniquify values first
+    (while values
+      (setcdr values (delete (car values) (cdr values)))
+      (setq values (cdr values)))
+    (mapcar 
+     (function
+      (lambda (value)
+	(let ((result-list (copy-sequence records)))
+	  (setq result-list (eudc-add-field-to-records 
+			     (cons (car field) value)
+			     result-list))
+	  (setq result (append result-list result))
+		 )))
+	    (cdr field))
+    result))
+
+
+(defun eudc-mode ()
+  "Major mode used in buffers displaying the results of directory queries.
+There is no sense in calling this command from a buffer other than
+one containing the results of a directory query.
+
+These are the special commands of EUDC mode:
+    q -- Kill this buffer.
+    f -- Display a form to query the current directory server.
+    n -- Move to next record.
+    p -- Move to previous record.
+    b -- Insert record at point into the BBDB database."
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'eudc-mode)
+  (setq mode-name "EUDC")
+  (use-local-map eudc-mode-map)
+  (if eudc-emacs-p
+      (easy-menu-define eudc-emacs-menu eudc-mode-map "" (eudc-menu))
+    (setq mode-popup-menu (eudc-menu)))
+  (run-hooks 'eudc-mode-hook)
+  )
+
+;;}}}        
+
+;;{{{      High-level interfaces (interactive functions)
+
+(defun eudc-customize ()
+  "Customize the EUDC package."
+  (interactive)
+  (customize-group 'eudc))
+
+;;;###autoload
+(defun eudc-set-server (server protocol &optional no-save)
+  "Set the directory server to SERVER using PROTOCOL.
+Unless NO-SAVE is non-nil, the server is saved as the default 
+server for future sessions."
+  (interactive (list
+		(read-from-minibuffer "Directory Server: ")
+		(intern (completing-read "Protocol: " 
+					 (mapcar '(lambda (elt)
+						    (cons (symbol-name elt)
+							  elt))
+						 eudc-known-protocols)))))
+  (unless (or (member protocol
+		      eudc-supported-protocols)
+	      (load (concat "eudcb-" (symbol-name protocol)) t))
+    (error "Unsupported protocol: %s" protocol))
+  (run-hooks 'eudc-switch-from-server-hook)
+  (setq eudc-protocol protocol)
+  (setq eudc-server server)
+  (eudc-update-local-variables)
+  (run-hooks 'eudc-switch-to-server-hook)
+  (if (interactive-p)
+      (message "Current directory server is now %s (%s)" eudc-server eudc-protocol))
+  (if (null no-save)
+      (eudc-save-options)))
+
+;;;###autoload
+(defun eudc-get-email (name)
+  "Get the email field of NAME from the directory server."
+  (interactive "sName: ")
+  (or eudc-server
+      (call-interactively 'eudc-set-server))
+  (let ((result (eudc-query (list (cons 'name name)) '(email)))
+	email)
+    (if (null (cdr result)) 
+	(setq email (eudc-cdaar result))
+      (error "Multiple match. Use the query form"))
+    (if (interactive-p)
+	(if email
+	    (message "%s" email)
+	  (error "No record matching %s" name)))
+    email))
+
+;;;###autoload
+(defun eudc-get-phone (name)
+  "Get the phone field of NAME from the directory server."
+  (interactive "sName: ")
+  (or eudc-server
+      (call-interactively 'eudc-set-server))
+  (let ((result (eudc-query (list (cons 'name name)) '(phone)))
+	phone)
+    (if (null (cdr result)) 
+	(setq phone (eudc-cdaar result))
+      (error "Multiple match. Use the query form"))
+    (if (interactive-p)
+	(if phone
+	    (message "%s" phone)
+	  (error "No record matching %s" name)))
+    phone))
+
+(defun eudc-get-attribute-list ()
+  "Return a list of valid attributes for the current server.
+When called interactively the list is formatted in a dedicated buffer
+otherwise a list of symbols is returned."
+  (interactive)
+  (if eudc-list-attributes-function
+      (let ((entries (funcall eudc-list-attributes-function (interactive-p))))
+	(if entries 
+	    (if (interactive-p)
+		(eudc-display-records entries t)
+	      entries)))
+    (error "The %s protocol has no support for listing attributes" eudc-protocol)))
+
+(defun eudc-format-query (words format)
+  "Use FORMAT to build a EUDC query from WORDS."
+  (let (query
+	query-alist
+	key val cell)
+    (if format
+	(progn
+	  (while (and words format)
+	    (setq query-alist (cons (cons (car format) (car words)) 
+				    query-alist))
+	    (setq words (cdr words)
+		  format (cdr format)))
+	  ;; If the same attribute appears more than once, merge
+	  ;; the corresponding values
+	  (setq query-alist (nreverse query-alist))
+	  (while query-alist
+	    (setq key (eudc-caar query-alist)
+		  val (eudc-cdar query-alist)
+		  cell (assq key query))
+	    (if cell
+		(setcdr cell (concat (cdr cell) " " val))
+	      (setq query (cons (car query-alist) query)))
+	    (setq query-alist (cdr query-alist)))
+	  query)
+      (if eudc-protocol-has-default-query-attributes
+	  (mapconcat 'identity words " ")
+	(list (cons 'name (mapconcat 'identity words " ")))))))
+
+(defun eudc-extract-n-word-formats (format-list n)
+  "Extract a list of N-long formats from FORMAT-LIST.
+If none try N - 1 and so forth."
+  (let (formats)
+    (while (and (null formats)
+		(> n 0))
+      (setq formats 
+	    (delq nil
+		  (mapcar '(lambda (format)
+			     (if (= n
+				    (length format))
+				 format
+			       nil))
+			  format-list)))
+      (setq n (1- n)))
+    formats))
+				    
+
+
+;;;###autoload
+(defun eudc-expand-inline (&optional replace)
+  "Query the directory server, and expand the query string before point.
+The query string consists of the buffer substring from the point back to
+the preceding comma, colon or beginning of line.  
+The variable `eudc-inline-query-format' controls how to associate the 
+individual inline query words with directory attribute names.
+After querying the server for the given string, the expansion specified by 
+`eudc-inline-expansion-format' is inserted in the buffer at point.
+If REPLACE is non nil, then this expansion replaces the name in the buffer.
+`eudc-expansion-overwrites-query' being non nil inverts the meaning of REPLACE.
+Multiple servers can be tried with the same query until one finds a match, 
+see `eudc-inline-expansion-servers'"
+  (interactive)
+  (if (memq eudc-inline-expansion-servers 
+	    '(current-server server-then-hotlist))
+      (or eudc-server
+	  (call-interactively 'eudc-set-server))
+    (or eudc-server-hotlist
+	(error "No server in the hotlist")))
+  (let* ((end (point))
+	 (beg (save-excursion
+		(if (re-search-backward "\\([:,]\\|^\\)[ \t]*" 
+					(save-excursion
+					  (beginning-of-line)
+					  (point))
+					'move)
+		    (goto-char (match-end 0)))
+		(point)))
+	 (query-words (split-string (buffer-substring beg end) "[ \t]+"))
+	 query-formats
+	 response
+	 response-string
+	 response-strings
+	 (eudc-former-server eudc-server)
+	 (eudc-former-protocol eudc-protocol)
+	 servers)
+
+    ;; Prepare the list of servers to query
+    (setq servers (copy-sequence eudc-server-hotlist))
+    (setq servers
+	  (cond 
+	   ((eq eudc-inline-expansion-servers 'hotlist)
+	    eudc-server-hotlist)
+	   ((eq eudc-inline-expansion-servers 'server-then-hotlist)
+	    (cons (cons eudc-server eudc-protocol)
+		  (delete (cons eudc-server eudc-protocol) servers)))
+	   ((eq eudc-inline-expansion-servers 'current-server)
+	    (list (cons eudc-server eudc-protocol)))
+	   (t
+	    (error "Wrong value for `eudc-inline-expansion-servers': %S"
+		   eudc-inline-expansion-servers))))
+    (if (and eudc-max-servers-to-query
+	     (> (length servers) eudc-max-servers-to-query))
+	(setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil))
+
+    (condition-case signal
+	(progn
+	  (setq response 
+		(catch 'found
+		  ;; Loop on the servers
+		  (while servers
+		    (eudc-set-server (eudc-caar servers) (eudc-cdar servers) t)
+		    
+		    ;; Determine which formats apply in the query-format list
+		    (setq query-formats
+			  (or 
+			   (eudc-extract-n-word-formats eudc-inline-query-format
+							(length query-words))
+			   (if (null eudc-protocol-has-default-query-attributes)
+			       '(name))))
+		    
+		    ;; Loop on query-formats
+		    (while query-formats
+		      (setq response
+			    (eudc-query
+			     (eudc-format-query query-words (car query-formats))
+			     (eudc-translate-attribute-list
+			      (cdr eudc-inline-expansion-format))))
+		      (if response
+			  (throw 'found response))
+		      (setq query-formats (cdr query-formats)))
+		    (setq servers (cdr servers)))
+		  ;; No more servers to try... no match found
+		  nil))
+
+
+	  (if (null response)
+	      (error "No match")
+	    
+	    ;; Process response through eudc-inline-expansion-format
+	    (while response
+	      (setq response-string (apply 'format 
+					   (car eudc-inline-expansion-format)
+					   (mapcar (function 
+						    (lambda (field)
+						      (or (cdr (assq field (car response))) 
+							  "")))
+						   (eudc-translate-attribute-list
+						    (cdr eudc-inline-expansion-format)))))
+	      (if (> (length response-string) 0)
+		  (setq response-strings
+			(cons response-string response-strings)))
+	      (setq response (cdr response)))
+	    
+	    (if (or
+		 (and replace (not eudc-expansion-overwrites-query))
+		 (and (not replace) eudc-expansion-overwrites-query))
+		(delete-region beg end))
+	    (cond 
+	     ((or (= (length response-strings) 1)
+		  (null eudc-multiple-match-handling-method)
+		  (eq eudc-multiple-match-handling-method 'first))
+	      (insert (car response-strings)))
+	     ((eq eudc-multiple-match-handling-method 'select)
+	      (eudc-select response-strings))
+	     ((eq eudc-multiple-match-handling-method 'all)
+	      (insert (mapconcat 'identity response-strings ", ")))
+	     ((eq eudc-multiple-match-handling-method 'abort)
+	      (error "There is more than one match for the query"))
+	     ))
+	  (or (and (equal eudc-server eudc-former-server)
+		   (equal eudc-protocol eudc-former-protocol))
+	      (eudc-set-server eudc-former-server eudc-former-protocol t)))
+      (t
+       (or (and (equal eudc-server eudc-former-server)
+		(equal eudc-protocol eudc-former-protocol))
+	   (eudc-set-server eudc-former-server eudc-former-protocol t))
+       (signal (car signal) (cdr signal))))))
+  
+;;;###autoload
+(defun eudc-query-form (&optional get-fields-from-server)
+  "Display a form to query the directory server.
+If given a non-nil argument GET-FIELDS-FROM-SERVER, the function first
+queries the server for the existing fields and displays a corresponding form."
+  (interactive "P")
+  (let ((fields (or (and get-fields-from-server
+			 (eudc-get-attribute-list))
+		    eudc-query-form-attributes))
+	(buffer (get-buffer-create "*Directory Query Form*"))
+	prompts
+	widget
+	(width 0)
+	inhibit-read-only
+	pt)
+    (switch-to-buffer buffer)
+    (setq inhibit-read-only t)
+    (erase-buffer)
+    (kill-all-local-variables)
+    (make-local-variable 'eudc-form-widget-list)
+    (widget-insert "Directory Query Form\n")
+    (widget-insert "====================\n\n")
+    (widget-insert "Current server is: " (or eudc-server
+					     (progn 
+					       (call-interactively 'eudc-set-server)
+					       eudc-server))
+					     "\n")
+    (widget-insert "Protocol         : " (symbol-name eudc-protocol) "\n")
+    ;; Build the list of prompts
+    (setq prompts (if eudc-use-raw-directory-names
+		      (mapcar 'symbol-name (eudc-translate-attribute-list fields))
+		    (mapcar (function
+			     (lambda (field)
+			       (or (and (assq field eudc-user-attribute-names-alist)
+					(cdr (assq field eudc-user-attribute-names-alist)))
+				   (capitalize (symbol-name field)))))
+			    fields)))
+    ;; Loop over prompt strings to find the longest one
+    (mapcar (function
+	     (lambda (prompt)
+		     (if (> (length prompt) width)
+			 (setq width (length prompt)))))
+	    prompts)
+    ;; Insert the first widget out of the mapcar to leave the cursor 
+    ;; in the first field 
+    (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts)))
+    (setq pt (point))
+    (setq widget (widget-create 'editable-field :size 15))
+    (setq eudc-form-widget-list (cons (cons (car fields) widget)
+				      eudc-form-widget-list))
+    (setq fields (cdr fields))
+    (setq prompts (cdr prompts))
+    (mapcar (function
+	     (lambda (field)
+	       (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts)))
+	       (setq widget (widget-create 'editable-field
+					   :size 15))
+	       (setq eudc-form-widget-list (cons (cons field widget)
+						 eudc-form-widget-list))
+	       (setq prompts (cdr prompts))))
+	    fields)
+    (widget-insert "\n\n")
+    (widget-create 'push-button
+		   :notify (lambda (&rest ignore)
+			     (eudc-process-form))
+		   "Query Server")
+    (widget-insert " ")
+    (widget-create 'push-button
+		   :notify (lambda (&rest ignore)
+			     (eudc-query-form))
+		   "Reset Form")
+    (widget-insert " ")
+    (widget-create 'push-button
+		   :notify (lambda (&rest ignore)
+			     (kill-this-buffer))
+		   "Quit")
+    (goto-char pt)
+    (use-local-map widget-keymap)
+    (widget-setup))
+  )
+
+(defun eudc-bookmark-server (server protocol)
+  "Add SERVER using PROTOCOL to the EUDC `servers' hotlist."
+  (interactive "sDirectory server: \nsProtocol: ")
+  (if (member (cons server protocol) eudc-server-hotlist)
+      (error "%s:%s is already in the hotlist" protocol server)
+    (setq eudc-server-hotlist (cons (cons server protocol) eudc-server-hotlist))
+    (eudc-install-menu)
+    (eudc-save-options)))
+
+(defun eudc-bookmark-current-server ()
+  "Add current server to the EUDC `servers' hotlist."
+  (interactive)
+  (eudc-bookmark-server eudc-server eudc-protocol))
+
+(defun eudc-save-options ()
+  "Save options to `eudc-options-file'."
+  (interactive)
+  (save-excursion
+    (set-buffer (find-file-noselect eudc-options-file t))
+    (goto-char (point-min))
+    ;; delete the previous setq
+    (let ((standard-output (current-buffer))
+	  provide-p
+	  set-hotlist-p
+	  set-server-p)
+      (catch 'found
+	(while t
+	  (let ((sexp (condition-case nil
+			  (read (current-buffer))
+			(end-of-file (throw 'found nil)))))
+	    (if (listp sexp)
+		(cond
+		 ((eq (car sexp)  'eudc-set-server)
+		  (delete-region (save-excursion
+				   (backward-sexp)
+				   (point))
+				 (point))
+		  (setq set-server-p t))
+		 ((and (eq (car sexp)  'setq)
+		       (eq (eudc-cadr sexp) 'eudc-server-hotlist))
+		  (delete-region (save-excursion
+				   (backward-sexp)
+				   (point))
+				 (point))
+		  (setq set-hotlist-p t))
+		 ((and (eq (car sexp)  'provide)
+		       (equal (eudc-cadr sexp) '(quote eudc-options-file)))
+		  (setq provide-p t)))
+	      (if (and provide-p
+		       set-hotlist-p
+		       set-server-p)
+		  (throw 'found t))))))
+      (if (eq (point-min) (point-max))
+	  (princ ";; This file was automatically generated by eudc.el.\n\n"))
+      (or provide-p
+	  (princ "(provide 'eudc-options-file)\n"))
+      (or (bolp)
+	  (princ "\n"))
+      (delete-blank-lines)
+      (princ "(eudc-set-server ")
+      (prin1 eudc-server)
+      (princ " '")
+      (prin1 eudc-protocol)
+      (princ " t)\n")
+      (princ "(setq eudc-server-hotlist '")
+      (prin1 eudc-server-hotlist)
+      (princ ")\n")
+      (save-buffer))))
+
+(defun eudc-move-to-next-record ()
+  "Move to next record, in a buffer displaying directory query results."
+  (interactive)
+  (if (not (eq major-mode 'eudc-mode))
+      (error "Not in a EUDC buffer")
+    (let ((pt (next-overlay-change (point))))
+      (if (< pt (point-max))
+	  (goto-char (1+ pt))
+	(error "No more records after point")))))
+
+(defun eudc-move-to-previous-record ()
+  "Move to previous record, in a buffer displaying directory query results."
+  (interactive)
+  (if (not (eq major-mode 'eudc-mode))
+      (error "Not in a EUDC buffer")
+    (let ((pt (previous-overlay-change (point))))
+      (if (> pt (point-min))
+	  (goto-char pt)
+	(error "No more records before point")))))
+
+
+      
+;;}}}
+
+;;{{{      Menus an keymaps
+
+(require 'easymenu)
+
+(setq eudc-mode-map 
+      (let ((map (make-sparse-keymap)))
+	(define-key map "q" 'kill-this-buffer)
+	(define-key map "x" 'kill-this-buffer)
+	(define-key map "f" 'eudc-query-form)
+	(define-key map "b" 'eudc-try-bbdb-insert)
+	(define-key map "n" 'eudc-move-to-next-record)
+	(define-key map "p" 'eudc-move-to-previous-record)
+	map))
+(set-keymap-parent eudc-mode-map widget-keymap)
+
+(defconst eudc-custom-generated-menu (cdr (custom-menu-create 'eudc)))
+
+(defconst eudc-tail-menu 
+  `(["---" nil nil]
+    ["Query with Form" eudc-query-form t]
+    ["Expand Inline Query" eudc-expand-inline t]
+    ["Insert Record into BBDB" eudc-insert-record-at-point-into-bbdb 
+     (and (or (featurep 'bbdb)
+	      (prog1 (locate-library "bbdb") (message "")))
+	  (overlays-at (point))
+	  (overlay-get (car (overlays-at (point))) 'eudc-record))]
+    ["Insert All Records into BBDB" eudc-batch-export-records-to-bbdb 
+     (and (eq major-mode 'eudc-mode)
+	  (or (featurep 'bbdb)
+	      (prog1 (locate-library "bbdb") (message ""))))]
+    ["---" nil nil]
+    ["Get Email" eudc-get-email t]
+    ["Get Phone" eudc-get-phone t]
+    ["List Valid Attribute Names" eudc-get-attribute-list t]
+    ["---" nil nil]
+    ,(cons "Customize" eudc-custom-generated-menu)))
+    
+
+(defconst eudc-server-menu 
+  '(["---" nil nil]
+    ["Bookmark Current Server" eudc-bookmark-current-server t]
+    ["Edit Server List" eudc-edit-hotlist t]
+    ["New Server" eudc-set-server t]))
+
+(defun eudc-menu ()
+  (let (command)
+    (append '("Directory Search")
+	    (list
+	     (append 
+	      '("Server")
+	      (mapcar 
+	       (function 
+		(lambda (servspec)
+		  (let* ((server (car servspec))
+			 (protocol (cdr servspec))
+			 (proto-name (symbol-name protocol)))
+		    (setq command (intern (concat "eudc-set-server-" 
+						  server 
+						  "-" 
+						  proto-name)))
+		    (if (not (fboundp command))
+			(fset command 
+			      `(lambda ()
+				 (interactive)
+				 (eudc-set-server ,server (quote ,protocol))
+				 (message "Selected directory server is now %s (%s)" 
+					  ,server 
+					  ,proto-name))))
+		    (vector (format "%s (%s)" server proto-name)
+			    command
+			    :style 'radio
+			    :selected `(equal eudc-server ,server)))))
+	       eudc-server-hotlist)
+	      eudc-server-menu))
+	    eudc-tail-menu)))
+
+(defun eudc-install-menu ()
+  (cond 
+   ((and eudc-xemacs-p (featurep 'menubar))
+    (add-submenu '("Tools") (eudc-menu)))
+   (eudc-emacs-p
+    (cond 
+     ((fboundp 'easy-menu-add-item)
+      (let ((menu (eudc-menu)))
+	(easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu)
+								  (cdr menu)))))
+     ((fboundp 'easy-menu-create-keymaps)
+      (easy-menu-define eudc-menu-map eudc-mode-map "Directory Client Menu" (eudc-menu))
+      (define-key 
+	global-map
+	[menu-bar tools eudc] 
+	(cons "Directory Search"
+	      (easy-menu-create-keymaps "Directory Search" (cdr (eudc-menu))))))
+     (t
+      (error "Unknown version of easymenu"))))
+   ))
+
+
+;;; Load time initializations :
+
+;;; Load the options file
+(if (and (not noninteractive)
+	 (and (locate-library eudc-options-file)
+	      (message ""))		; Remove modeline message
+	 (not (featurep 'eudc-options-file)))
+    (load eudc-options-file))
+  
+	 
+;;; Install the full menu
+(unless (featurep 'infodock)
+  (eudc-install-menu))
+
+
+;;; The following installs a short menu for EUDC at XEmacs startup.
+
+;;;###autoload
+(defun eudc-load-eudc ()
+  "Load the Emacs Unified Directory Client.
+This does nothing except loading eudc by autoload side-effect."
+  (interactive)
+  nil)
+
+;;;###autoload
+(let ((menu  '("Directory Search"
+	       ["Load Hotlist of Servers" eudc-load-eudc t]
+	       ["New Server" eudc-set-server t]
+	       ["---" nil nil]
+	       ["Query with Form" eudc-query-form t]
+	       ["Expand Inline Query" eudc-expand-inline t]
+	       ["---" nil nil]
+	       ["Get Email" eudc-get-email t]
+	       ["Get Phone" eudc-get-phone t])))
+  (if (not (featurep 'eudc-autoloads))
+      (if (string-match "XEmacs" emacs-version)
+	  (if (and (featurep 'menubar)
+		   (not (featurep 'infodock)))
+	      (add-submenu '("Tools") menu))
+	(require 'easymenu)
+	(cond 
+	 ((fboundp 'easy-menu-add-item)
+	  (easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu)
+								    (cdr menu))))
+	 ((fboundp 'easy-menu-create-keymaps)
+	  (define-key 
+	    global-map
+	    [menu-bar tools eudc] 
+	    (cons "Directory Search"
+		  (easy-menu-create-keymaps "Directory Search" (cdr menu)))))))))
+        
+;;}}}
+
+(provide 'eudc)
+
+;;; eudc.el ends here
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
new file mode 100644
index 00000000000..a7441c2c295
--- /dev/null
+++ b/lisp/net/eudcb-bbdb.el
@@ -0,0 +1,234 @@
+;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
+
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <oscar@xemacs.org>
+;; Maintainer: Oscar Figueiredo <oscar@xemacs.org>
+;; Keywords: help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;    This library provides an interface to use BBDB as a backend of 
+;;    the Emacs Unified Directory Client.
+
+;;; Code:
+
+(require 'eudc)
+(if (not (featurep 'bbdb))
+    (load-library "bbdb"))
+(if (not (featurep 'bbdb-com))
+    (load-library "bbdb-com"))
+
+;;{{{      Internal cooking
+
+;; I don't like this but mapcar does not accept a parameter to the function and
+;; I don't want to use mapcar*
+(defvar eudc-bbdb-current-query nil)
+(defvar eudc-bbdb-current-return-attributes nil)
+
+(defvar eudc-bbdb-attributes-translation-alist
+  '((name . lastname)
+    (email . net)
+    (phone . phones))
+  "Alist mapping EUDC attribute names to BBDB names.")
+
+(eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb)
+(eudc-protocol-set 'eudc-list-attributes-function nil 'bbdb)
+(eudc-protocol-set 'eudc-protocol-attributes-translation-alist 
+		   'eudc-bbdb-attributes-translation-alist 'bbdb)
+(eudc-protocol-set 'eudc-bbdb-conversion-alist nil 'bbdb)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'bbdb)
+
+(defun eudc-bbdb-format-query (query)
+  "Format a EUDC query alist into a list suitable to `bbdb-search'."
+  (let* ((firstname (cdr (assq 'firstname query)))
+	 (lastname (cdr (assq 'lastname query)))
+	 (name (or (and firstname lastname
+			(concat firstname " " lastname))
+		   firstname
+		   lastname))
+	(company (cdr (assq 'company query)))
+	(net (cdr (assq 'net query)))
+	(notes (cdr (assq 'notes query)))
+	(phone (cdr (assq 'phone query))))
+    (list name company net notes phone)))
+	
+
+(defun eudc-bbdb-filter-non-matching-record (record)
+  "Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
+  (catch 'unmatch
+    (progn
+      (mapcar 
+       (function 
+	(lambda (condition)
+	  (let ((attr (car condition))
+		(val (cdr condition))
+		(case-fold-search t)
+		bbdb-val)
+	    (or (and (memq attr '(firstname lastname aka company phones addresses net))
+		     (progn 
+		       (setq bbdb-val 
+			     (eval (list (intern (concat "bbdb-record-" 
+							 (symbol-name attr)))
+					 'record)))
+		       (if (listp bbdb-val)
+			   (if eudc-bbdb-enable-substring-matches
+			       (eval `(or ,@(mapcar '(lambda (subval)
+						       (string-match val
+								     subval))
+						  bbdb-val)))
+			     (member (downcase val)
+				     (mapcar 'downcase bbdb-val)))
+			 (if eudc-bbdb-enable-substring-matches
+			     (string-match val bbdb-val)
+			   (string-equal (downcase val) (downcase bbdb-val))))))
+		(throw 'unmatch nil)))))
+       eudc-bbdb-current-query)
+      record)))
+
+(defun eudc-bbdb-extract-phones (record)
+  (mapcar (function
+	   (lambda (phone)
+	     (if eudc-bbdb-use-locations-as-attribute-names
+		 (cons (intern (bbdb-phone-location phone))
+		       (bbdb-phone-string phone))
+	       (cons 'phones (format "%s: %s" 
+				     (bbdb-phone-location phone)
+				     (bbdb-phone-string phone))))))
+	  (bbdb-record-phones record)))
+
+(defun eudc-bbdb-extract-addresses (record)
+  (let (s c val)
+    (mapcar (function
+	     (lambda (address)
+	       (setq val (concat (unless (= 0 (length (setq s (bbdb-address-street1 address))))
+				   (concat s "\n"))
+				 (unless (= 0 (length (setq s (bbdb-address-street2 address))))
+				   (concat s "\n"))
+				 (unless (= 0 (length (setq s (bbdb-address-street3 address))))
+				   (concat s "\n"))
+				 (progn 
+				   (setq c (bbdb-address-city address))
+				   (setq s (bbdb-address-state address))
+				   (if (and (> (length c) 0) (> (length s) 0))
+				       (concat c ", " s " ")
+				     (concat c " ")))
+				 (bbdb-address-zip-string address)))
+	       (if eudc-bbdb-use-locations-as-attribute-names
+		   (cons (intern (bbdb-address-location address)) val)
+		 (cons 'addresses (concat (bbdb-address-location address) "\n" val)))))
+	    (bbdb-record-addresses record))))
+
+(defun eudc-bbdb-format-record-as-result (record)
+  "Format the BBDB RECORD as a EUDC query result record.
+The record is filtered according to `eudc-bbdb-current-return-attributes'"
+  (let ((attrs (or eudc-bbdb-current-return-attributes
+		   '(firstname lastname aka company phones addresses net notes)))
+	attr
+	eudc-rec
+	val)
+    (while (prog1 
+	       (setq attr (car attrs))
+	     (setq attrs (cdr attrs)))
+      (cond
+       ((eq attr 'phones)
+	(setq val (eudc-bbdb-extract-phones record)))
+       ((eq attr 'addresses)
+	(setq val (eudc-bbdb-extract-addresses record)))
+       ((memq attr '(firstname lastname aka company net notes))
+	(setq val (eval 
+		   (list (intern 
+			  (concat "bbdb-record-" 
+				  (symbol-name attr)))
+			 'record))))
+       (t
+	(setq val "Unknown BBDB attribute")))
+      (if val
+	(cond 
+	 ((memq attr '(phones addresses))
+	  (setq eudc-rec (append val eudc-rec)))
+	 ((and (listp val)
+	  (= 1 (length val)))
+	  (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
+	 ((> (length val) 0)
+	  (setq eudc-rec (cons (cons attr val) eudc-rec)))
+	 (t
+	  (error "Unexpected attribute value")))))
+    (nreverse eudc-rec)))
+	
+
+
+(defun eudc-bbdb-query-internal (query &optional return-attrs)
+  "Query BBDB  with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid 
+BBDB attribute names.  
+RETURN-ATTRS is a list of attributes to return, defaulting to 
+`eudc-default-return-attributes'."
+
+  (let ((eudc-bbdb-current-query query)
+	(eudc-bbdb-current-return-attributes return-attrs)
+	(query-attrs (eudc-bbdb-format-query query))
+	bbdb-attrs
+	(records (bbdb-records))
+	result
+	filtered)
+    ;; BBDB ORs its query attributes while EUDC ANDs them, hence we need to
+    ;; call bbdb-search iteratively on the returned records for each of the
+    ;; requested attributes
+    (while (and records (> (length query-attrs) 0))
+      (setq bbdb-attrs (append bbdb-attrs (list (car query-attrs))))
+      (if (car query-attrs)
+	  (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
+      (setq query-attrs (cdr query-attrs)))
+    (mapcar (function
+	     (lambda (record)
+	       (setq filtered (eudc-filter-duplicate-attributes record))
+	       ;; If there were duplicate attributes reverse the order of the
+	       ;; record so the unique attributes appear first
+	       (if (> (length filtered) 1)
+		   (setq filtered (mapcar (function 
+					   (lambda (rec)
+					     (reverse rec)))
+					  filtered)))
+	       (setq result (append result filtered))))
+	    (delq nil
+		  (mapcar 'eudc-bbdb-format-record-as-result 
+			  (delq nil 
+				(mapcar 'eudc-bbdb-filter-non-matching-record 
+					records)))))
+    result))
+
+;;}}}        
+
+;;{{{      High-level interfaces (interactive functions)
+
+(defun eudc-bbdb-set-server (dummy)
+  "Set the EUDC server to BBDB."
+  (interactive)
+  (eudc-set-server dummy 'bbdb)
+  (message "BBDB server selected"))
+
+;;;}}}
+
+
+(eudc-register-protocol 'bbdb)
+
+(provide 'eudcb-bbdb)
+
+;;; eudcb-bbdb.el ends here
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
new file mode 100644
index 00000000000..5223a232305
--- /dev/null
+++ b/lisp/net/eudcb-ldap.el
@@ -0,0 +1,210 @@
+;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend
+
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <oscar@xemacs.org>
+;; Maintainer: Oscar Figueiredo <oscar@xemacs.org>
+;; Keywords: help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;    This library provides specific LDAP protocol support for the 
+;;    Emacs Unified Directory Client package
+
+;;; Installation:
+;;    Install EUDC first. See EUDC documentation.
+
+;;; Code:
+
+(require 'eudc)
+(require 'ldap)
+
+
+;;{{{      Internal cooking
+
+(eval-and-compile
+  (if (fboundp 'ldap-get-host-parameter)
+      (fset 'eudc-ldap-get-host-parameter 'ldap-get-host-parameter)
+    (defun eudc-ldap-get-host-parameter (host parameter)
+      "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
+      (plist-get (cdr (assoc host ldap-host-parameters-alist))
+		 parameter))))
+
+(defvar eudc-ldap-attributes-translation-alist
+  '((name . sn)
+    (firstname . givenname)
+    (email . mail)
+    (phone . telephonenumber))
+  "Alist mapping EUDC attribute names to LDAP names.")
+
+(eudc-protocol-set 'eudc-query-function 'eudc-ldap-simple-query-internal 
+		   'ldap)
+(eudc-protocol-set 'eudc-list-attributes-function 'eudc-ldap-get-field-list
+		   'ldap)
+(eudc-protocol-set 'eudc-protocol-attributes-translation-alist 
+		   'eudc-ldap-attributes-translation-alist 'ldap)
+(eudc-protocol-set 'eudc-bbdb-conversion-alist 
+		   'eudc-ldap-bbdb-conversion-alist 
+		   'ldap)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'ldap)
+(eudc-protocol-set 'eudc-attribute-display-method-alist 
+		   '(("jpegphoto" . eudc-display-jpeg-inline)
+		     ("labeledurl" . eudc-display-url)
+		     ("audio" . eudc-display-sound)
+		     ("labeledurl" . eudc-display-url)
+		     ("url" . eudc-display-url)) 
+		   'ldap)
+(eudc-protocol-set 'eudc-switch-to-server-hook 
+		   '(eudc-ldap-check-base) 
+		   'ldap)
+
+(defun eudc-ldap-cleanup-record-simple (record)
+  "Do some cleanup in a RECORD to make it suitable for EUDC."
+  (mapcar 
+   (function 
+    (lambda (field)
+      (cons (intern (car field))
+	    (if (cdr (cdr field))
+		(cdr field)
+	      (car (cdr field))))))
+   record))
+
+(defun eudc-filter-$ (string)
+  (mapconcat 'identity (split-string string "\\$") "\n"))
+
+;; Cleanup a LDAP record to make it suitable for EUDC:
+;;   Make the record a cons-cell instead of a list if the it's single-valued
+;;   Filter the $ character in addresses into \n if not done by the LDAP lib
+(defun eudc-ldap-cleanup-record-filtering-addresses (record)
+  (mapcar 
+   (function 
+    (lambda (field)
+      (let ((name (intern (car field)))
+	    (value (cdr field)))
+	(if (memq name '(postaladdress registeredaddress))
+	    (setq value (mapcar 'eudc-filter-$ value)))
+	(cons name
+	      (if (cdr value)
+		  value
+		(car value))))))
+   record))
+
+(defun eudc-ldap-simple-query-internal (query &optional return-attrs)
+  "Query the LDAP server with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid 
+LDAP attribute names.  
+RETURN-ATTRS is a list of attributes to return, defaulting to 
+`eudc-default-return-attributes'."
+  (let ((result (ldap-search (eudc-ldap-format-query-as-rfc1558 query)
+			     eudc-server
+			     (if (listp return-attrs)
+				 (mapcar 'symbol-name return-attrs))))
+	final-result)
+    (if (or (not (boundp 'ldap-ignore-attribute-codings))
+	    ldap-ignore-attribute-codings)
+	(setq result 
+	      (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
+      (setq result (mapcar 'eudc-ldap-cleanup-record-simple result)))
+
+    (if (and eudc-strict-return-matches
+	     return-attrs
+	     (not (eq 'all return-attrs)))
+	(setq result (eudc-filter-partial-records result return-attrs)))
+    ;; Apply eudc-duplicate-attribute-handling-method
+    (if (not (eq 'list eudc-duplicate-attribute-handling-method))
+	(mapcar 
+	 (function (lambda (record)
+		     (setq final-result 
+			   (append (eudc-filter-duplicate-attributes record)
+				   final-result))))
+	 result))
+    final-result))
+
+(defun eudc-ldap-get-field-list (dummy &optional objectclass)
+  "Return a list of valid attribute names for the current server.
+OBJECTCLASS is the LDAP object class for which the valid
+attribute names are returned. Default to `person'"
+  (interactive)
+  (or eudc-server
+      (call-interactively 'eudc-set-server))
+  (let ((ldap-host-parameters-alist 
+	 (list (cons eudc-server
+		     '(scope subtree sizelimit 1)))))
+    (mapcar 'eudc-ldap-cleanup-record
+	    (ldap-search 
+	     (eudc-ldap-format-query-as-rfc1558 
+	      (list (cons "objectclass"
+			  (or objectclass
+			      "person"))))
+	     eudc-server nil t))))
+
+(defun eudc-ldap-escape-query-special-chars (string)
+  "Value is STRING with characters forbidden in LDAP queries escaped."
+;; Note that * should also be escaped but in most situations I suppose 
+;; the user doesn't want this
+  (eudc-replace-in-string
+   (eudc-replace-in-string
+    (eudc-replace-in-string
+      (eudc-replace-in-string 
+       string 
+       "\\\\" "\\5c")
+      "(" "\\28")
+     ")" "\\29")
+   (char-to-string ?\0) "\\00"))
+
+(defun eudc-ldap-format-query-as-rfc1558 (query)
+  "Format the EUDC QUERY list as a RFC1558 LDAP search filter."
+  (format "(&%s)" 
+	  (apply 'concat 
+		 (mapcar '(lambda (item)
+			    (format "(%s=%s)" 
+				    (car item) 
+				    (eudc-ldap-escape-query-special-chars (cdr item))))
+			 query))))
+
+
+;;}}}        
+
+;;{{{      High-level interfaces (interactive functions)
+
+(defun eudc-ldap-customize ()
+  "Customize the EUDC LDAP support."
+  (interactive)
+  (customize-group 'eudc-ldap))
+
+(defun eudc-ldap-check-base ()
+  "Check if the current LDAP server has a configured search base."
+  (unless (or (eudc-ldap-get-host-parameter eudc-server 'base)
+	      ldap-default-base
+	      (null (y-or-n-p "No search base defined. Configure it now ?")))
+    ;; If the server is not in ldap-host-parameters-alist we add it for the
+    ;; user
+    (if (null (assoc eudc-server ldap-host-parameters-alist))
+	(setq ldap-host-parameters-alist 
+	      (cons (list eudc-server) ldap-host-parameters-alist)))
+    (customize-variable 'ldap-host-parameters-alist)))
+
+;;;}}}
+
+
+(eudc-register-protocol 'ldap)
+
+(provide 'eudcb-ldap)
+
+;;; eudcb-ldap.el ends here
diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el
new file mode 100644
index 00000000000..5466aaa1493
--- /dev/null
+++ b/lisp/net/eudcb-ph.el
@@ -0,0 +1,257 @@
+;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend
+
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <oscar@xemacs.org>
+;; Maintainer: Oscar Figueiredo <oscar@xemacs.org>
+;; Keywords: help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;    This library provides specific CCSO PH/QI protocol support for the 
+;;    Emacs Unified Directory Client package
+
+;;; Code:
+
+(require 'eudc)
+
+
+;;{{{      Internal cooking
+
+(eudc-protocol-set 'eudc-bbdb-conversion-alist 'eudc-ph-bbdb-conversion-alist 'ph)
+(eudc-protocol-set 'eudc-query-function 'eudc-ph-query-internal 'ph)
+(eudc-protocol-set 'eudc-list-attributes-function 'eudc-ph-get-field-list 'ph)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes t 'ph)
+
+(defvar eudc-ph-process-buffer nil)
+(defvar eudc-ph-read-point)
+
+(defconst eudc-ph-default-server-port 105
+  "Default TCP port for CCSO PH/QI directory services.")
+
+
+
+
+(defun eudc-ph-query-internal (query &optional return-fields)
+  "Query the PH/QI server with QUERY.
+QUERY can be a string NAME or a list made of strings NAME 
+and/or cons cells (KEY . VALUE) where KEYs should be valid 
+CCSO database keys.  NAME is equivalent to (DEFAULT . NAME),
+where DEFAULT is the default key of the database.
+RETURN-FIELDS is a list of database fields to return,
+defaulting to `eudc-default-return-attributes'."
+  (let (request)
+    (if (null return-fields)
+	(setq return-fields eudc-default-return-attributes))
+    (if (eq 'all return-fields)
+	(setq return-fields '(all)))
+    (setq request 
+	  (concat "query "
+		  (if (stringp query)
+		      query
+		    (mapconcat (function (lambda (elt)
+					   (if (stringp elt) elt)
+					   (format "%s=%s" (car elt) (cdr elt))))
+			       query
+			       " "))
+		  (if return-fields
+		      (concat " return " (mapconcat 'symbol-name return-fields " ")))))
+    (and (> (length request) 6)
+	 (eudc-ph-do-request request)
+	 (eudc-ph-parse-query-result return-fields))))
+
+(defun eudc-ph-get-field-list (full-records)
+  "Return a list of valid field names for the current server.
+If FULL-RECORDS is non-nil, full records including field description
+are returned"
+  (interactive)
+  (eudc-ph-do-request "fields")
+  (if full-records
+      (eudc-ph-parse-query-result)
+    (mapcar 'eudc-caar (eudc-ph-parse-query-result))))
+
+
+(defun eudc-ph-parse-query-result (&optional fields)
+  "Return a list of alists of key/values from in `eudc-ph-process-buffer'. 
+Fields not in FIELDS are discarded."
+  (let (record 
+	records
+	line-regexp
+	current-key
+	key
+	value
+	ignore)
+    (save-excursion
+      (message "Parsing results...")
+      (set-buffer eudc-ph-process-buffer)
+      (goto-char (point-min))
+      (while (re-search-forward "^\\(-[0-9]+\\):\\([0-9]+\\):" nil t)
+	(catch 'ignore
+	  (setq line-regexp (concat "^\\(-[0-9]+\\):" (match-string 2) ":[ \t]*\\([-a-zA-Z_]*\\)?:[ \t]*\\(.*\\)$"))
+	  (beginning-of-line)
+	  (setq record nil
+		ignore nil
+		current-key nil)
+	  (while (re-search-forward line-regexp nil t)
+	    (catch 'skip-line
+	      (if (string= "-508" (match-string 1))
+		  ;; A field is missing in this entry.  Skip it or skip the
+		  ;; whole record (see `eudc-strict-return-matches')
+		  (if (not eudc-strict-return-matches)
+		      (throw 'skip-line t)
+		    (while (re-search-forward line-regexp nil t))
+		    (setq ignore t)
+		    (throw 'ignore t)))
+	      (setq key   (and (not (string= (match-string 2) ""))
+			       (intern (match-string 2)))
+		    value (match-string 3))
+	      (if (and current-key
+		       (eq key current-key)) 
+		  (setq key nil)
+		(setq current-key key))
+	      (if (or (null fields)
+		      (eq 'all fields)
+		      (memq current-key fields))
+		  (if key
+		      (setq record (cons (cons key value) record)) ; New key
+		    (setcdr (car record) (if (listp (eudc-cdar record))
+					     (append (eudc-cdar record) (list value))
+					   (list (eudc-cdar record) value))))))))
+	(and (not ignore)
+	     (or (null fields)
+		 (eq 'all fields)
+		 (setq record (nreverse record)))
+	     (setq record (if (not (eq 'list eudc-duplicate-attribute-handling-method))
+			      (eudc-filter-duplicate-attributes record)
+			    (list record)))
+	     (setq records (append record records))))
+      )
+    (message "Done")
+    records)
+  )
+
+(defun eudc-ph-do-request (request)
+  "Send REQUEST to the server.
+Wait for response and return the buffer containing it."
+  (let (process
+	buffer)
+    (unwind-protect
+	(progn
+	  (message "Contacting server...")
+	  (setq process (eudc-ph-open-session))
+	  (if process
+	      (save-excursion 
+		(set-buffer (setq buffer (process-buffer process)))
+		(eudc-ph-send-command process request)
+		(message "Request sent, waiting for reply...")
+		(eudc-ph-read-response process))))
+      (if process
+	  (eudc-ph-close-session process)))
+    buffer))
+        
+(defun eudc-ph-open-session (&optional server)
+  "Open a connection to the given CCSO/QI SERVER.
+SERVER is either a string naming the server or a list (NAME PORT)."
+  (let (process
+	host
+	port)
+    (catch 'done
+      (if (null server)
+	  (setq server (or eudc-server
+			   (call-interactively 'eudc-ph-set-server))))
+      (string-match "\\(.*\\)\\(:\\(.*\\)\\)?" server)
+      (setq host (match-string 1 server))
+      (setq port (or (match-string 3 server)
+		     eudc-ph-default-server-port))
+      (setq eudc-ph-process-buffer (get-buffer-create (format " *PH-%s*" host)))
+      (save-excursion
+	(set-buffer eudc-ph-process-buffer)
+	(erase-buffer)
+	(setq eudc-ph-read-point (point))
+	(and eudc-xemacs-mule-p
+	     (set-buffer-file-coding-system 'binary t)))
+      (setq process (open-network-stream "ph" eudc-ph-process-buffer host port))
+      (if (null process)
+	  (throw 'done nil))
+      (process-kill-without-query process)
+      process)))
+
+
+(defun eudc-ph-close-session (process)
+  (save-excursion
+    (set-buffer (process-buffer process))
+    (eudc-ph-send-command process "quit")
+    (eudc-ph-read-response process)
+    (if (fboundp 'add-async-timeout)
+	(add-async-timeout 10 'delete-process process)
+      (run-at-time 2 nil 'delete-process process))))
+
+(defun eudc-ph-send-command (process command)
+  (goto-char (point-max))
+  (process-send-string process command)
+  (process-send-string process "\r\n")
+  )
+
+(defun eudc-ph-read-response (process &optional return-response)
+  "Read a response from the PH/QI query process PROCESS.
+Returns nil if response starts with an error code.  If the
+response is successful the return code or the response itself is returned
+depending on RETURN-RESPONSE."
+  (let ((case-fold-search nil)
+	return-code
+	match-end)
+    (goto-char eudc-ph-read-point)
+    ;; CCSO protocol : response complete if status >= 200
+    (while (not (re-search-forward "^\\(^[2-5].*\\):.*\n" nil t))
+      (accept-process-output process)
+      (goto-char eudc-ph-read-point))
+    (setq match-end (point))
+    (goto-char eudc-ph-read-point)
+    (if (and (setq return-code (match-string 1))
+	     (setq return-code (string-to-number return-code))
+	     (>= (abs return-code) 300))
+	(progn (setq eudc-ph-read-point match-end) nil)
+      (setq eudc-ph-read-point match-end)
+      (if return-response
+	  (buffer-substring (point) match-end)
+	return-code))))
+
+;;}}}        
+
+;;{{{      High-level interfaces (interactive functions)
+
+(defun eudc-ph-customize ()
+  "Customize the EUDC PH support."
+  (interactive)
+  (customize-group 'eudc-ph))
+
+(defun eudc-ph-set-server (server)
+  "Set the PH server to SERVER."
+  (interactive "sNew PH/QI Server: ")
+  (message "Selected PH/QI server is now %s" server)
+  (eudc-set-server server 'ph))
+
+;;}}}
+
+
+(eudc-register-protocol 'ph)
+
+(provide 'eudcb-ph)
+
+;;; eudcb-ph.el ends here
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
new file mode 100644
index 00000000000..3838b2ec616
--- /dev/null
+++ b/lisp/net/ldap.el
@@ -0,0 +1,611 @@
+;;; ldap.el --- Client interface to LDAP for Emacs
+
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+;; Created: April 1998
+;; Keywords: comm
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;    This package provides basic functionality to perform searches on LDAP
+;;    servers.  It requires a command line utility generally named 
+;;    `ldapsearch' to actually perform the searches.  That program can be 
+;;    found in all LDAP developer kits such as:
+;;      - UM-LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
+;;      - OpenLDAP (http://www.openldap.org/)
+
+;;; Code:
+
+(require 'custom)
+
+(defgroup ldap nil
+  "Lightweight Directory Access Protocol."
+  :group 'comm)
+
+(defcustom ldap-default-host nil
+  "*Default LDAP server.
+A TCP port number can be appended to that name using a colon as 
+a separator."
+  :type '(choice (string :tag "Host name")
+		 (const :tag "Use library default" nil))
+  :group 'ldap)
+
+(defcustom ldap-default-port nil
+  "*Default TCP port for LDAP connections.
+Initialized from the LDAP library at build time. Default value is 389."
+  :type '(choice (const :tag "Use library default" nil)
+		 (integer :tag "Port number"))
+  :group 'ldap)
+
+(defcustom ldap-default-base nil
+  "*Default base for LDAP searches.
+This is a string using the syntax of RFC 1779.
+For instance, \"o=ACME, c=US\" limits the search to the
+Acme organization in the United States."
+  :type '(choice (const :tag "Use library default" nil)
+		 (string :tag "Search base"))
+  :group 'ldap)
+
+
+(defcustom ldap-host-parameters-alist nil
+  "*Alist of host-specific options for LDAP transactions.
+The format of each list element is (HOST PROP1 VAL1 PROP2 VAL2 ...).
+HOST is the hostname of an LDAP server(with an optional TCP port number
+appended to it  using a colon as a separator). 
+PROPn and VALn are property/value pairs describing parameters for the server.
+Valid properties include: 
+  `binddn' is the distinguished name of the user to bind as 
+    (in RFC 1779 syntax).
+  `passwd' is the password to use for simple authentication.
+  `auth' is the authentication method to use. 
+    Possible values are: `simple', `krbv41' and `krbv42'.
+  `base' is the base for the search as described in RFC 1779.
+  `scope' is one of the three symbols `subtree', `base' or `onelevel'.
+  `deref' is one of the symbols `never', `always', `search' or `find'.
+  `timelimit' is the timeout limit for the connection in seconds.
+  `sizelimit' is the maximum number of matches to return."
+  :type '(repeat :menu-tag "Host parameters"
+		 :tag "Host parameters"
+		 (list :menu-tag "Host parameters"
+		       :tag "Host parameters"
+		       :value nil
+		       (string :tag "Host name")
+		       (checklist :inline t
+				  :greedy t
+				  (list
+				   :tag "Search Base" 
+				   :inline t
+				   (const :tag "Search Base" base)
+				   string)
+				  (list
+				   :tag "Binding DN"
+				   :inline t
+				   (const :tag "Binding DN" binddn)
+				   string)
+				  (list
+				   :tag "Password"
+				   :inline t
+				   (const :tag "Password" passwd)
+				   string)
+				  (list
+				   :tag "Authentication Method"
+				   :inline t
+				   (const :tag "Authentication Method" auth)
+				   (choice
+				    (const :menu-tag "None" :tag "None" nil)
+				    (const :menu-tag "Simple" :tag "Simple" simple)
+				    (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41)
+				    (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42)))
+				  (list
+				   :tag "Search Base" 
+				   :inline t
+				   (const :tag "Search Base" base)
+				   string)
+				  (list
+				   :tag "Search Scope" 
+				   :inline t
+				   (const :tag "Search Scope" scope)
+				   (choice
+				    (const :menu-tag "Default" :tag "Default" nil)
+				    (const :menu-tag "Subtree" :tag "Subtree" subtree)
+				    (const :menu-tag "Base" :tag "Base" base)
+				    (const :menu-tag "One Level" :tag "One Level" onelevel)))
+				  (list
+				   :tag "Dereferencing"
+				   :inline t
+				   (const :tag "Dereferencing" deref)
+				   (choice
+				    (const :menu-tag "Default" :tag "Default" nil)
+				    (const :menu-tag "Never" :tag "Never" never)
+				    (const :menu-tag "Always" :tag "Always" always)
+				    (const :menu-tag "When searching" :tag "When searching" search)
+				    (const :menu-tag "When locating base" :tag "When locating base" find)))
+				  (list
+				   :tag "Time Limit"
+				   :inline t
+				   (const :tag "Time Limit" timelimit)
+				   (integer :tag "(in seconds)"))
+				  (list
+				   :tag "Size Limit"
+				   :inline t
+				   (const :tag "Size Limit" sizelimit)
+				   (integer :tag "(number of records)")))))
+  :group 'ldap)
+
+(defcustom ldap-ldapsearch-prog "ldapsearch"
+  "*The name of the ldapsearch command line program."
+  :type '(string :tag "`ldapsearch' Program")
+  :group 'ldap)
+
+(defcustom ldap-ldapsearch-args '("-B")
+  "*A list of additional arguments to pass to `ldapsearch'.
+It is recommended to use the `-T' switch with Netscape's
+implementation to avoid line wrapping.
+The `-B' switch should be used to enable the retrieval of 
+binary values."
+  :type '(repeat :tag "`ldapsearch' Arguments"
+		 (string :tag "Argument"))
+  :group 'ldap)
+
+(defcustom ldap-ignore-attribute-codings t
+  "*If non-nil, do not encode/decode LDAP attribute values."
+  :type 'boolean
+  :group 'ldap)
+
+(defcustom ldap-default-attribute-decoder nil
+  "*Decoder function to use for attributes whose syntax is unknown."
+  :type 'symbol
+  :group 'ldap)
+
+(defcustom ldap-coding-system nil
+  "*Coding system of LDAP string values.
+LDAP v3 specifies the coding system of strings to be UTF-8 but 
+Emacs still does not have reasonable support for that."
+  :type 'symbol
+  :group 'ldap)
+
+(defvar ldap-attribute-syntax-encoders
+  [nil					; 1  ACI Item                        N  
+   nil					; 2  Access Point                    Y  
+   nil					; 3  Attribute Type Description      Y  
+   nil					; 4  Audio                           N  
+   nil					; 5  Binary                          N  
+   nil					; 6  Bit String                      Y  
+   ldap-encode-boolean			; 7  Boolean                         Y  
+   nil					; 8  Certificate                     N  
+   nil					; 9  Certificate List                N  
+   nil					; 10 Certificate Pair                N  
+   ldap-encode-country-string		; 11 Country String                  Y  
+   ldap-encode-string			; 12 DN                              Y  
+   nil					; 13 Data Quality Syntax             Y  
+   nil					; 14 Delivery Method                 Y  
+   ldap-encode-string			; 15 Directory String                Y  
+   nil					; 16 DIT Content Rule Description    Y  
+   nil					; 17 DIT Structure Rule Description  Y  
+   nil					; 18 DL Submit Permission            Y  
+   nil					; 19 DSA Quality Syntax              Y  
+   nil					; 20 DSE Type                        Y  
+   nil					; 21 Enhanced Guide                  Y  
+   nil					; 22 Facsimile Telephone Number      Y  
+   nil					; 23 Fax                             N  
+   nil					; 24 Generalized Time                Y  
+   nil					; 25 Guide                           Y  
+   nil					; 26 IA5 String                      Y  
+   number-to-string			; 27 INTEGER                         Y  
+   nil					; 28 JPEG                            N  
+   nil					; 29 Master And Shadow Access Points Y  
+   nil					; 30 Matching Rule Description       Y  
+   nil					; 31 Matching Rule Use Description   Y  
+   nil					; 32 Mail Preference                 Y  
+   nil					; 33 MHS OR Address                  Y  
+   nil					; 34 Name And Optional UID           Y  
+   nil					; 35 Name Form Description           Y  
+   nil					; 36 Numeric String                  Y  
+   nil					; 37 Object Class Description        Y  
+   nil					; 38 OID                             Y  
+   nil					; 39 Other Mailbox                   Y  
+   nil					; 40 Octet String                    Y  
+   ldap-encode-address			; 41 Postal Address                  Y  
+   nil					; 42 Protocol Information            Y  
+   nil					; 43 Presentation Address            Y  
+   ldap-encode-string			; 44 Printable String                Y  
+   nil					; 45 Subtree Specification           Y  
+   nil					; 46 Supplier Information            Y  
+   nil					; 47 Supplier Or Consumer            Y  
+   nil					; 48 Supplier And Consumer           Y  
+   nil					; 49 Supported Algorithm             N  
+   nil					; 50 Telephone Number                Y  
+   nil					; 51 Teletex Terminal Identifier     Y  
+   nil					; 52 Telex Number                    Y  
+   nil					; 53 UTC Time                        Y  
+   nil					; 54 LDAP Syntax Description         Y  
+   nil					; 55 Modify Rights                   Y  
+   nil					; 56 LDAP Schema Definition          Y  
+   nil					; 57 LDAP Schema Description         Y  
+   nil					; 58 Substring Assertion             Y  
+   ]  
+  "A vector of functions used to encode LDAP attribute values.
+The sequence of functions corresponds to the sequence of LDAP attribute syntax
+object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in 
+RFC2252 section 4.3.2")
+
+(defvar ldap-attribute-syntax-decoders
+  [nil					; 1  ACI Item                        N  
+   nil					; 2  Access Point                    Y  
+   nil					; 3  Attribute Type Description      Y  
+   nil					; 4  Audio                           N  
+   nil					; 5  Binary                          N  
+   nil					; 6  Bit String                      Y  
+   ldap-decode-boolean			; 7  Boolean                         Y  
+   nil					; 8  Certificate                     N  
+   nil					; 9  Certificate List                N  
+   nil					; 10 Certificate Pair                N  
+   ldap-decode-string			; 11 Country String                  Y  
+   ldap-decode-string			; 12 DN                              Y  
+   nil					; 13 Data Quality Syntax             Y  
+   nil					; 14 Delivery Method                 Y  
+   ldap-decode-string			; 15 Directory String                Y  
+   nil					; 16 DIT Content Rule Description    Y  
+   nil					; 17 DIT Structure Rule Description  Y  
+   nil					; 18 DL Submit Permission            Y  
+   nil					; 19 DSA Quality Syntax              Y  
+   nil					; 20 DSE Type                        Y  
+   nil					; 21 Enhanced Guide                  Y  
+   nil					; 22 Facsimile Telephone Number      Y  
+   nil					; 23 Fax                             N  
+   nil					; 24 Generalized Time                Y  
+   nil					; 25 Guide                           Y  
+   nil					; 26 IA5 String                      Y  
+   string-to-number			; 27 INTEGER                         Y  
+   nil					; 28 JPEG                            N  
+   nil					; 29 Master And Shadow Access Points Y  
+   nil					; 30 Matching Rule Description       Y  
+   nil					; 31 Matching Rule Use Description   Y  
+   nil					; 32 Mail Preference                 Y  
+   nil					; 33 MHS OR Address                  Y  
+   nil					; 34 Name And Optional UID           Y  
+   nil					; 35 Name Form Description           Y  
+   nil					; 36 Numeric String                  Y  
+   nil					; 37 Object Class Description        Y  
+   nil					; 38 OID                             Y  
+   nil					; 39 Other Mailbox                   Y  
+   nil					; 40 Octet String                    Y  
+   ldap-decode-address			; 41 Postal Address                  Y  
+   nil					; 42 Protocol Information            Y  
+   nil					; 43 Presentation Address            Y  
+   ldap-decode-string			; 44 Printable String                Y  
+   nil					; 45 Subtree Specification           Y  
+   nil					; 46 Supplier Information            Y  
+   nil					; 47 Supplier Or Consumer            Y  
+   nil					; 48 Supplier And Consumer           Y  
+   nil					; 49 Supported Algorithm             N  
+   nil					; 50 Telephone Number                Y  
+   nil					; 51 Teletex Terminal Identifier     Y  
+   nil					; 52 Telex Number                    Y  
+   nil					; 53 UTC Time                        Y  
+   nil					; 54 LDAP Syntax Description         Y  
+   nil					; 55 Modify Rights                   Y  
+   nil					; 56 LDAP Schema Definition          Y  
+   nil					; 57 LDAP Schema Description         Y  
+   nil					; 58 Substring Assertion             Y  
+   ]  
+  "A vector of functions used to decode LDAP attribute values.
+The sequence of functions corresponds to the sequence of LDAP attribute syntax
+object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in 
+RFC2252 section 4.3.2")
+
+
+(defvar ldap-attribute-syntaxes-alist
+  '((createtimestamp . 24)
+    (modifytimestamp . 24)
+    (creatorsname . 12)
+    (modifiersname . 12)
+    (subschemasubentry . 12)
+    (attributetypes . 3)
+    (objectclasses . 37)
+    (matchingrules . 30)
+    (matchingruleuse . 31)
+    (namingcontexts . 12)
+    (altserver . 26)
+    (supportedextension . 38)
+    (supportedcontrol . 38)
+    (supportedsaslmechanisms . 15)
+    (supportedldapversion . 27)
+    (ldapsyntaxes . 16)
+    (ditstructurerules . 17)
+    (nameforms . 35)
+    (ditcontentrules . 16)
+    (objectclass . 38)
+    (aliasedobjectname . 12)
+    (cn . 15)
+    (sn . 15)
+    (serialnumber . 44)
+    (c . 15)
+    (l . 15)
+    (st . 15)
+    (street . 15)
+    (o . 15)
+    (ou . 15)
+    (title . 15)
+    (description . 15)
+    (searchguide . 25)
+    (businesscategory . 15)
+    (postaladdress . 41)
+    (postalcode . 15)
+    (postofficebox . 15)
+    (physicaldeliveryofficename . 15)
+    (telephonenumber . 50)
+    (telexnumber . 52)
+    (telexterminalidentifier . 51)
+    (facsimiletelephonenumber . 22)
+    (x121address . 36)
+    (internationalisdnnumber . 36)
+    (registeredaddress . 41)
+    (destinationindicator . 44)
+    (preferreddeliverymethod . 14)
+    (presentationaddress . 43)
+    (supportedapplicationcontext . 38)
+    (member . 12)
+    (owner . 12)
+    (roleoccupant . 12)
+    (seealso . 12)
+    (userpassword . 40)
+    (usercertificate . 8)
+    (cacertificate . 8)
+    (authorityrevocationlist . 9)
+    (certificaterevocationlist . 9)
+    (crosscertificatepair . 10)
+    (name . 15)
+    (givenname . 15)
+    (initials . 15)
+    (generationqualifier . 15)
+    (x500uniqueidentifier . 6)
+    (dnqualifier . 44)
+    (enhancedsearchguide . 21)
+    (protocolinformation . 42)
+    (distinguishedname . 12)
+    (uniquemember . 34)
+    (houseidentifier . 15)
+    (supportedalgorithms . 49)
+    (deltarevocationlist . 9)
+    (dmdname . 15))
+  "A map of LDAP attribute names to their type object id minor number.
+This table is built from RFC2252 Section 5 and RFC2256 Section 5")
+
+
+;; Coding/decoding functions
+
+(defun ldap-encode-boolean (bool)
+  (if bool
+      "TRUE"
+    "FALSE"))
+
+(defun ldap-decode-boolean (str)
+  (cond
+   ((string-equal str "TRUE")
+    t)
+   ((string-equal str "FALSE")
+    nil)
+   (t
+    (error "Wrong LDAP boolean string: %s" str))))
+    
+(defun ldap-encode-country-string (str)
+  ;; We should do something useful here...
+  (if (not (= 2 (length str)))
+      (error "Invalid country string: %s" str)))
+
+(defun ldap-decode-string (str)
+  (decode-coding-string str ldap-coding-system))
+
+(defun ldap-encode-string (str)
+  (encode-coding-string str ldap-coding-system))
+
+(defun ldap-decode-address (str)
+  (mapconcat 'ldap-decode-string
+	     (split-string str "\\$")
+	     "\n"))
+
+(defun ldap-encode-address (str)
+  (mapconcat 'ldap-encode-string
+	     (split-string str "\n")
+	     "$"))
+
+
+;; LDAP protocol functions
+    
+(defun ldap-get-host-parameter (host parameter)
+  "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
+  (plist-get (cdr (assoc host ldap-host-parameters-alist))
+	     parameter))
+	
+(defun ldap-decode-attribute (attr)
+  "Decode the attribute/value pair ATTR according to LDAP rules.
+The attribute name is looked up in `ldap-attribute-syntaxes-alist' 
+and the corresponding decoder is then retrieved from 
+`ldap-attribute-syntax-decoders' and applied on the value(s)."
+  (let* ((name (car attr))
+	 (values (cdr attr))
+	 (syntax-id (cdr (assq (intern (downcase name))
+			       ldap-attribute-syntaxes-alist)))
+	 decoder)
+    (if syntax-id
+	(setq decoder (aref ldap-attribute-syntax-decoders
+			    (1- syntax-id)))
+      (setq decoder ldap-default-attribute-decoder))
+    (if decoder
+	(cons name (mapcar decoder values))
+      attr)))
+    
+
+(defun ldap-search (filter &optional host attributes attrsonly withdn)
+  "Perform an LDAP search.
+FILTER is the search filter in RFC1558 syntax.
+HOST is the LDAP host on which to perform the search.
+ATTRIBUTES are the specific attributes to retrieve, nil means 
+retrieve all.
+ATTRSONLY, if non-nil, retrieves the attributes only, without 
+the associated values.
+If WITHDN is non-nil, each entry in the result will be prepended with
+its distinguished name WITHDN.
+Additional search parameters can be specified through 
+`ldap-host-parameters-alist', which see."
+  (interactive "sFilter:")
+  (or host
+      (setq host ldap-default-host)
+      (error "No LDAP host specified"))
+  (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
+	result)
+    (setq result (ldap-search-internal (append host-plist
+					       (list 'host host
+						     'filter filter
+						     'attributes attributes 
+						     'attrsonly attrsonly
+						     'withdn withdn))))
+    (if ldap-ignore-attribute-codings
+	result
+      (mapcar (function
+	       (lambda (record)
+		 (mapcar 'ldap-decode-attribute record)))
+	      result))))
+
+
+(defun ldap-search-internal (search-plist)
+  "Perform a search on a LDAP server.
+SEARCH-PLIST is a property list describing the search request.
+Valid keys in that list are:
+  `host' is a string naming one or more (blank-separated) LDAP servers to
+to try to connect to.  Each host name may optionally be of the form HOST:PORT.
+  `filter' is a filter string for the search as described in RFC 1558.
+  `attributes' is a list of strings indicating which attributes to retrieve
+for each matching entry. If nil, return all available attributes.
+  `attrsonly', if non-nil, indicates that only attributes are retrieved,
+not their associated values.
+  `base' is the base for the search as described in RFC 1779.
+  `scope' is one of the three symbols `sub', `base' or `one'.
+  `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
+  `passwd' is the password to use for simple authentication.
+  `deref' is one of the symbols `never', `always', `search' or `find'.
+  `timelimit' is the timeout limit for the connection in seconds.
+  `sizelimit' is the maximum number of matches to return.
+  `withdn' if non-nil each entry in the result will be prepended with
+its distinguished name DN.
+The function returns a list of matching entries.  Each entry is itself
+an alist of attribute/value pairs."
+  (let ((buf (get-buffer-create " *ldap-search*"))
+	(bufval (get-buffer-create " *ldap-value*"))
+	(host (or (plist-get search-plist 'host)
+		  ldap-default-host))
+	(filter (plist-get search-plist 'filter))
+	(attributes (plist-get search-plist 'attributes))
+	(attrsonly (plist-get search-plist 'attrsonly))
+	(base (or (plist-get search-plist 'base)
+		  ldap-default-base))
+	(scope (plist-get search-plist 'scope))
+	(binddn (plist-get search-plist 'binddn))
+	(passwd (plist-get search-plist 'passwd))
+	(deref (plist-get search-plist 'deref))
+	(timelimit (plist-get search-plist 'timelimit))
+	(sizelimit (plist-get search-plist 'sizelimit))
+	(withdn (plist-get search-plist 'withdn))
+	(numres 0)
+	arglist dn name value record result)
+    (if (or (null filter)
+	    (equal "" filter))
+	(error "No search filter"))
+    (setq filter (cons filter attributes))
+    (save-excursion
+      (set-buffer buf)
+      (erase-buffer)
+      (if (and host
+	       (not (equal "" host)))
+	  (setq arglist (nconc arglist (list (format "-h%s" host)))))
+      (if (and attrsonly
+	       (not (equal "" attrsonly)))
+	  (setq arglist (nconc arglist (list "-A"))))
+      (if (and base
+	       (not (equal "" base)))
+	  (setq arglist (nconc arglist (list (format "-b%s" base)))))
+      (if (and scope
+	       (not (equal "" scope)))
+	  (setq arglist (nconc arglist (list (format "-s%s" scope)))))
+      (if (and binddn
+	       (not (equal "" binddn)))
+	  (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
+      (if (and passwd
+	       (not (equal "" passwd)))
+	  (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
+      (if (and deref
+	       (not (equal "" deref)))
+	  (setq arglist (nconc arglist (list (format "-a%s" deref)))))
+      (if (and timelimit
+	       (not (equal "" timelimit)))
+	  (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
+      (if (and sizelimit
+	       (not (equal "" sizelimit)))
+	  (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
+      (eval `(call-process ldap-ldapsearch-prog
+			   nil
+			   buf
+			   nil	  
+			   ,@arglist
+			   "-t"		; Write values to temp files
+			   ,@ldap-ldapsearch-args
+			   ,@filter))
+      (insert "\n")
+      (goto-char (point-min))
+      
+      (if (looking-at "usage")
+	  (error "Incorrect ldapsearch invocation")
+	(message "Parsing results... ")
+	(while (progn 
+		 (skip-chars-forward " \t\n")
+		 (not (eobp)))
+	  (setq dn (buffer-substring (point) (save-excursion 
+					       (end-of-line)
+					       (point))))
+	  (forward-line 1)
+	  (while (looking-at "^\\(\\w*\\)[=:\t ]+\\(.*\\)$")
+	    (setq name (match-string 1)
+		  value (match-string 2))
+	    (save-excursion
+	      (set-buffer bufval)
+	      (erase-buffer)
+	      (insert-file-contents-literally value)
+	      (delete-file value)
+	      (setq value (buffer-substring (point-min) (point-max))))
+	    (setq record (cons (list name value)
+			       record))
+	    (forward-line 1))
+	  (setq result (cons (if withdn 
+				 (cons dn (nreverse record))
+			       (nreverse record)) result))
+	  (setq record nil)
+	  (skip-chars-forward " \t\n")      
+	  (message "Parsing results... %d" numres)
+	  (1+ numres))
+	(message "Parsing results... done")
+	(nreverse result)))))
+
+
+(provide 'ldap)
+
+;;; ldap.el ends here