Commits

Anonymous committed feb66c3

EUDC 1.30

  • Participants
  • Parent commits e1253e8
  • Tags r1-30, sumo-1999-12-09 1
    1. sumo-1999-12-11

Comments (0)

Files changed (9)

+1999-10-17  Oscar Figueiredo  <Oscar.Figueiredo@di.epfl.ch>
+
+	* eudc: EUDC 1.30 is released
+
+	* eudc-bob.el (eudc-bob-pipe-object-to-external-program): Declare
+	`viewer' locally
+
+	* eudcb-ldap.el (eudc-ldap-escape-query-special-chars): New
+	function
+	(eudc-ldap-format-query-as-rfc1558): Use it
+	(eudc-ldap-simple-query-internal): Typo
+
+	* eudc.el (eudc-replace-in-string): New function
+	(eudc-expand-inline): Avoid using `subseq' not defined
+	in Emacs
+
+1999-10-16  Oscar Figueiredo  <Oscar.Figueiredo@di.epfl.ch>
+
+	* eudc.el (eudc-set-server): Take the back end file name change
+	into account
+	(eudc-plist-get):
+	(eudc-lax-plist-get):
+	(eudc-plist-member): New functions
+	(eudc-variable-protocol-value):
+	(eudc-variable-server-value): 
+	(eudc-protocol-set): 
+	(eudc-server-set): 
+	(eudc-variable-default-value): 
+	(eudc-variable-protocol-value): 
+	(eudc-variable-server-value): Use them
+
+	(eudc-format-query): Fixed a bug where query words were reversed
+	when merged to the same attribute name. Reported by
+	<tuomo.tikkanen@nokia.com>
+
+	* eudc-vars.el (eudc-inline-query-format): Docstring change
+
+	* eudc-hotlist.el (eudc-edit-hotlist): Do not assume server names
+	are less than 30 characters. Bug reported by
+	<sfarrell@almaden.ibm.com>
+
+	* eudc: Renamed `eudc-custom-vars.el' to `eudc-vars.el'.  Renamed
+	the back end files from `eudc-bck-*' `eudcb-*' per RMS's request
+
+1999-08-14  Oscar Figueiredo  <Oscar.Figueiredo@di.epfl.ch>
+
+	* eudc.el (eudc-display-records): Do not attempt to move point to
+	first record when there's none to display
+
 1999-07-21  Oscar Figueiredo  <Oscar.Figueiredo@di.epfl.ch>
 
 	* eudc: EUDC 1.29 is released
 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 # Boston, MA 02111-1307, USA.
 
-VERSION = 1.29
-AUTHOR_VERSION = 1.29
+VERSION = 1.30
+AUTHOR_VERSION = 1.30
 MAINTAINER = Oscar Figueiredo <oscar@xemacs.org>
 PACKAGE = eudc
 PKG_TYPE = regular
 CATEGORY = comm
 
 ELCS =  eudc.elc eudc-hotlist.elc eudc-export.elc eudc-bob.elc \
-	eudc-bck-ph.elc eudc-bck-ldap.elc eudc-bck-bbdb.elc \
-	eudc-custom-vars.elc
+	eudcb-ph.elc eudcb-ldap.elc eudcb-bbdb.elc \
+	eudc-vars.elc
 
 INFO_FILES = $(PACKAGE).info*
 TEXI_FILES = $(PACKAGE).texi
 
 
 
+* Release 1.30
+  ------------
+
+** Bugfix release, no new features
+
+
 * Release 1.29
   ------------
 
   (interactive)
   (let ((data (eudc-bob-get-overlay-prop 'object-data))
 	(buffer (generate-new-buffer "*eudc-tmp*"))
-	program)
+	program
+	viewer)
     (condition-case nil
 	(save-excursion
 	  (if (fboundp 'set-buffer-file-coding-system)

File eudc-export.el

 
 (require 'eudc)
 
-(require 'bbdb)
-(require 'bbdb-com)
+(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.
 	   (eudc-create-bbdb-record record t)))
     (message "%d records imported into BBDB" nbrec)))
 
-;;;### autoload
+;;;###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."
 	(error "Point is not over a record")
       (eudc-create-bbdb-record record))))
 
-;;;### autoload
+;;;###autoload
 (defun eudc-try-bbdb-insert ()
   "Call `eudc-insert-record-at-point-into-bbdb' if on a record."
   (interactive)

File eudc-hotlist.el

 (defun eudc-edit-hotlist ()
   "Edit the hotlist of directory servers in a specialized buffer"
   (interactive)
-  (switch-to-buffer (get-buffer-create "*EUDC Servers*"))
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  (insert "              EUDC Servers\n"
-	  "              ============\n"
-	  "\n"
-	  "Server                        Protocol\n"
-	  "------                        --------\n"
-	  "\n")
-  (setq eudc-hotlist-list-beginning (point))
-  (mapcar '(lambda (entry)
+  (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 30)
+	     (indent-to proto-col)
 	     (insert (symbol-name (cdr entry)) "\n"))
 	  eudc-server-hotlist)
-  (eudc-hotlist-mode))
+  (eudc-hotlist-mode)))
 
 (defun eudc-hotlist-add-server ()
   "Add a new server to the list after current one"
 ;; 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. 
-;;    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.
+;;    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:
-;;    See the corresponding info file
+;;    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:
 
 
 (autoload 'custom-menu-create "cus-edit")
 
-(require 'eudc-custom-vars)
+(require 'eudc-vars)
 
 
 
 (defun eudc-cdaar (obj)
   (cdr (car (car obj))))
 
-(if (not (fboundp 'plist-member))
-    (progn
-      (defun plist-member (plist prop)
-	(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))))
+(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))
 
-(if (not (fboundp 'lax-plist-get))
-    (defun lax-plist-get (plist prop &optional default)
-      (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)))
+;; 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.
+
+LAX-PLIST is a lax property list, which is a list of the form (PROP1
+VALUE1 PROP2 VALUE2...), where comparions between properties is done
+using `equal' instead of `eq'.  This function returns the value
+corresponding to the given 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)
 		  (cons (substring string start) parts)
 		parts)))))
 
-(if eudc-xemacs-p
-    (defalias 'eudc-plist-get 'plist-get)
-  (defun eudc-plist-get (plist prop &optional default)
-    (if (plist-member plist prop)
-	(plist-get plist prop)
-      default)))
+(defun eudc-replace-in-string (str regexp newtext)
+  "Replace all matches in STR for REGEXP with NEWTEXT string,
+ and returns 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))))
 
 ;;}}} 
 
 
 (defun eudc-server-local-variable-p (var)
   "Return non-nil if variable has server local bindings"
-  (plist-member (get var 'eudc-locals) 'server))
+  (eudc-plist-member (get var 'eudc-locals) 'server))
 
 (defun eudc-protocol-local-variable-p (var)
   "Return non-nil if variable has protocol local bindings"
-  (plist-member (get var 'eudc-locals) 'protocol))
+  (eudc-plist-member (get var 'eudc-locals) 'protocol))
 
 (defun eudc-default-set (var val)
   "Set the EUDC default value of VAR to VAL.
 	 protocol-locals)
     (if (not (and  (boundp var)
 		   eudc-locals
-		   (plist-member eudc-locals 'protocol)))
+		   (eudc-plist-member eudc-locals 'protocol)))
 	'unbound
       (setq protocol-locals (eudc-plist-get eudc-locals 'protocol))
-      (lax-plist-get protocol-locals 
-		     (or protocol
-			 eudc-protocol) 'unbound))))
+      (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.
 	 server-locals)
     (if (not (and (boundp var)
 		  eudc-locals
-		  (plist-member eudc-locals 'server)))
+		  (eudc-plist-member eudc-locals 'server)))
 	'unbound
       (setq server-locals (eudc-plist-get eudc-locals 'server))
-      (lax-plist-get server-locals 
-		     (or server
-			 eudc-server) 'unbound))))
+      (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.
 	eudc-insertion-marker nil))
 
 (defun eudc-query (query &optional return-attributes no-translation)
-   "Query the directory server with QUERY.
+   "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 
 		   "Quit")
     (eudc-mode)
     (widget-setup)
-    (goto-char first-record)))
+    (if first-record
+	(goto-char first-record))))
 
 (defun eudc-process-form ()
   "Process the query form in current buffer and display the results."
 					     query-alist)))))
 	      eudc-form-widget-list)
       (kill-buffer (current-buffer))
-      (eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names)
-      )))
+      (eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names))))
          
            
 
 						 eudc-known-protocols)))))
   (unless (or (member protocol
 		      eudc-supported-protocols)
-	      (load (concat "eudc-bck-" (symbol-name protocol)) t))
+	      (load (concat "eudcb-" (symbol-name protocol)) t))
     (error "Unsupported protocol: %s" protocol))
   (run-hooks 'eudc-switch-from-server-hook)
   (setq eudc-protocol protocol)
 		  val (eudc-cdar query-alist)
 		  cell (assq key query))
 	    (if cell
-		(setcdr cell (concat val " " (cdr 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
-	  (car words)
-	(list (cons 'name (car words)))))))
+	  (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.
 					'move)
 		    (goto-char (match-end 0)))
 		(point)))
-	 (query-words (split-string (buffer-substring beg end)"[ \t]+"))
+	 (query-words (split-string (buffer-substring beg end) "[ \t]+"))
 	 query-formats
 	 response
 	 response-string
 	   (t
 	    (error "Wrong value for `eudc-inline-expansion-servers': %S"
 		   eudc-inline-expansion-servers))))
-    (if eudc-max-servers-to-query
-	(setq servers (subseq servers 0 (min eudc-max-servers-to-query
-					     (length 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
 Display a button for the JPEG @var{data}.
 @end defun
 
-Right-clicking on a binary value button pops-up a contextual menu with
+Right-clicking on a binary value button pops up a contextual menu with
 options to process the value.  Among these are saving the attribute
 value to a file or sending it to an external viewer command.  External
 viewers should expect the value on their standard input and should
 consisting of a first name followed by a surname.  If the query consists 
 of more than two words, then the first one is considered as the first
 name and the remaining words are all considered as surname constituents.
+
+@var{format}s are in fact not limited to EUDC attribute names, you can
+use server or protocol specific names in them.  It may be safer if you
+do so, to set the variable @code{eudc-inline-query-format} in a protocol
+or server local fashion (see @pxref{Server/Protocol Locals}).
+
+For instance you could use the following to match up to three words
+against the @code{cn} attribute of LDAP servers:
+@lisp
+(eudc-protocol-set 'eudc-inline-query-format
+                   '((cn)
+                     (cn cn)
+                     (cn cn cn))
+                   'ldap)
+@end lisp
 @end defvar
 
 @defvar eudc-inline-expansion-format
 The first match is considered as being the only one, the others are
 discarded.
 @item select
-A selection buffer pops-up where you can choose a particular match. This 
+A selection buffer pops up where you can choose a particular match. This 
 is the default value of the variable.
 @item all
 The expansion uses all records successively
 cannot update an existing BBDB record and will signal an error if you
 try to insert a record matching an existing one.
 
-It is also to export to BBDB the whole batch of records contained in the
-directory query result with the command
+It is also possible to export to BBDB the whole batch of records
+contained in the directory query result with the command
 @code{eudc-batch-export-records-to-bbdb}.
 
 Because directory systems may not enforce a strict record format, local

File package-info.in

    filename FILENAME
    md5sum MD5SUM
    size SIZE
-   provides (eudc eudc-ldap eudc-ph eudc-bbdb)
+   provides (eudc eudc-vars eudc-hotlist eudc-export eudc-bob eudcb-ldap eudcb-ph eudcb-bbdb)
    requires (REQUIRES)
    type regular
 ))