1 |
;;; eudc.el --- Emacs Unified Directory Client |
;;; eudc.el --- Emacs Unified Directory Client |
2 |
|
|
3 |
;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. |
;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Oscar Figueiredo <oscar@xemacs.org> |
;; Author: Oscar Figueiredo <oscar@cpe.fr> |
6 |
;; Maintainer: Oscar Figueiredo <oscar@xemacs.org> |
;; Maintainer: Pavel Janík <Pavel@Janik.cz> |
7 |
;; Keywords: comm |
;; Keywords: comm |
8 |
|
|
9 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
74 |
|
|
75 |
(defvar eudc-form-widget-list nil) |
(defvar eudc-form-widget-list nil) |
76 |
(defvar eudc-mode-map nil) |
(defvar eudc-mode-map nil) |
|
;; Used by the selection insertion mechanism |
|
|
(defvar eudc-pre-select-window-configuration nil) |
|
|
(defvar eudc-insertion-marker nil) |
|
77 |
|
|
78 |
;; List of known servers |
;; List of known servers |
79 |
;; Alist of (SERVER . PROTOCOL) |
;; Alist of (SERVER . PROTOCOL) |
372 |
list)) |
list)) |
373 |
list)) |
list)) |
374 |
|
|
375 |
(defun eudc-select (choices) |
(defun eudc-select (choices beg end) |
376 |
"Choose one from CHOICES using a completion buffer." |
"Choose one from CHOICES using a completion. |
377 |
(setq eudc-pre-select-window-configuration (current-window-configuration)) |
BEG and END delimit the text which is to be replaced." |
378 |
(setq eudc-insertion-marker (point-marker)) |
(let ((replacement)) |
379 |
(with-output-to-temp-buffer "*EUDC Completions*" |
(setq replacement |
380 |
(apply 'display-completion-list |
(completing-read "Multiple matches found; choose one:" |
381 |
choices |
(mapcar 'list choices))) |
382 |
(if eudc-xemacs-p |
(delete-region beg end) |
383 |
'(:activate-callback eudc-insert-selected))))) |
(insert replacement))) |
|
|
|
|
(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)) |
|
384 |
|
|
385 |
(defun eudc-query (query &optional return-attributes no-translation) |
(defun eudc-query (query &optional return-attributes no-translation) |
386 |
"Query the current directory server with QUERY. |
"Query the current directory server with QUERY. |
810 |
individual inline query words with directory attribute names. |
individual inline query words with directory attribute names. |
811 |
After querying the server for the given string, the expansion specified by |
After querying the server for the given string, the expansion specified by |
812 |
`eudc-inline-expansion-format' is inserted in the buffer at point. |
`eudc-inline-expansion-format' is inserted in the buffer at point. |
813 |
If REPLACE is non nil, then this expansion replaces the name in the buffer. |
If REPLACE is non-nil, then this expansion replaces the name in the buffer. |
814 |
`eudc-expansion-overwrites-query' being non nil inverts the meaning of REPLACE. |
`eudc-expansion-overwrites-query' being non-nil inverts the meaning of REPLACE. |
815 |
Multiple servers can be tried with the same query until one finds a match, |
Multiple servers can be tried with the same query until one finds a match, |
816 |
see `eudc-inline-expansion-servers'" |
see `eudc-inline-expansion-servers'" |
817 |
(interactive) |
(interactive) |
909 |
(if (or |
(if (or |
910 |
(and replace (not eudc-expansion-overwrites-query)) |
(and replace (not eudc-expansion-overwrites-query)) |
911 |
(and (not replace) eudc-expansion-overwrites-query)) |
(and (not replace) eudc-expansion-overwrites-query)) |
912 |
(delete-region beg end)) |
(kill-ring-save beg end)) |
913 |
(cond |
(cond |
914 |
((or (= (length response-strings) 1) |
((or (= (length response-strings) 1) |
915 |
(null eudc-multiple-match-handling-method) |
(null eudc-multiple-match-handling-method) |
916 |
(eq eudc-multiple-match-handling-method 'first)) |
(eq eudc-multiple-match-handling-method 'first)) |
917 |
|
(delete-region beg end) |
918 |
(insert (car response-strings))) |
(insert (car response-strings))) |
919 |
((eq eudc-multiple-match-handling-method 'select) |
((eq eudc-multiple-match-handling-method 'select) |
920 |
(eudc-select response-strings)) |
(eudc-select response-strings beg end)) |
921 |
((eq eudc-multiple-match-handling-method 'all) |
((eq eudc-multiple-match-handling-method 'all) |
922 |
(insert (mapconcat 'identity response-strings ", "))) |
(insert (mapconcat 'identity response-strings ", "))) |
923 |
((eq eudc-multiple-match-handling-method 'abort) |
((eq eudc-multiple-match-handling-method 'abort) |
924 |
(error "There is more than one match for the query")) |
(error "There is more than one match for the query")))) |
|
)) |
|
925 |
(or (and (equal eudc-server eudc-former-server) |
(or (and (equal eudc-server eudc-former-server) |
926 |
(equal eudc-protocol eudc-former-protocol)) |
(equal eudc-protocol eudc-former-protocol)) |
927 |
(eudc-set-server eudc-former-server eudc-former-protocol t))) |
(eudc-set-server eudc-former-server eudc-former-protocol t))) |
1101 |
(goto-char pt) |
(goto-char pt) |
1102 |
(error "No more records before point"))))) |
(error "No more records before point"))))) |
1103 |
|
|
|
|
|
1104 |
;;}}} |
;;}}} |
1105 |
|
|
1106 |
;;{{{ Menus an keymaps |
;;{{{ Menus an keymaps |