diff --git a/ChangeLog b/ChangeLog index 40d66d22f10fdec3d3ab8738086c8c15cd5bb66b_Q2hhbmdlTG9n..9d2c65802add8f660e79f6d9127831ef88965128_Q2hhbmdlTG9n 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,31 @@ +1998-03-15 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> + + * eudc: Released 1.0/pkg1.1 + + * eudc-ldap.el: + (eudc-ldap-clear-inline-query-format-on-exit): New var + (eudc-ldap-set-inline-query-format-maybe): New defun + (eudc-ldap-protocol-switch-init): New defun + (eudc-ldap-protocol-switch-exit): New defun + + * eudc.el: (eudc-protocol-switch-init-function): New var + (eudc-protocol-switch-exit-function): New var + (eudc-switch-to-protocol): Reswitch to previous protocol in case + of error. Run protocol specific init and exit functions. + (eudc-expand-inline): Use eudc-inline-query-format if if query + string is a single word. + Discard words in query string if there is no corresponding + attribute in eudc-inline-query-format + New selection mechanism for multiple matches + +1998-03-01 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> + + * eudc.el: (eudc-use-raw-directory-names): New var + (eudc-query-form): Take previous var into account + (eudc-tail-menu): Changed some menu entry names + (eudc-load-eudc): New function + Attach a basic menu for EUDC at autoload time. + 1998-02-25 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> * eudc: Released 0.2/pkg0.9 diff --git a/Makefile b/Makefile index 40d66d22f10fdec3d3ab8738086c8c15cd5bb66b_TWFrZWZpbGU=..9d2c65802add8f660e79f6d9127831ef88965128_TWFrZWZpbGU= 100644 --- a/Makefile +++ b/Makefile @@ -17,8 +17,8 @@ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. -VERSION = 1.0 -AUTHOR_VERSION = 0.2 +VERSION = 1.1 +AUTHOR_VERSION = 1.0 MAINTAINER = Oscar Figueiredo <Oscar.Figueiredo@epfl.ch> PACKAGE = eudc PKG_TYPE = regular diff --git a/eudc-ldap.el b/eudc-ldap.el index 40d66d22f10fdec3d3ab8738086c8c15cd5bb66b_ZXVkYy1sZGFwLmVs..9d2c65802add8f660e79f6d9127831ef88965128_ZXVkYy1sZGFwLmVs 100644 --- a/eudc-ldap.el +++ b/eudc-ldap.el @@ -5,7 +5,7 @@ ;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch> ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch> ;; Created: Feb 1998 -;; Version: 1.3 +;; Version: $Revision$ ;; Keywords: help ;; This file is part of XEmacs @@ -78,6 +78,10 @@ ;;{{{ Internal cooking +;; Whether eudc-inline-query-format should be cleared on switching protocols +;; from LDAP +(defvar eudc-ldap-clear-inline-query-format-on-exit nil) + (defvar eudc-ldap-attributes-translation-alist '((name . sn) (email . mail) @@ -87,7 +91,9 @@ (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)) + (eudc-bbdb-conversion-alist . eudc-ldap-bbdb-conversion-alist) + (eudc-protocol-switch-init-function . eudc-ldap-protocol-switch-init) + (eudc-protocol-switch-exit-function . eudc-ldap-protocol-switch-exit)) "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 @@ -125,6 +131,20 @@ (format "(%s=%s)" (car item) (cdr item))) query)))) +;; Set eudc-inline-query-format for LDAP since LDAP does not +;; have default query attributes and hence won't accept plain +;; string queries without an associated attribute name +(defun eudc-ldap-set-inline-query-format-maybe () + (when (null eudc-inline-query-format) + (setq eudc-inline-query-format '(name)) + (setq eudc-ldap-clear-inline-query-format-on-exit t))) + +(defun eudc-ldap-protocol-switch-init () + (eudc-ldap-set-inline-query-format-maybe)) + +(defun eudc-ldap-protocol-switch-exit () + (if eudc-ldap-clear-inline-query-format-on-exit + (setq eudc-inline-query-format nil))) ;;}}} diff --git a/eudc-ph.el b/eudc-ph.el index 40d66d22f10fdec3d3ab8738086c8c15cd5bb66b_ZXVkYy1waC5lbA==..9d2c65802add8f660e79f6d9127831ef88965128_ZXVkYy1waC5lbA== 100644 --- a/eudc-ph.el +++ b/eudc-ph.el @@ -5,7 +5,7 @@ ;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch> ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch> ;; Created: Feb 1998 -;; Version: 1.4 +;; Version: $Revision$ ;; Keywords: help ;; This file is part of XEmacs diff --git a/eudc.el b/eudc.el index 40d66d22f10fdec3d3ab8738086c8c15cd5bb66b_ZXVkYy5lbA==..9d2c65802add8f660e79f6d9127831ef88965128_ZXVkYy5lbA== 100644 --- a/eudc.el +++ b/eudc.el @@ -5,7 +5,7 @@ ;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch> ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch> ;; Created: Feb 1998 -;; Version: 1.5 +;; Version: $Revision$ ;; Keywords: help ;; This file is part of XEmacs @@ -83,7 +83,7 @@ (defcustom eudc-strict-return-matches t - "*If non-nil, entries not containing all requested return attributes are ignored." + "*If non-nil, ignore entries that do not contain all requested return attributes." :type 'boolean :group 'eudc) @@ -200,6 +200,13 @@ (string :tag "User 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-options-file "~/.eudc-options" "*A file where the `servers' hotlist is stored." :type '(file :Tag "File Name:")) @@ -224,6 +231,10 @@ (defvar eudc-form-widget-list 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) @@ -241,9 +252,16 @@ ;; in that list: `name' , `email', `phone' (defvar eudc-protocol-attributes-translation-alist nil) +;; A function called each time EUDC switches to a protocol +(defvar eudc-protocol-switch-init-function nil) + +;; A function called each time EUDC switches from a protocol to +;; another one +(defvar eudc-protocol-switch-exit-function 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) @@ -244,10 +262,12 @@ ;; 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)))) + (eudc-bbdb-conversion-alist . nil) + (eudc-protocol-switch-init-function . nil) + (eudc-protocol-switch-exit-function . nil)))) ;;; Emacs does not provide that one @@ -286,8 +306,4 @@ (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) @@ -293,6 +309,6 @@ (defun eudc-switch-to-protocol (protocol) - "From now on, use PROTOCOL for directory queries" + "Use PROTOCOL for directory queries from now on." (unless (or (member protocol eudc-supported-protocols) (load (concat "eudc-" (symbol-name protocol)) t)) (error "Unsupported protocol: %s" protocol)) @@ -295,21 +311,30 @@ (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)) + (condition-case nil + (let ((locals (assq 'default eudc-protocol-locals))) + (if eudc-protocol-switch-exit-function + (funcall eudc-protocol-switch-exit-function)) + ;; 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) + (if eudc-protocol-switch-init-function + (funcall eudc-protocol-switch-init-function))) + ;; If something bad happens return to the previous protocol + (t + (if eudc-protocol + (eudc-switch-to-protocol eudc-protocol))))) (defun eudc-translate-query (query) "Translate attribute names of QUERY according to `eudc-protocol-attributes-translation-alist'." @@ -324,7 +349,7 @@ query)) (defun eudc-translate-attribute-list (list) - "Translate a list of attribute names ccording to `eudc-protocol-attributes-translation-alist'." + "Translate a list of attribute names according to `eudc-protocol-attributes-translation-alist'." (if eudc-protocol-attributes-translation-alist (let (trans) (mapcar '(lambda (attribute) @@ -336,6 +361,26 @@ 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*" + (display-completion-list + response-strings + :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 directory server with QUERY. QUERY is a list of cons cells (ATTR . VALUE) where @@ -386,7 +431,7 @@ (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))) + (cdr (assq (car field) eudc-user-attribute-names-alist))) (capitalize (mapconcat '(lambda (char) (if (eq char ?_) " " @@ -452,7 +497,7 @@ query-alist))))) eudc-form-widget-list) (kill-buffer (current-buffer)) - (eudc-display-records (eudc-query query-alist)) + (eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names) ))) @@ -704,6 +749,7 @@ (interactive) (customize-group 'eudc)) +;;;###autoload (defun eudc-set-server (server protocol) "Set the directory server to SERVER using PROTOCOL." (interactive "sDirectory Server: \nSProtocol: ") @@ -764,9 +810,9 @@ (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. +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. @@ -792,11 +838,10 @@ key val cell) ;; Prepare the query - (if (or (not query-format) - (not (string-match "[ \t]+" words))) + (if (not query-format) (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))) @@ -797,14 +842,12 @@ (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 + + ;; 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) @@ -812,8 +855,8 @@ 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 query (cons (car query-alist) query))) + (setq query-alist (cdr query-alist)))) (setq response (eudc-query query (cdr eudc-inline-expansion-format))) @@ -843,8 +886,7 @@ (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))) + (eudc-select response-strings)) ((eq eudc-multiple-match-handling-method 'all) (insert (mapconcat 'identity response-strings ", "))) ((eq eudc-multiple-match-handling-method 'abort) @@ -863,7 +905,7 @@ (eudc-get-attribute-list)) eudc-query-form-attributes)) (buffer (get-buffer-create "*Directory Query Form*")) - field-name + prompts widget (width 0) inhibit-read-only @@ -881,16 +923,20 @@ 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)) + ;; 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 @@ -895,5 +941,5 @@ ;; 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)))) + (widget-insert "\n\n" (format (concat "%" width "s: ") (car prompts))) (setq pt (point)) (setq widget (widget-create 'editable-field :size 15)) @@ -898,5 +944,5 @@ (setq pt (point)) (setq widget (widget-create 'editable-field :size 15)) - (setq eudc-form-widget-list (cons (cons (car (car fields)) widget) + (setq eudc-form-widget-list (cons (cons (car fields) widget) eudc-form-widget-list)) (setq fields (cdr fields)) @@ -901,4 +947,5 @@ eudc-form-widget-list)) (setq fields (cdr fields)) + (setq prompts (cdr prompts)) (mapcar (function (lambda (field) @@ -903,5 +950,5 @@ (mapcar (function (lambda (field) - (widget-insert "\n\n" (format (concat "%" width "s: ") (cdr field))) + (widget-insert "\n\n" (format (concat "%" width "s: ") (car prompts))) (setq widget (widget-create 'editable-field :size 15)) @@ -906,7 +953,8 @@ (setq widget (widget-create 'editable-field :size 15)) - (setq eudc-form-widget-list (cons (cons (car field) widget) - eudc-form-widget-list)))) + (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 @@ -1043,8 +1091,8 @@ (defconst eudc-tail-menu `(["---" nil nil] - ["Query Directory Server" eudc-query-form t] - ["Expand Inline" eudc-expand-inline t] + ["Query with Form" eudc-query-form t] + ["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 ""))) @@ -1058,7 +1106,7 @@ ,(cons "Customize" (cdr (custom-menu-create 'eudc))))) (defconst eudc-server-menu - '(["---" eudc-bookmark-server t] + '(["---" nil nil] ["Bookmark Current Server" eudc-bookmark-current-server t] ["New Server" eudc-set-server t])) @@ -1097,7 +1145,10 @@ (easy-menu-create-keymaps "Directory" (cdr (eudc-menu)))))) )) + +;;; Load time initializations : + ;;; Load the options file (if (and (and (locate-library eudc-options-file) (message "")) ; Remove modeline message (not (featurep 'eudc-options-file))) @@ -1100,7 +1151,12 @@ ;;; 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)) - + (load eudc-options-file)) +;;; Install the full menu +(eudc-install-menu) + + + +;;; The following installs a short menu for EUDC at XEmacs startup. @@ -1106,7 +1162,24 @@ -(eudc-install-menu) - - +;;;###autoload +(defun eudc-load-eudc () + "Load the Emacs Unified Directory Client. +This does nothing except loading eudc by autoload side-effect." + (interactive) + nil) + +;;;###autoload +(unless (featurep 'eudc) + (add-submenu '("Tools") + '("Directory" + ["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]))) + ;;}}} (provide 'eudc)