Commits

Anonymous committed 40d66d2

Basline package from Steve

  • Participants
  • Tags base

Comments (0)

Files changed (7)

+_pkg.el
+package-info
+auto-autoloads.el
+custom-load.el
+1998-02-25  Oscar Figueiredo  <Oscar.Figueiredo@di.epfl.ch>
+
+	* eudc: Released 0.2/pkg0.9 
+
+	* eudc.el: Bug fix for compilation (overlay require)
+	(eudc-switch-to-protocol): Try to load eudc protocol support file
+	if protocol not supported yet
+	(eudc-set-server): Display message if interactively called
+	(eudc-query-form): Display fix
+
+	* eudc-ldap.el, eudc-ph.el: Removed custom dependency on eudc that 
+	would cause eudc-ldap and eudc-ph to be loaded together with eudc
+
+	* Makefile: Updated for release 0.2/0.9
+
+1998-02-24  Oscar Figueiredo  <Oscar.Figueiredo@di.epfl.ch>
+
+	* eudc.el: (eudc-query): Typo fix
+	(eudc-bbdbify-address): Ditto
+	
+	* Makefile: Fixes
+
+1998-02-22  Oscar Figueiredo  <Oscar.Figueiredo@di.epfl.ch>
+
+	* eudc-ph.el: Released 0.1
+
+	* eudc.el: (eudc-attribute-to-formstring-alist): Renamed to
+ 	`eudc-user-attribute-names-alist'
+	(eudc-query): Translate also return attributes if needed
+	(eudc-filter-duplicate-fields): Renamed to 
+	`eudc-filter-duplicate-attributes'
+	(eudc-create-bbdb-record): Fixed wrt `eudc-bbdb-conversion-alist'
+	(eudc-bbdbify-address): Added support for country on the last line 
+	of address
+	(eudc-get-email, eudc-get-phone): Signal error on multiple matches
+	(eudc-get-email, eudc-get-phone, eudc-expand-inline): Set server
+	if none set
+	
+	* eudc-ph.el: Bug fix (new function had not been updated)
+
+	* eudc-ldap.el: (eudc-ldap-bbdb-conversion-alist): New variable
+	(eudc-ldap-protocol-locals): Added the new var
+	(eudc-ldap-simple-query-internal): Additional cleanup in records
+	for better display by eudc
+
+Mon Feb 16 19:06:07 1998  Oscar Figueiredo, LSP DI EPFL  <figueire@lspsun12>
+
+	* eudc-ph.el: beta 1
+	Basically tested (queries only)
+
+	* eudc-ldap.el: Initial revision
+
+	* eudc.el: beta 1
+	Basically tested with ph and ldap (queries only)
+
+Sat Feb 14 17:04:44 1998  Oscar Figueiredo, LSP DI EPFL  <figueire@lspsun12>
+
+	* eudc.el, eudc-ph.el: Initial revision
+
+# Makefile for Ph lisp code
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+VERSION = 1.0
+AUTHOR_VERSION = 0.2
+MAINTAINER = Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
+PACKAGE = eudc
+PKG_TYPE = regular
+REQUIRES = xemacs-base
+CATEGORY = comm
+
+ELCS = eudc.elc eudc-ph.elc eudc-ldap.elc
+
+# INFO_FILES = eudc.info*
+
+include ../../XEmacs.rules
+
+all:: $(ELCS) auto-autoloads.elc custom-load.elc
+
+srckit: srckit-std
+
+binkit: binkit-sourceonly
+;;; eudc.el --- Emacs Unified Directory Client - LDAP Support
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
+;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
+;; Created: Feb 1998
+;; Version: 1.3
+;; Keywords: help
+
+;; This file is part of XEmacs
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; 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 library.
+
+;;; Installation:
+;;    Install EUDC first. See EUDC documentation.
+
+;;    This library runs under XEmacs 20 and under Emacs 19.34 and above
+
+;;; Usage:
+
+;;; Code:
+
+(require 'eudc)
+(require 'ldap)
+
+
+;;{{{      Package customization variables
+
+(defgroup eudc-ldap nil 
+  "Emacs Unified Directory Client - LDAP Support"
+  :group 'comm)
+
+(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)
+;;}}}
+
+;;{{{      Internal cooking
+
+(defvar eudc-ldap-attributes-translation-alist
+  '((name . sn)
+    (email . mail)
+    (phone . telephonenumber))
+  "Alist mapping EUDC attribute names to LDAP names.")
+
+(defconst eudc-ldap-protocol-locals 
+  '((eudc-query-function . eudc-ldap-simple-query-internal)
+    (eudc-protocol-attributes-translation-alist . eudc-ldap-attributes-translation-alist)
+    (eudc-bbdb-conversion-alist . eudc-ldap-bbdb-conversion-alist))
+  "LDAP protocol specific values of EUDC variables.
+This should be an alist of the form (EUDC-VAR . LDAP-VAR) where
+EUDC-VAR is the name of a EUDC variable and LDAP-VAR is 
+the corresponding LDAP-specific variable.")
+
+(defun eudc-ldap-cleanup-record-field (field)
+  "Do some cleanup in a record field to make it suitable for EUDC."
+  ;; Make the field a cons-cell if it's single-valued
+  ;; 
+  (if (null (cdr (cdr field)))
+      (cons (intern (car field)) 
+	    ;; Convert separators to newlines
+	    (replace-in-string (car (cdr field)) " \\$ " "\n"))
+    ;; Make the field name a symbol
+    (cons (intern (car field)) (cdr field))))
+
+(defun eudc-ldap-cleanup-record (record)
+  (mapcar 'eudc-ldap-cleanup-record-field
+	  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'."
+  (mapcar 'eudc-ldap-cleanup-record
+	  (ldap-search (eudc-ldap-format-query-as-rfc1558 query)
+		       eudc-server
+		       (mapcar 'symbol-name return-attrs))))
+
+(defun eudc-ldap-format-query-as-rfc1558 (query)
+  "Format the QUERY list as a RFC1558 LDAP search filter."
+  (format "(&%s)" (apply 'concat (mapcar '(lambda (item)
+					    (format "(%s=%s)" (car item) (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-set-server (server)
+  "Set the LDAP server to SERVER."
+  (interactive "sNew LDAP Server: ")
+  (eudc-set-server server 'ldap)
+  (message "Selected LDAP server is now %s" server))
+
+;;;}}}
+
+
+(eudc-register-protocol 'ldap eudc-ldap-protocol-locals)
+
+(provide 'eudc-ldap)
+
+;;; eudc-ldap.el ends here
+;;; eudc.el --- Emacs Unified Directory Client - CCSO PH/QI Support
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
+;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
+;; Created: Feb 1998
+;; Version: 1.4
+;; Keywords: help
+
+;; This file is part of XEmacs
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; 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 library.
+
+;;; Installation:
+;;    Install EUDC first. See EUDC documentation.
+
+;;    This library runs under XEmacs 20 and under Emacs 19.34 and above
+
+;;; Usage:
+
+;;; Code:
+
+(require 'eudc)
+
+;;{{{      Package customization variables
+
+(defgroup eudc-ph nil 
+  "Emacs Unified Directory Client - CCSO PH/QI Support"
+  :group 'comm)
+
+(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 CCSO Field Name Mapping"
+  :type '(repeat (cons :tag "Field Name"
+		       (symbol :tag "BBDB Field")
+		       (sexp :tag "Conversion Spec")))
+  :group 'eudc-ph)
+
+;;}}}
+
+;;{{{      Internal cooking
+
+(defconst eudc-ph-protocol-locals 
+  '((cons eudc-bbdb-conversion-alist . eudc-ph-bbdb-conversion-alist)
+    (eudc-query-function . eudc-ph-query-internal)
+    (eudc-list-attributes-function . eudc-ph-get-field-list))
+  "CCSO PH/QI protocol specific values of EUDC variables.
+This should be an alist of the form (EUDC-VAR . PH-VAR) where
+EUDC-VAR is the name of a EUDC variable and PH-VAR is the 
+corresponding PH-specific variable.")
+
+(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))
+    (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 ()
+  "Return a list of valid field names for the current server."
+  (interactive)
+  (eudc-ph-do-request "fields")
+  (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)
+		      (memq '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)
+		 (memq '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 reponse 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 eudc-ph-protocol-locals)
+
+(provide 'eudc-ph)
+
+;;; eudc-ph.el ends here
+;;; eudc.el --- Emacs Unified Directory Client
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
+;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
+;; Created: Feb 1998
+;; Version: 1.5
+;; Keywords: help
+
+;; This file is part of XEmacs
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; 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 or CCSO PH/QI.
+;;    Queries can be made through an interactive form. 
+;;    Inline query strings in buffers can also be expanded with appropriately
+;;    formatted query results (especially used to expand email addresses in
+;;    message buffers).  It also interfaces with the BBDB package to let you
+;;    register query results into your own BBDB database.
+
+;;; Installation:
+
+;;    This library runs under XEmacs 20 and under Emacs 19.34 and above
+
+;;; Usage:
+
+;;; Code:
+
+(require 'wid-edit)
+
+(eval-and-compile
+  (if (not (fboundp 'make-overlay))
+      (require 'overlay)))
+
+(autoload 'custom-menu-create "cus-edit")
+(autoload 'bbdb-create-internal "bbdb-com")
+(autoload 'bbdb-parse-phone-number "bbdb-com")
+(autoload 'bbdb-display-records "bbdb")
+
+;;{{{      Package customization variables
+
+(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."
+  :type  '(string :tag "Server")
+  :group 'eudc)
+
+(defvar eudc-supported-protocols nil
+  "Protocols currently supported by the Unified Directory Client.
+This variable is updated when protocol-specific libraries
+are loaded, do not change by hand.")
+
+(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 'string ':tag (symbol-name s)))
+			    eudc-supported-protocols))
+  :group 'eudc)
+
+
+(defcustom eudc-strict-return-matches t
+  "*If non-nil, entries not containing all requested return attributes are ignored."
+  :type  'boolean
+  :group 'eudc)
+
+(defcustom eudc-default-return-attributes nil
+  "*A list of the default attributes to extract from directory entries.
+If set to the symbol `all' return all attributes.
+nil means return the default attributes as configured in the server."
+  :type  '(repeat (symbol :tag "Field 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' expands to all matches,
+`abort' the operation is aborted, an error is signaled."
+  :type  '(choice :menu-tag "Method"
+		  (const :menu-tag "First"  first)
+		  (const :menu-tag "Select" select)
+		  (const :menu-tag "All"    all)
+		  (const :menu-tag "Abort"  abort)
+		  (const :menu-tag "None" 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 nil
+  "*Format of an inline expansion query.
+If the inline query string consists of several words, this list specifies 
+how these individual words are mapped onto attribute names.
+If nil all the words will be mapped onto the default server/protocol key."
+  :type  '(repeat (symbol :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 "Attribute names"
+			(symbol :tag "")))
+  :group 'eudc)
+
+(defcustom eudc-query-form-attributes '(name email phone)
+  "*A list of attributes presented in the query form."
+  :tag   "Attributes in Query Forms"
+  :type  '(repeat (symbol :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 `_' signs and capitalizing the individual words."
+  :tag   "User-defined Names of Directory Attributes"
+  :type  '(repeat (cons :tag "Field"
+			(symbol :tag "Directory attribute")
+			(string :tag "User name")))
+  :group 'eudc)
+
+(defcustom eudc-options-file "~/.eudc-options"
+  "*A file where the `servers' hotlist is stored."
+  :type '(file :Tag "File Name:"))
+
+(defcustom eudc-mode-hook nil
+  "*Normal hook run on entry to EUDC mode."
+  :type '(repeat (sexp :tag "Hook")))
+
+;;}}}
+
+
+;;{{{      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)
+
+;; List of known servers
+;; Alist of (SERVER . PROTOCOL)
+(defvar eudc-server-hotlist nil)
+
+;; Query function 
+;; Protocol dependent, should be defined in eudc-protocol-locals
+(defvar eudc-query-function nil)
+
+;; A function that retrieves a list of valid attribute names 
+(defvar eudc-list-attributes-function nil)
+
+;; 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' , `email', `phone'
+(defvar eudc-protocol-attributes-translation-alist nil)
+
+;; Protocol locals
+;; List of (PROTOCOL (EUDC-VAR . VALUE) (EUDC-VAR .VALUE) ...)
+(defvar eudc-protocol-locals '((default 
+				 (eudc-query-function . nil) 
+				 (eudc-list-attributes-function . nil)
+				 (eudc-protocol-attributes-translation-alist . nil)
+				 (eudc-bbdb-conversion-alist . nil))))
+
+
+;;; Emacs does not provide that one
+(if (not (fboundp 'split-string))
+    (defun split-string (string pattern)
+      "Return a list of substrings of STRING which are separated by PATTERN."
+      (let (parts (start 0))
+	(while (string-match pattern string start)
+	  (setq parts (cons (substring string start (match-beginning 0)) parts)
+		start (match-end 0)))
+	(nreverse (cons (substring string start) parts))
+	)))
+
+(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))))
+
+;;}}} 
+
+
+;; Add PROTOCOL to the list of supported protocols
+;; and LOCALS to the protocol locals list
+(defun eudc-register-protocol (protocol locals)
+  (unless (memq protocol eudc-supported-protocols)
+    (setq eudc-supported-protocols 
+	  (cons protocol eudc-supported-protocols))
+    (setq eudc-protocol-locals 
+	  (cons (cons protocol locals)
+		eudc-protocol-locals))))
+
+;; If eudc-protocol-locals has been corrupted, things can go bad here as part
+;; of the variables may be set for the new protocol while some will remain
+;; for the old one.  A condition-case would partly solve the problem but the
+;; code increase to be really foolproof is too big.
+(defun eudc-switch-to-protocol (protocol)
+  "From now on, use PROTOCOL for directory queries"
+  (unless (or (member protocol
+		      eudc-supported-protocols)
+	      (load (concat "eudc-" (symbol-name protocol)) t))
+      (error "Unsupported protocol: %s" protocol))
+  (let ((locals (assq 'default eudc-protocol-locals)))
+    ;; First reset protocol locals to their default values
+    (setq locals (cdr locals))
+    (while locals
+      (set (car (car locals)) (cdr (car locals)))
+      (setq locals (cdr locals)))
+    (setq locals (assq protocol eudc-protocol-locals))
+    (if (null locals)
+	(error "No protocol specific settings found"))
+    (setq locals (cdr locals))
+    (while locals
+      (set (car (car locals)) (cdr (car locals)))
+      (setq locals (cdr locals))))
+  (setq eudc-protocol protocol))
+
+(defun eudc-translate-query (query)
+  "Translate attribute names of QUERY 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 ccording 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-query (query &optional return-attributes no-translation)
+   "Query the directory server with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE) where 
+ATTR is an attribute name and VALUE the corresponding
+value.  
+ATTR is translated according to `eudc-protocol-attributes-translation-alist' 
+unless NO-TRANSLATION is non nil.
+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 return-attributes)
+     (funcall eudc-query-function 
+	      (eudc-translate-query query)
+	      (eudc-translate-attribute-list return-attributes))))
+
+ 
+(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 field-beg
+	attribute)
+    (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 prompt strings, compute max prompt width
+      (setq precords
+	    (mapcar 
+	     (function
+	      (lambda (record)
+		(mapcar 
+		 (function
+		  (lambda (field)
+		    (setq attribute (if raw-attr-names
+					 (symbol-name (car field))
+				      (or (and (assq (car field) eudc-user-attribute-names-alist)
+						(cdr (assq (car field) eudc-user-attribute-names-alist)))
+					   (capitalize (mapconcat '(lambda (char)
+								     (if (eq char ?_)
+									 " "
+								       (char-to-string char)))
+								  (symbol-name (car field))
+								  "")))))
+		    (if (> (length attribute) width)
+			(setq width (length attribute)))
+		    (cons attribute (cdr field))))
+		 record)))
+	     records))
+      (mapcar (function
+	       (lambda (record)
+		 (setq beg (point))
+		 ;; Actually insert the attribute/value pairs
+		 (mapcar (function
+			  (lambda (field)
+			    (setq field-beg (point))
+			    (insert (format (concat "%" width "s: ") (car field)))
+			    (put-text-property field-beg (point) 'face 'bold)
+			    (mapcar (function 
+				     (lambda (val)
+				       (indent-to (+ 2 width))
+				       (insert val "\n")))
+				    (if (stringp (cdr field))
+					(split-string (cdr field) "\n")
+				      (cdr field)))))
+			 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)      
+    )
+  )
+
+(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))
+      )))
+         
+           
+
+(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))
+      (mapcar (function
+	       (lambda (field)
+		 (let ((method (if (consp eudc-duplicate-attribute-handling-method)
+				   (cdr (assq (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-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-create-bbdb-record (record)
+  "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."
+  ;; 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))
+
+      (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-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)
+  (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))
+
+(defun eudc-set-server (server protocol)
+  "Set the directory server to SERVER using PROTOCOL."
+  (interactive "sDirectory Server: \nSProtocol: ")
+  (unless (eq protocol eudc-protocol)
+    (eudc-switch-to-protocol protocol))
+  (setq eudc-server server)
+  (if (interactive-p)
+      (message "Current directory server is now %s (%s)" eudc-server eudc-protocol)))
+
+;;;###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)))
+	(if entries 
+	    (if (interactive-p)
+		(eudc-display-records entries t)
+	      entries)))
+    (error "The %s protocol has no support for listing attributes" eudc-protocol)))
+
+;;;###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.  If it contains more than
+one word, the variable `eudc-inline-query-format' controls to map these
+onto 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."
+  (interactive)
+  (or eudc-server
+      (call-interactively 'eudc-set-server))
+  (let* ((end (point))
+	 (beg (save-excursion
+		(if (re-search-backward "[:,][ \t]*" 
+					(save-excursion
+					  (beginning-of-line)
+					  (point))
+					'move)
+		    (goto-char (match-end 0)))
+		(point)))
+	 (words (buffer-substring beg end))
+	 query
+	 query-alist
+	 (query-format eudc-inline-query-format)
+	 response
+	 response-strings
+	 key val cell)
+    
+    ;; Prepare the query
+    (if (or (not query-format)
+	    (not (string-match "[ \t]+" words)))
+	(setq query words)
+      (setq words (split-string words "[ \t]+"))
+      (while (and words query-format)
+	(setq query-alist (cons (cons (car query-format) (car words)) query-alist))
+	(setq words (cdr words)
+	      query-format (cdr query-format)))
+      (if words
+	  (setcdr (car query-alist)
+		  (concat (eudc-cdar query-alist) " "
+			  (mapconcat 'identity words " "))))
+      ;; Uniquify query-alist
+      (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 val " " (cdr cell)))
+	  (setq query (cons (car query-alist) query))))
+      (setq query-alist (cdr query-alist)))
+
+    (setq response (eudc-query query (cdr eudc-inline-expansion-format)))
+
+    (if (null response)
+	(error "No match found")
+
+      ;; Process response through eudc-inline-expansion-format
+      (while response
+	(setq response-strings
+	      (cons (apply 'format 
+			   (car eudc-inline-expansion-format)
+			   (mapcar (function 
+				    (lambda (field)
+				      (or (cdr (assq field (car response))) 
+					  "")))
+				   (cdr eudc-inline-expansion-format)))
+		    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)
+	(with-output-to-temp-buffer "*Completions*"
+	  (display-completion-list 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"))
+       ))
+    )
+  )
+
+;;;###autoload
+(defun eudc-query-form (&optional get-fields-from-server)
+  "Display a form to query the directory server.
+If given a non-nil argument 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*"))
+	field-name
+	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")
+    ;; Loop over prompt strings to find the biggest one
+    (setq fields 
+	  (mapcar (function
+		   (lambda (field)
+		     (setq field-name (or (and (assq field eudc-user-attribute-names-alist)
+					       (cdr (assq field eudc-user-attribute-names-alist)))
+					  (capitalize (symbol-name field))))
+		     (if (> (length field-name) width)
+			 (setq width (length field-name)))
+		     (cons field field-name)))
+		  fields))
+    ;; Insert the first widget out of the mapcar to leave the cursor 
+    ;; in the first field 
+    (widget-insert "\n\n" (format (concat "%" width "s: ") (cdr (car fields))))
+    (setq pt (point))
+    (setq widget (widget-create 'editable-field :size 15))
+    (setq eudc-form-widget-list (cons (cons (car (car fields)) widget)
+				      eudc-form-widget-list))
+    (setq fields (cdr fields))
+    (mapcar (function
+	     (lambda (field)
+	       (widget-insert "\n\n" (format (concat "%" width "s: ") (cdr field)))
+	       (setq widget (widget-create 'editable-field
+					   :size 15))
+	       (setq eudc-form-widget-list (cons (cons (car field) widget)
+						 eudc-form-widget-list))))
+	    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 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 (essentially the hotlist) to `eudc-options-file'."
+  (interactive)
+  (save-excursion
+    (set-buffer (find-file-noselect eudc-options-file t))
+    ;; delete the previous setq
+    (let ((standard-output (current-buffer))
+	  provide-p
+	  setq-p)
+      (catch 'found
+	(while t
+	  (let ((sexp (condition-case nil
+			  (read (current-buffer))
+			(end-of-file (throw 'found nil)))))
+	    (if (listp sexp)
+		(progn
+		  (if (and (eq (car sexp)  'setq)
+			   (eq (eudc-cadr sexp) 'eudc-server-hotlist))
+		      (progn 
+			(delete-region (save-excursion
+					 (backward-sexp)
+					 (point))
+				       (point))
+			(setq setq-p t)))
+		  (if (and (eq (car sexp)  'provide)
+			   (equal (eudc-cadr sexp) '(quote eudc-options-file)))
+		      (setq provide-p t))
+		  (if (and provide-p
+			   setq-p)
+		      (throw 'found t)))))))
+      (if (eq (point-min) (point-max))
+	  (princ ";; This file was automatically generated by eudc.el\n\n"))
+      (if (not (bolp))
+	  (princ "\n"))
+      (princ "(setq eudc-server-hotlist '")
+      (prin1 eudc-server-hotlist)
+      (princ ")\n")
+      (if (not provide-p)
+	  (princ "(provide 'eudc-options-file)\n"))
+      (save-buffer)))
+  )
+
+(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))))
+
+(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)))
+
+(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)
+
+(defvar 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-tail-menu 
+  `(["---" nil nil]
+    ["Query Directory Server" eudc-query-form t]
+    ["Expand Inline" 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))]
+    ["---" 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" (cdr (custom-menu-create 'eudc)))))
+
+(defconst eudc-server-menu 
+  '(["---" eudc-bookmark-server t]
+    ["Bookmark Current Server" eudc-bookmark-current-server t]
+    ["New Server" eudc-set-server t]))
+
+
+(defun eudc-menu ()
+  (let (command)
+    (append '("Directory")
+	    (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 t))))
+			     eudc-server-hotlist)
+		     eudc-server-menu))
+	    eudc-tail-menu)))
+
+(defun eudc-install-menu ()
+  (cond 
+   (eudc-xemacs-p
+    (add-submenu '("Tools") (eudc-menu)))
+   (eudc-emacs-p
+    (easy-menu-define eudc-menu-map eudc-mode-map "Directory Client Menu" (eudc-menu))
+    (define-key 
+      global-map
+      [menu-bar tools eudc] 
+      (cons "Directory"
+	    (easy-menu-create-keymaps "Directory" (cdr (eudc-menu))))))
+   ))
+
+;;; Load the options file
+(if (and (and (locate-library eudc-options-file)
+	      (message ""))		; Remove modeline message
+	 (not (featurep 'eudc-options-file)))
+    (load eudc-options-file))
+	 
+
+(eudc-install-menu)
+  
+      
+;;}}}
+
+(provide 'eudc)
+
+;;; eudc.el ends here
+(eudc
+  (standards-version 1.0
+   version VERSION
+   author-version AUTHOR_VERSION
+   date DATE
+   build-date BUILD_DATE
+   maintainer MAINTAINER
+   distribution stable
+   priority low
+   category CATEGORY
+   dump nil
+   description "Emacs Unified Directory Client."
+   filename FILENAME
+   md5sum MD5SUM
+   size SIZE
+   provides (eudc eudc-ldap eudc-ph)
+   requires (REQUIRES)
+   type regular
+))