Mercurial > emacs
annotate lisp/net/eudc.el @ 105593:1987d1800365
(vc-git-dir-extra-headers): Set the branch name
correctly in the detached head case.
(vc-git-print-log): Remove unused binding.
author | Dan Nicolaescu <dann@ics.uci.edu> |
---|---|
date | Wed, 14 Oct 2009 06:28:00 +0000 |
parents | bd2966850aac |
children | 6b8dce5c4461 |
rev | line source |
---|---|
27313 | 1 ;;; eudc.el --- Emacs Unified Directory Client |
2 | |
105074
45b5d5aae703
Fix typos in condition-case handlers.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, |
45b5d5aae703
Fix typos in condition-case handlers.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
4 ;; 2007, 2008, 2009 Free Software Foundation, Inc. |
27313 | 5 |
42781
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
6 ;; Author: Oscar Figueiredo <oscar@cpe.fr> |
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
7 ;; Maintainer: Pavel Janík <Pavel@Janik.cz> |
42575
24c994803548
(top-level): Revert previous change.
Pavel Janík <Pavel@Janik.cz>
parents:
42569
diff
changeset
|
8 ;; Keywords: comm |
27313 | 9 |
10 ;; This file is part of GNU Emacs. | |
11 | |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
27313 | 13 ;; it under the terms of the GNU General Public License as published by |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
15 ;; (at your option) any later version. |
27313 | 16 |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
27313 | 24 |
25 ;;; Commentary: | |
26 ;; This package provides a common interface to query directory servers using | |
27 ;; different protocols such as LDAP, CCSO PH/QI or BBDB. Queries can be | |
28 ;; made through an interactive form or inline. Inline query strings in | |
29 ;; buffers are expanded with appropriately formatted query results | |
30 ;; (especially used to expand email addresses in message buffers). EUDC | |
31 ;; also interfaces with the BBDB package to let you register query results | |
32 ;; into your own BBDB database. | |
33 | |
34 ;;; Usage: | |
35 ;; EUDC comes with an extensive documentation, please refer to it. | |
36 ;; | |
37 ;; The main entry points of EUDC are: | |
38 ;; `eudc-query-form': Query a directory server from a query form | |
39 ;; `eudc-expand-inline': Query a directory server for the e-mail address | |
47939
5f47d61ffbdc
Fix typo in comment.
Juanma Barranquero <lekktu@gmail.com>
parents:
47566
diff
changeset
|
40 ;; of the name before cursor and insert it in the |
27313 | 41 ;; buffer |
42 ;; `eudc-get-phone': Get a phone number from a directory server | |
43 ;; `eudc-get-email': Get an e-mail address from a directory server | |
44 ;; `eudc-customize': Customize various aspects of EUDC | |
45 | |
46 ;;; Code: | |
47 | |
48 (require 'wid-edit) | |
49 | |
50 (eval-and-compile | |
51 (if (not (fboundp 'make-overlay)) | |
52 (require 'overlay)) | |
53 (if (not (fboundp 'unless)) | |
54 (require 'cl))) | |
55 | |
56 (unless (fboundp 'custom-menu-create) | |
57 (autoload 'custom-menu-create "cus-edit")) | |
58 | |
59 (require 'eudc-vars) | |
60 | |
61 | |
62 | |
63 ;;{{{ Internal cooking | |
64 | |
65 ;;{{{ Internal variables and compatibility tricks | |
66 | |
67 (defvar eudc-form-widget-list nil) | |
93674
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
68 |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
69 (defvar eudc-mode-map |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
70 (let ((map (make-sparse-keymap))) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
71 (define-key map "q" 'kill-this-buffer) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
72 (define-key map "x" 'kill-this-buffer) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
73 (define-key map "f" 'eudc-query-form) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
74 (define-key map "b" 'eudc-try-bbdb-insert) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
75 (define-key map "n" 'eudc-move-to-next-record) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
76 (define-key map "p" 'eudc-move-to-previous-record) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
77 map)) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
78 (set-keymap-parent eudc-mode-map widget-keymap) |
27313 | 79 |
65221
33a4813c9bf4
(mode-popup-menu): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents:
64701
diff
changeset
|
80 (defvar mode-popup-menu) |
33a4813c9bf4
(mode-popup-menu): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents:
64701
diff
changeset
|
81 |
27313 | 82 ;; List of known servers |
83 ;; Alist of (SERVER . PROTOCOL) | |
84 (defvar eudc-server-hotlist nil) | |
85 | |
86 ;; List of variables that have server- or protocol-local bindings | |
87 (defvar eudc-local-vars nil) | |
88 | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
89 ;; Protocol local. Query function |
27313 | 90 (defvar eudc-query-function nil) |
91 | |
92 ;; Protocol local. A function that retrieves a list of valid attribute names | |
93 (defvar eudc-list-attributes-function nil) | |
94 | |
95 ;; Protocol local. A mapping between EUDC attribute names and corresponding | |
96 ;; protocol specific names. The following names are defined by EUDC and may be | |
97 ;; included in that list: `name' , `firstname', `email', `phone' | |
98 (defvar eudc-protocol-attributes-translation-alist nil) | |
99 | |
100 ;; Protocol local. Mapping between protocol attribute names and BBDB field | |
101 ;; names | |
102 (defvar eudc-bbdb-conversion-alist nil) | |
103 | |
104 ;; Protocol/Server local. Hook called upon switching to that server | |
105 (defvar eudc-switch-to-server-hook nil) | |
106 | |
107 ;; Protocol/Server local. Hook called upon switching from that server | |
108 (defvar eudc-switch-from-server-hook nil) | |
109 | |
110 ;; Protocol local. Whether the protocol supports queries with no specified | |
111 ;; attribute name | |
112 (defvar eudc-protocol-has-default-query-attributes nil) | |
113 | |
114 (defun eudc-cadr (obj) | |
115 (car (cdr obj))) | |
116 | |
117 (defun eudc-cdar (obj) | |
118 (cdr (car obj))) | |
119 | |
120 (defun eudc-caar (obj) | |
121 (car (car obj))) | |
122 | |
123 (defun eudc-cdaar (obj) | |
124 (cdr (car (car obj)))) | |
125 | |
126 (defun eudc-plist-member (plist prop) | |
127 "Return t if PROP has a value specified in PLIST." | |
128 (if (not (= 0 (% (length plist) 2))) | |
129 (error "Malformed plist")) | |
130 (catch 'found | |
131 (while plist | |
132 (if (eq prop (car plist)) | |
133 (throw 'found t)) | |
134 (setq plist (cdr (cdr plist)))) | |
135 nil)) | |
136 | |
137 ;; Emacs' plist-get lacks third parameter | |
138 (defun eudc-plist-get (plist prop &optional default) | |
139 "Extract a value from a property list. | |
140 PLIST is a property list, which is a list of the form | |
47497
036e57c15cdc
* xscheme.el (scheme-interaction-mode): Doc fix.
John Paul Wallington <jpw@pobox.com>
parents:
42781
diff
changeset
|
141 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value |
27313 | 142 corresponding to the given PROP, or DEFAULT if PROP is not |
143 one of the properties on the list." | |
144 (if (eudc-plist-member plist prop) | |
145 (plist-get plist prop) | |
146 default)) | |
147 | |
148 (defun eudc-lax-plist-get (plist prop &optional default) | |
149 "Extract a value from a lax property list. | |
150 | |
151 PLIST is a lax property list, which is a list of the form (PROP1 | |
152 VALUE1 PROP2 VALUE2...), where comparisons between properties are done | |
153 using `equal' instead of `eq'. This function returns the value | |
154 corresponding to PROP, or DEFAULT if PROP is not one of the | |
155 properties on the list." | |
156 (if (not (= 0 (% (length plist) 2))) | |
157 (error "Malformed plist")) | |
158 (catch 'found | |
159 (while plist | |
160 (if (equal prop (car plist)) | |
161 (throw 'found (car (cdr plist)))) | |
162 (setq plist (cdr (cdr plist)))) | |
163 default)) | |
164 | |
165 (if (not (fboundp 'split-string)) | |
166 (defun split-string (string &optional pattern) | |
167 "Return a list of substrings of STRING which are separated by PATTERN. | |
168 If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." | |
169 (or pattern | |
170 (setq pattern "[ \f\t\n\r\v]+")) | |
171 (let (parts (start 0)) | |
172 (when (string-match pattern string 0) | |
173 (if (> (match-beginning 0) 0) | |
174 (setq parts (cons (substring string 0 (match-beginning 0)) nil))) | |
175 (setq start (match-end 0)) | |
176 (while (and (string-match pattern string start) | |
177 (> (match-end 0) start)) | |
178 (setq parts (cons (substring string start (match-beginning 0)) parts) | |
179 start (match-end 0)))) | |
180 (nreverse (if (< start (length string)) | |
181 (cons (substring string start) parts) | |
182 parts))))) | |
183 | |
184 (defun eudc-replace-in-string (str regexp newtext) | |
185 "Replace all matches in STR for REGEXP with NEWTEXT. | |
186 Value is the new string." | |
187 (let ((rtn-str "") | |
188 (start 0) | |
189 match prev-start) | |
190 (while (setq match (string-match regexp str start)) | |
191 (setq prev-start start | |
192 start (match-end 0) | |
193 rtn-str | |
194 (concat rtn-str | |
195 (substring str prev-start match) | |
196 newtext))) | |
197 (concat rtn-str (substring str start)))) | |
198 | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
199 ;;}}} |
27313 | 200 |
201 ;;{{{ Server and Protocol Variable Routines | |
202 | |
203 (defun eudc-server-local-variable-p (var) | |
204 "Return non-nil if VAR has server-local bindings." | |
205 (eudc-plist-member (get var 'eudc-locals) 'server)) | |
206 | |
207 (defun eudc-protocol-local-variable-p (var) | |
208 "Return non-nil if VAR has protocol-local bindings." | |
209 (eudc-plist-member (get var 'eudc-locals) 'protocol)) | |
210 | |
211 (defun eudc-default-set (var val) | |
212 "Set the EUDC default value of VAR to VAL. | |
213 The current binding of VAR is not changed." | |
47939
5f47d61ffbdc
Fix typo in comment.
Juanma Barranquero <lekktu@gmail.com>
parents:
47566
diff
changeset
|
214 (put var 'eudc-locals |
27313 | 215 (plist-put (get var 'eudc-locals) 'default val)) |
216 (add-to-list 'eudc-local-vars var)) | |
217 | |
218 (defun eudc-protocol-set (var val &optional protocol) | |
219 "Set the PROTOCOL-local binding of VAR to VAL. | |
220 If omitted PROTOCOL defaults to the current value of `eudc-protocol'. | |
221 The current binding of VAR is changed only if PROTOCOL is omitted." | |
222 (if (eq 'unbound (eudc-variable-default-value var)) | |
223 (eudc-default-set var (symbol-value var))) | |
224 (let* ((eudc-locals (get var 'eudc-locals)) | |
225 (protocol-locals (eudc-plist-get eudc-locals 'protocol))) | |
226 (setq protocol-locals (plist-put protocol-locals (or protocol | |
227 eudc-protocol) val)) | |
47939
5f47d61ffbdc
Fix typo in comment.
Juanma Barranquero <lekktu@gmail.com>
parents:
47566
diff
changeset
|
228 (setq eudc-locals |
27313 | 229 (plist-put eudc-locals 'protocol protocol-locals)) |
230 (put var 'eudc-locals eudc-locals) | |
231 (add-to-list 'eudc-local-vars var) | |
232 (unless protocol | |
233 (eudc-update-variable var)))) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
234 |
27313 | 235 (defun eudc-server-set (var val &optional server) |
236 "Set the SERVER-local binding of VAR to VAL. | |
237 If omitted SERVER defaults to the current value of `eudc-server'. | |
238 The current binding of VAR is changed only if SERVER is omitted." | |
239 (if (eq 'unbound (eudc-variable-default-value var)) | |
240 (eudc-default-set var (symbol-value var))) | |
241 (let* ((eudc-locals (get var 'eudc-locals)) | |
242 (server-locals (eudc-plist-get eudc-locals 'server))) | |
243 (setq server-locals (plist-put server-locals (or server | |
244 eudc-server) val)) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
245 (setq eudc-locals |
27313 | 246 (plist-put eudc-locals 'server server-locals)) |
247 (put var 'eudc-locals eudc-locals) | |
248 (add-to-list 'eudc-local-vars var) | |
249 (unless server | |
250 (eudc-update-variable var)))) | |
251 | |
252 | |
253 (defun eudc-set (var val) | |
254 "Set the most local (server, protocol or default) binding of VAR to VAL. | |
255 The current binding of VAR is also set to VAL" | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
256 (cond |
27313 | 257 ((not (eq 'unbound (eudc-variable-server-value var))) |
258 (eudc-server-set var val)) | |
259 ((not (eq 'unbound (eudc-variable-protocol-value var))) | |
260 (eudc-protocol-set var val)) | |
261 (t | |
262 (eudc-default-set var val))) | |
263 (set var val)) | |
264 | |
265 (defun eudc-variable-default-value (var) | |
266 "Return the default binding of VAR. | |
267 Return `unbound' if VAR has no EUDC default value." | |
268 (let ((eudc-locals (get var 'eudc-locals))) | |
269 (if (and (boundp var) | |
270 eudc-locals) | |
271 (eudc-plist-get eudc-locals 'default 'unbound) | |
272 'unbound))) | |
273 | |
274 (defun eudc-variable-protocol-value (var &optional protocol) | |
275 "Return the value of VAR local to PROTOCOL. | |
276 Return `unbound' if VAR has no value local to PROTOCOL. | |
277 PROTOCOL defaults to `eudc-protocol'" | |
278 (let* ((eudc-locals (get var 'eudc-locals)) | |
279 protocol-locals) | |
280 (if (not (and (boundp var) | |
281 eudc-locals | |
282 (eudc-plist-member eudc-locals 'protocol))) | |
283 'unbound | |
284 (setq protocol-locals (eudc-plist-get eudc-locals 'protocol)) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
285 (eudc-lax-plist-get protocol-locals |
27313 | 286 (or protocol |
287 eudc-protocol) 'unbound)))) | |
288 | |
289 (defun eudc-variable-server-value (var &optional server) | |
290 "Return the value of VAR local to SERVER. | |
291 Return `unbound' if VAR has no value local to SERVER. | |
292 SERVER defaults to `eudc-server'" | |
293 (let* ((eudc-locals (get var 'eudc-locals)) | |
294 server-locals) | |
295 (if (not (and (boundp var) | |
296 eudc-locals | |
297 (eudc-plist-member eudc-locals 'server))) | |
298 'unbound | |
299 (setq server-locals (eudc-plist-get eudc-locals 'server)) | |
47939
5f47d61ffbdc
Fix typo in comment.
Juanma Barranquero <lekktu@gmail.com>
parents:
47566
diff
changeset
|
300 (eudc-lax-plist-get server-locals |
27313 | 301 (or server |
302 eudc-server) 'unbound)))) | |
303 | |
304 (defun eudc-update-variable (var) | |
305 "Set the value of VAR according to its locals. | |
306 If the VAR has a server- or protocol-local value corresponding | |
307 to the current `eudc-server' and `eudc-protocol' then it is set | |
308 accordingly. Otherwise it is set to its EUDC default binding" | |
309 (let (val) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
310 (cond |
27313 | 311 ((not (eq 'unbound (setq val (eudc-variable-server-value var)))) |
312 (set var val)) | |
313 ((not (eq 'unbound (setq val (eudc-variable-protocol-value var)))) | |
314 (set var val)) | |
315 ((not (eq 'unbound (setq val (eudc-variable-default-value var)))) | |
316 (set var val))))) | |
317 | |
318 (defun eudc-update-local-variables () | |
319 "Update all EUDC variables according to their local settings." | |
320 (interactive) | |
321 (mapcar 'eudc-update-variable eudc-local-vars)) | |
322 | |
323 (eudc-default-set 'eudc-query-function nil) | |
324 (eudc-default-set 'eudc-list-attributes-function nil) | |
325 (eudc-default-set 'eudc-protocol-attributes-translation-alist nil) | |
326 (eudc-default-set 'eudc-bbdb-conversion-alist nil) | |
327 (eudc-default-set 'eudc-switch-to-server-hook nil) | |
328 (eudc-default-set 'eudc-switch-from-server-hook nil) | |
329 (eudc-default-set 'eudc-protocol-has-default-query-attributes nil) | |
330 (eudc-default-set 'eudc-attribute-display-method-alist nil) | |
331 | |
332 ;;}}} | |
333 | |
334 | |
335 ;; Add PROTOCOL to the list of supported protocols | |
336 (defun eudc-register-protocol (protocol) | |
337 (unless (memq protocol eudc-supported-protocols) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
338 (setq eudc-supported-protocols |
27313 | 339 (cons protocol eudc-supported-protocols)) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
340 (put 'eudc-protocol 'custom-type |
27313 | 341 `(choice :menu-tag "Protocol" |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
342 ,@(mapcar (lambda (s) |
27313 | 343 (list 'string ':tag (symbol-name s))) |
344 eudc-supported-protocols)))) | |
345 (or (memq protocol eudc-known-protocols) | |
346 (setq eudc-known-protocols | |
347 (cons protocol eudc-known-protocols)))) | |
348 | |
349 | |
350 (defun eudc-translate-query (query) | |
351 "Translate attribute names of QUERY. | |
352 The translation is done according to | |
353 `eudc-protocol-attributes-translation-alist'." | |
354 (if eudc-protocol-attributes-translation-alist | |
355 (mapcar '(lambda (attribute) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
356 (let ((trans (assq (car attribute) |
27313 | 357 (symbol-value eudc-protocol-attributes-translation-alist)))) |
358 (if trans | |
359 (cons (cdr trans) (cdr attribute)) | |
360 attribute))) | |
361 query) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
362 query)) |
27313 | 363 |
364 (defun eudc-translate-attribute-list (list) | |
365 "Translate a list of attribute names LIST. | |
366 The translation is done according to | |
367 `eudc-protocol-attributes-translation-alist'." | |
368 (if eudc-protocol-attributes-translation-alist | |
369 (let (trans) | |
370 (mapcar '(lambda (attribute) | |
371 (setq trans (assq attribute | |
372 (symbol-value eudc-protocol-attributes-translation-alist))) | |
373 (if trans | |
374 (cdr trans) | |
375 attribute)) | |
376 list)) | |
377 list)) | |
378 | |
42781
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
379 (defun eudc-select (choices beg end) |
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
380 "Choose one from CHOICES using a completion. |
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
381 BEG and END delimit the text which is to be replaced." |
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
382 (let ((replacement)) |
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
383 (setq replacement |
66591
5f00d2caf8cf
(eudc-expand-inline): If the `eudc-multiple-match-handling-method' is
John Wiegley <johnw@newartisans.com>
parents:
65221
diff
changeset
|
384 (completing-read "Multiple matches found; choose one: " |
42781
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
385 (mapcar 'list choices))) |
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
386 (delete-region beg end) |
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
387 (insert replacement))) |
27313 | 388 |
389 (defun eudc-query (query &optional return-attributes no-translation) | |
390 "Query the current directory server with QUERY. | |
391 QUERY is a list of cons cells (ATTR . VALUE) where ATTR is an attribute | |
392 name and VALUE the corresponding value. | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
393 If NO-TRANSLATION is non-nil, ATTR is translated according to |
27313 | 394 `eudc-protocol-attributes-translation-alist'. |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
395 RETURN-ATTRIBUTES is a list of attributes to return defaulting to |
27313 | 396 `eudc-default-return-attributes'." |
397 (unless eudc-query-function | |
398 (error "Don't know how to perform the query")) | |
399 (if no-translation | |
400 (funcall eudc-query-function query (or return-attributes | |
401 eudc-default-return-attributes)) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
402 |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
403 (funcall eudc-query-function |
27313 | 404 (eudc-translate-query query) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
405 (cond |
27313 | 406 (return-attributes |
407 (eudc-translate-attribute-list return-attributes)) | |
408 ((listp eudc-default-return-attributes) | |
409 (eudc-translate-attribute-list eudc-default-return-attributes)) | |
410 (t | |
411 eudc-default-return-attributes))))) | |
412 | |
413 (defun eudc-format-attribute-name-for-display (attribute) | |
414 "Format a directory attribute name for display. | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
415 ATTRIBUTE is looked up in `eudc-user-attribute-names-alist' and replaced |
27313 | 416 by the corresponding user name if any. Otherwise it is capitalized and |
417 underscore characters are replaced by spaces." | |
418 (let ((match (assq attribute eudc-user-attribute-names-alist))) | |
419 (if match | |
420 (cdr match) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
421 (capitalize |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
422 (mapconcat 'identity |
27313 | 423 (split-string (symbol-name attribute) "_") |
424 " "))))) | |
425 | |
426 (defun eudc-print-attribute-value (field) | |
427 "Insert the value of the directory FIELD at point. | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
428 The directory attribute name in car of FIELD is looked up in |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
429 `eudc-attribute-display-method-alist' and the corresponding method, |
27313 | 430 if any, is called to print the value in cdr of FIELD." |
431 (let ((match (assoc (downcase (car field)) | |
432 eudc-attribute-display-method-alist)) | |
433 (col (current-column)) | |
434 (val (cdr field))) | |
435 (if match | |
436 (progn | |
437 (eval (list (cdr match) val)) | |
438 (insert "\n")) | |
439 (mapcar | |
440 (function | |
441 (lambda (val-elem) | |
442 (indent-to col) | |
443 (insert val-elem "\n"))) | |
444 (cond | |
445 ((listp val) val) | |
446 ((stringp val) (split-string val "\n")) | |
447 ((null val) '("")) | |
448 (t (list val))))))) | |
449 | |
450 (defun eudc-print-record-field (field column-width) | |
451 "Print the record field FIELD. | |
452 FIELD is a list (ATTR VALUE1 VALUE2 ...) or cons-cell (ATTR . VAL) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
453 COLUMN-WIDTH is the width of the first display column containing the |
27313 | 454 attribute name ATTR." |
455 (let ((field-beg (point))) | |
456 ;; The record field that is passed to this function has already been processed | |
457 ;; by `eudc-format-attribute-name-for-display' so we don't need to call it | |
458 ;; again to display the attribute name | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
459 (insert (format (concat "%" (int-to-string column-width) "s: ") |
27313 | 460 (car field))) |
461 (put-text-property field-beg (point) 'face 'bold) | |
462 (indent-to (+ 2 column-width)) | |
463 (eudc-print-attribute-value field))) | |
464 | |
465 (defun eudc-display-records (records &optional raw-attr-names) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
466 "Display the record list RECORDS in a formatted buffer. |
27313 | 467 If RAW-ATTR-NAMES is non-nil, the raw attribute names are displayed |
468 otherwise they are formatted according to `eudc-user-attribute-names-alist'." | |
57828
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
469 (let (inhibit-read-only |
27313 | 470 precords |
471 (width 0) | |
472 beg | |
473 first-record | |
474 attribute-name) | |
57828
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
475 (with-output-to-temp-buffer "*Directory Query Results*" |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
476 (with-current-buffer standard-output |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
477 (setq buffer-read-only t) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
478 (setq inhibit-read-only t) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
479 (erase-buffer) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
480 (insert "Directory Query Result\n") |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
481 (insert "======================\n\n\n") |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
482 (if (null records) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
483 (insert "No match found.\n" |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
484 (if eudc-strict-return-matches |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
485 "Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n" |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
486 "")) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
487 ;; Replace field names with user names, compute max width |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
488 (setq precords |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
489 (mapcar |
27313 | 490 (function |
57828
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
491 (lambda (record) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
492 (mapcar |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
493 (function |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
494 (lambda (field) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
495 (setq attribute-name |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
496 (if raw-attr-names |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
497 (symbol-name (car field)) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
498 (eudc-format-attribute-name-for-display (car field)))) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
499 (if (> (length attribute-name) width) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
500 (setq width (length attribute-name))) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
501 (cons attribute-name (cdr field)))) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
502 record))) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
503 records)) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
504 ;; Display the records |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
505 (setq first-record (point)) |
85229 | 506 (mapc |
57828
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
507 (function |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
508 (lambda (record) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
509 (setq beg (point)) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
510 ;; Map over the record fields to print the attribute/value pairs |
85229 | 511 (mapc (function |
512 (lambda (field) | |
513 (eudc-print-record-field field width))) | |
514 record) | |
57828
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
515 ;; Store the record internal format in some convenient place |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
516 (overlay-put (make-overlay beg (point)) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
517 'eudc-record |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
518 (car records)) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
519 (setq records (cdr records)) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
520 (insert "\n"))) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
521 precords)) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
522 (insert "\n") |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
523 (widget-create 'push-button |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
524 :notify (lambda (&rest ignore) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
525 (eudc-query-form)) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
526 "New query") |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
527 (widget-insert " ") |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
528 (widget-create 'push-button |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
529 :notify (lambda (&rest ignore) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
530 (kill-this-buffer)) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
531 "Quit") |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
532 (eudc-mode) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
533 (widget-setup) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
534 (if first-record |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
535 (goto-char first-record)))))) |
27313 | 536 |
537 (defun eudc-process-form () | |
538 "Process the query form in current buffer and display the results." | |
539 (let (query-alist | |
540 value) | |
541 (if (not (and (boundp 'eudc-form-widget-list) | |
542 eudc-form-widget-list)) | |
543 (error "Not in a directory query form buffer") | |
85229 | 544 (mapc (function |
545 (lambda (wid-field) | |
546 (setq value (widget-value (cdr wid-field))) | |
547 (if (not (string= value "")) | |
548 (setq query-alist (cons (cons (car wid-field) value) | |
549 query-alist))))) | |
550 eudc-form-widget-list) | |
27313 | 551 (kill-buffer (current-buffer)) |
552 (eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names)))) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
553 |
27313 | 554 |
555 (defun eudc-filter-duplicate-attributes (record) | |
556 "Filter RECORD according to `eudc-duplicate-attribute-handling-method'." | |
557 (let ((rec record) | |
558 unique | |
559 duplicates | |
560 result) | |
561 | |
562 ;; Search for multiple records | |
563 (while (and rec | |
564 (not (listp (eudc-cdar rec)))) | |
565 (setq rec (cdr rec))) | |
566 | |
567 (if (null (eudc-cdar rec)) | |
568 (list record) ; No duplicate attrs in this record | |
85229 | 569 (mapc (function |
570 (lambda (field) | |
571 (if (listp (cdr field)) | |
572 (setq duplicates (cons field duplicates)) | |
573 (setq unique (cons field unique))))) | |
574 record) | |
27313 | 575 (setq result (list unique)) |
576 ;; Map over the record fields that have multiple values | |
85229 | 577 (mapc |
27313 | 578 (function |
579 (lambda (field) | |
580 (let ((method (if (consp eudc-duplicate-attribute-handling-method) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
581 (cdr |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
582 (assq |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
583 (or |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
584 (car |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
585 (rassq |
27313 | 586 (car field) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
587 (symbol-value |
27313 | 588 eudc-protocol-attributes-translation-alist))) |
589 (car field)) | |
590 eudc-duplicate-attribute-handling-method)) | |
591 eudc-duplicate-attribute-handling-method))) | |
592 (cond | |
593 ((or (null method) (eq 'list method)) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
594 (setq result |
27313 | 595 (eudc-add-field-to-records field result))) |
596 ((eq 'first method) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
597 (setq result |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
598 (eudc-add-field-to-records (cons (car field) |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
599 (eudc-cadr field)) |
27313 | 600 result))) |
601 ((eq 'concat method) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
602 (setq result |
27313 | 603 (eudc-add-field-to-records (cons (car field) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
604 (mapconcat |
27313 | 605 'identity |
606 (cdr field) | |
607 "\n")) result))) | |
608 ((eq 'duplicate method) | |
609 (setq result | |
610 (eudc-distribute-field-on-records field result))))))) | |
611 duplicates) | |
612 result))) | |
613 | |
614 (defun eudc-filter-partial-records (records attrs) | |
42575
24c994803548
(top-level): Revert previous change.
Pavel Janík <Pavel@Janik.cz>
parents:
42569
diff
changeset
|
615 "Eliminate records that do not contain all ATTRS from RECORDS." |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
616 (delq nil |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
617 (mapcar |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
618 (function |
27313 | 619 (lambda (rec) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
620 (if (eval (cons 'and |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
621 (mapcar |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
622 (function |
27313 | 623 (lambda (attr) |
624 (consp (assq attr rec)))) | |
625 attrs))) | |
626 rec))) | |
627 records))) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
628 |
27313 | 629 (defun eudc-add-field-to-records (field records) |
630 "Add FIELD to each individual record in RECORDS and return the resulting list." | |
631 (mapcar (function | |
632 (lambda (r) | |
633 (cons field r))) | |
634 records)) | |
635 | |
636 (defun eudc-distribute-field-on-records (field records) | |
637 "Duplicate each individual record in RECORDS according to value of FIELD. | |
638 Each copy is added a new field containing one of the values of FIELD." | |
639 (let (result | |
640 (values (cdr field))) | |
641 ;; Uniquify values first | |
642 (while values | |
643 (setcdr values (delete (car values) (cdr values))) | |
644 (setq values (cdr values))) | |
85229 | 645 (mapc |
27313 | 646 (function |
647 (lambda (value) | |
648 (let ((result-list (copy-sequence records))) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
649 (setq result-list (eudc-add-field-to-records |
27313 | 650 (cons (car field) value) |
651 result-list)) | |
652 (setq result (append result-list result)) | |
653 ))) | |
654 (cdr field)) | |
655 result)) | |
656 | |
657 | |
658 (defun eudc-mode () | |
659 "Major mode used in buffers displaying the results of directory queries. | |
660 There is no sense in calling this command from a buffer other than | |
661 one containing the results of a directory query. | |
662 | |
663 These are the special commands of EUDC mode: | |
664 q -- Kill this buffer. | |
665 f -- Display a form to query the current directory server. | |
666 n -- Move to next record. | |
667 p -- Move to previous record. | |
668 b -- Insert record at point into the BBDB database." | |
669 (interactive) | |
670 (kill-all-local-variables) | |
671 (setq major-mode 'eudc-mode) | |
672 (setq mode-name "EUDC") | |
673 (use-local-map eudc-mode-map) | |
85511
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85229
diff
changeset
|
674 (if (not (featurep 'xemacs)) |
27313 | 675 (easy-menu-define eudc-emacs-menu eudc-mode-map "" (eudc-menu)) |
676 (setq mode-popup-menu (eudc-menu))) | |
62768 | 677 (run-mode-hooks 'eudc-mode-hook)) |
27313 | 678 |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
679 ;;}}} |
27313 | 680 |
681 ;;{{{ High-level interfaces (interactive functions) | |
682 | |
683 (defun eudc-customize () | |
684 "Customize the EUDC package." | |
685 (interactive) | |
686 (customize-group 'eudc)) | |
687 | |
688 ;;;###autoload | |
689 (defun eudc-set-server (server protocol &optional no-save) | |
690 "Set the directory server to SERVER using PROTOCOL. | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
691 Unless NO-SAVE is non-nil, the server is saved as the default |
27313 | 692 server for future sessions." |
693 (interactive (list | |
694 (read-from-minibuffer "Directory Server: ") | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
695 (intern (completing-read "Protocol: " |
27313 | 696 (mapcar '(lambda (elt) |
697 (cons (symbol-name elt) | |
698 elt)) | |
699 eudc-known-protocols))))) | |
700 (unless (or (member protocol | |
701 eudc-supported-protocols) | |
702 (load (concat "eudcb-" (symbol-name protocol)) t)) | |
703 (error "Unsupported protocol: %s" protocol)) | |
704 (run-hooks 'eudc-switch-from-server-hook) | |
705 (setq eudc-protocol protocol) | |
706 (setq eudc-server server) | |
707 (eudc-update-local-variables) | |
708 (run-hooks 'eudc-switch-to-server-hook) | |
105372
bd2966850aac
Use `called-interactively-p' instead of `interactive-p'.
Juanma Barranquero <lekktu@gmail.com>
parents:
105074
diff
changeset
|
709 (if (called-interactively-p 'interactive) |
27313 | 710 (message "Current directory server is now %s (%s)" eudc-server eudc-protocol)) |
711 (if (null no-save) | |
712 (eudc-save-options))) | |
713 | |
714 ;;;###autoload | |
57828
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
715 (defun eudc-get-email (name &optional error) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
716 "Get the email field of NAME from the directory server. |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
717 If ERROR is non-nil, report an error if there is none." |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
718 (interactive "sName: \np") |
27313 | 719 (or eudc-server |
720 (call-interactively 'eudc-set-server)) | |
721 (let ((result (eudc-query (list (cons 'name name)) '(email))) | |
722 email) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
723 (if (null (cdr result)) |
27313 | 724 (setq email (eudc-cdaar result)) |
57828
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
725 (error "Multiple match--use the query form")) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
726 (if error |
27313 | 727 (if email |
728 (message "%s" email) | |
729 (error "No record matching %s" name))) | |
730 email)) | |
731 | |
732 ;;;###autoload | |
57828
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
733 (defun eudc-get-phone (name &optional error) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
734 "Get the phone field of NAME from the directory server. |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
735 If ERROR is non-nil, report an error if there is none." |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
736 (interactive "sName: \np") |
27313 | 737 (or eudc-server |
738 (call-interactively 'eudc-set-server)) | |
739 (let ((result (eudc-query (list (cons 'name name)) '(phone))) | |
740 phone) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
741 (if (null (cdr result)) |
27313 | 742 (setq phone (eudc-cdaar result)) |
57828
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
743 (error "Multiple match--use the query form")) |
7957cb0def89
(eudc-display-records): Use with-output-to-temp-buffer;
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
744 (if error |
27313 | 745 (if phone |
746 (message "%s" phone) | |
747 (error "No record matching %s" name))) | |
748 phone)) | |
749 | |
750 (defun eudc-get-attribute-list () | |
751 "Return a list of valid attributes for the current server. | |
752 When called interactively the list is formatted in a dedicated buffer | |
753 otherwise a list of symbols is returned." | |
754 (interactive) | |
755 (if eudc-list-attributes-function | |
105372
bd2966850aac
Use `called-interactively-p' instead of `interactive-p'.
Juanma Barranquero <lekktu@gmail.com>
parents:
105074
diff
changeset
|
756 (let ((entries (funcall eudc-list-attributes-function |
bd2966850aac
Use `called-interactively-p' instead of `interactive-p'.
Juanma Barranquero <lekktu@gmail.com>
parents:
105074
diff
changeset
|
757 (called-interactively-p 'interactive)))) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
758 (if entries |
105372
bd2966850aac
Use `called-interactively-p' instead of `interactive-p'.
Juanma Barranquero <lekktu@gmail.com>
parents:
105074
diff
changeset
|
759 (if (called-interactively-p 'interactive) |
27313 | 760 (eudc-display-records entries t) |
761 entries))) | |
762 (error "The %s protocol has no support for listing attributes" eudc-protocol))) | |
763 | |
764 (defun eudc-format-query (words format) | |
765 "Use FORMAT to build a EUDC query from WORDS." | |
766 (let (query | |
767 query-alist | |
768 key val cell) | |
769 (if format | |
770 (progn | |
771 (while (and words format) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
772 (setq query-alist (cons (cons (car format) (car words)) |
27313 | 773 query-alist)) |
774 (setq words (cdr words) | |
775 format (cdr format))) | |
776 ;; If the same attribute appears more than once, merge | |
777 ;; the corresponding values | |
778 (setq query-alist (nreverse query-alist)) | |
779 (while query-alist | |
780 (setq key (eudc-caar query-alist) | |
781 val (eudc-cdar query-alist) | |
782 cell (assq key query)) | |
783 (if cell | |
784 (setcdr cell (concat (cdr cell) " " val)) | |
785 (setq query (cons (car query-alist) query))) | |
786 (setq query-alist (cdr query-alist))) | |
787 query) | |
788 (if eudc-protocol-has-default-query-attributes | |
789 (mapconcat 'identity words " ") | |
790 (list (cons 'name (mapconcat 'identity words " "))))))) | |
791 | |
792 (defun eudc-extract-n-word-formats (format-list n) | |
793 "Extract a list of N-long formats from FORMAT-LIST. | |
794 If none try N - 1 and so forth." | |
795 (let (formats) | |
796 (while (and (null formats) | |
797 (> n 0)) | |
47939
5f47d61ffbdc
Fix typo in comment.
Juanma Barranquero <lekktu@gmail.com>
parents:
47566
diff
changeset
|
798 (setq formats |
27313 | 799 (delq nil |
800 (mapcar '(lambda (format) | |
801 (if (= n | |
802 (length format)) | |
803 format | |
804 nil)) | |
805 format-list))) | |
806 (setq n (1- n))) | |
807 formats)) | |
808 | |
809 | |
810 ;;;###autoload | |
811 (defun eudc-expand-inline (&optional replace) | |
812 "Query the directory server, and expand the query string before point. | |
813 The query string consists of the buffer substring from the point back to | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
814 the preceding comma, colon or beginning of line. |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
815 The variable `eudc-inline-query-format' controls how to associate the |
27313 | 816 individual inline query words with directory attribute names. |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
817 After querying the server for the given string, the expansion specified by |
27313 | 818 `eudc-inline-expansion-format' is inserted in the buffer at point. |
42781
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
819 If REPLACE is non-nil, then this expansion replaces the name in the buffer. |
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
820 `eudc-expansion-overwrites-query' being non-nil inverts the meaning of REPLACE. |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
821 Multiple servers can be tried with the same query until one finds a match, |
27313 | 822 see `eudc-inline-expansion-servers'" |
823 (interactive) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
824 (if (memq eudc-inline-expansion-servers |
27313 | 825 '(current-server server-then-hotlist)) |
826 (or eudc-server | |
827 (call-interactively 'eudc-set-server)) | |
828 (or eudc-server-hotlist | |
829 (error "No server in the hotlist"))) | |
830 (let* ((end (point)) | |
831 (beg (save-excursion | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
832 (if (re-search-backward "\\([:,]\\|^\\)[ \t]*" |
27313 | 833 (save-excursion |
834 (beginning-of-line) | |
835 (point)) | |
836 'move) | |
837 (goto-char (match-end 0))) | |
838 (point))) | |
839 (query-words (split-string (buffer-substring beg end) "[ \t]+")) | |
840 query-formats | |
841 response | |
842 response-string | |
843 response-strings | |
844 (eudc-former-server eudc-server) | |
845 (eudc-former-protocol eudc-protocol) | |
846 servers) | |
847 | |
848 ;; Prepare the list of servers to query | |
849 (setq servers (copy-sequence eudc-server-hotlist)) | |
850 (setq servers | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
851 (cond |
27313 | 852 ((eq eudc-inline-expansion-servers 'hotlist) |
853 eudc-server-hotlist) | |
854 ((eq eudc-inline-expansion-servers 'server-then-hotlist) | |
855 (cons (cons eudc-server eudc-protocol) | |
856 (delete (cons eudc-server eudc-protocol) servers))) | |
857 ((eq eudc-inline-expansion-servers 'current-server) | |
858 (list (cons eudc-server eudc-protocol))) | |
859 (t | |
860 (error "Wrong value for `eudc-inline-expansion-servers': %S" | |
861 eudc-inline-expansion-servers)))) | |
862 (if (and eudc-max-servers-to-query | |
863 (> (length servers) eudc-max-servers-to-query)) | |
864 (setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil)) | |
865 | |
866 (condition-case signal | |
867 (progn | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
868 (setq response |
27313 | 869 (catch 'found |
870 ;; Loop on the servers | |
871 (while servers | |
872 (eudc-set-server (eudc-caar servers) (eudc-cdar servers) t) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
873 |
27313 | 874 ;; Determine which formats apply in the query-format list |
875 (setq query-formats | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
876 (or |
27313 | 877 (eudc-extract-n-word-formats eudc-inline-query-format |
878 (length query-words)) | |
879 (if (null eudc-protocol-has-default-query-attributes) | |
880 '(name)))) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
881 |
27313 | 882 ;; Loop on query-formats |
883 (while query-formats | |
884 (setq response | |
885 (eudc-query | |
886 (eudc-format-query query-words (car query-formats)) | |
887 (eudc-translate-attribute-list | |
888 (cdr eudc-inline-expansion-format)))) | |
889 (if response | |
890 (throw 'found response)) | |
891 (setq query-formats (cdr query-formats))) | |
892 (setq servers (cdr servers))) | |
893 ;; No more servers to try... no match found | |
894 nil)) | |
895 | |
896 | |
897 (if (null response) | |
898 (error "No match") | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
899 |
27313 | 900 ;; Process response through eudc-inline-expansion-format |
901 (while response | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
902 (setq response-string (apply 'format |
27313 | 903 (car eudc-inline-expansion-format) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
904 (mapcar (function |
27313 | 905 (lambda (field) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
906 (or (cdr (assq field (car response))) |
27313 | 907 ""))) |
908 (eudc-translate-attribute-list | |
909 (cdr eudc-inline-expansion-format))))) | |
910 (if (> (length response-string) 0) | |
911 (setq response-strings | |
912 (cons response-string response-strings))) | |
913 (setq response (cdr response))) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
914 |
27313 | 915 (if (or |
916 (and replace (not eudc-expansion-overwrites-query)) | |
917 (and (not replace) eudc-expansion-overwrites-query)) | |
42781
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
918 (kill-ring-save beg end)) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
919 (cond |
27313 | 920 ((or (= (length response-strings) 1) |
921 (null eudc-multiple-match-handling-method) | |
922 (eq eudc-multiple-match-handling-method 'first)) | |
42781
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
923 (delete-region beg end) |
27313 | 924 (insert (car response-strings))) |
925 ((eq eudc-multiple-match-handling-method 'select) | |
42781
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
926 (eudc-select response-strings beg end)) |
27313 | 927 ((eq eudc-multiple-match-handling-method 'all) |
66591
5f00d2caf8cf
(eudc-expand-inline): If the `eudc-multiple-match-handling-method' is
John Wiegley <johnw@newartisans.com>
parents:
65221
diff
changeset
|
928 (delete-region beg end) |
27313 | 929 (insert (mapconcat 'identity response-strings ", "))) |
930 ((eq eudc-multiple-match-handling-method 'abort) | |
42781
cd8db5bd4819
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42575
diff
changeset
|
931 (error "There is more than one match for the query")))) |
27313 | 932 (or (and (equal eudc-server eudc-former-server) |
933 (equal eudc-protocol eudc-former-protocol)) | |
934 (eudc-set-server eudc-former-server eudc-former-protocol t))) | |
105074
45b5d5aae703
Fix typos in condition-case handlers.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
935 (error |
27313 | 936 (or (and (equal eudc-server eudc-former-server) |
937 (equal eudc-protocol eudc-former-protocol)) | |
938 (eudc-set-server eudc-former-server eudc-former-protocol t)) | |
939 (signal (car signal) (cdr signal)))))) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
940 |
27313 | 941 ;;;###autoload |
942 (defun eudc-query-form (&optional get-fields-from-server) | |
943 "Display a form to query the directory server. | |
944 If given a non-nil argument GET-FIELDS-FROM-SERVER, the function first | |
945 queries the server for the existing fields and displays a corresponding form." | |
946 (interactive "P") | |
947 (let ((fields (or (and get-fields-from-server | |
948 (eudc-get-attribute-list)) | |
949 eudc-query-form-attributes)) | |
950 (buffer (get-buffer-create "*Directory Query Form*")) | |
951 prompts | |
952 widget | |
953 (width 0) | |
954 inhibit-read-only | |
955 pt) | |
956 (switch-to-buffer buffer) | |
957 (setq inhibit-read-only t) | |
958 (erase-buffer) | |
959 (kill-all-local-variables) | |
960 (make-local-variable 'eudc-form-widget-list) | |
961 (widget-insert "Directory Query Form\n") | |
962 (widget-insert "====================\n\n") | |
963 (widget-insert "Current server is: " (or eudc-server | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
964 (progn |
27313 | 965 (call-interactively 'eudc-set-server) |
966 eudc-server)) | |
967 "\n") | |
968 (widget-insert "Protocol : " (symbol-name eudc-protocol) "\n") | |
969 ;; Build the list of prompts | |
970 (setq prompts (if eudc-use-raw-directory-names | |
971 (mapcar 'symbol-name (eudc-translate-attribute-list fields)) | |
972 (mapcar (function | |
973 (lambda (field) | |
974 (or (and (assq field eudc-user-attribute-names-alist) | |
975 (cdr (assq field eudc-user-attribute-names-alist))) | |
976 (capitalize (symbol-name field))))) | |
977 fields))) | |
978 ;; Loop over prompt strings to find the longest one | |
85229 | 979 (mapc (function |
980 (lambda (prompt) | |
981 (if (> (length prompt) width) | |
982 (setq width (length prompt))))) | |
983 prompts) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
984 ;; Insert the first widget out of the mapcar to leave the cursor |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
985 ;; in the first field |
27313 | 986 (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts))) |
987 (setq pt (point)) | |
988 (setq widget (widget-create 'editable-field :size 15)) | |
989 (setq eudc-form-widget-list (cons (cons (car fields) widget) | |
990 eudc-form-widget-list)) | |
991 (setq fields (cdr fields)) | |
992 (setq prompts (cdr prompts)) | |
85229 | 993 (mapc (function |
994 (lambda (field) | |
995 (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts))) | |
996 (setq widget (widget-create 'editable-field | |
997 :size 15)) | |
998 (setq eudc-form-widget-list (cons (cons field widget) | |
999 eudc-form-widget-list)) | |
1000 (setq prompts (cdr prompts)))) | |
1001 fields) | |
27313 | 1002 (widget-insert "\n\n") |
1003 (widget-create 'push-button | |
1004 :notify (lambda (&rest ignore) | |
1005 (eudc-process-form)) | |
1006 "Query Server") | |
1007 (widget-insert " ") | |
1008 (widget-create 'push-button | |
1009 :notify (lambda (&rest ignore) | |
1010 (eudc-query-form)) | |
1011 "Reset Form") | |
1012 (widget-insert " ") | |
1013 (widget-create 'push-button | |
1014 :notify (lambda (&rest ignore) | |
1015 (kill-this-buffer)) | |
1016 "Quit") | |
1017 (goto-char pt) | |
1018 (use-local-map widget-keymap) | |
1019 (widget-setup)) | |
1020 ) | |
1021 | |
1022 (defun eudc-bookmark-server (server protocol) | |
1023 "Add SERVER using PROTOCOL to the EUDC `servers' hotlist." | |
1024 (interactive "sDirectory server: \nsProtocol: ") | |
1025 (if (member (cons server protocol) eudc-server-hotlist) | |
1026 (error "%s:%s is already in the hotlist" protocol server) | |
1027 (setq eudc-server-hotlist (cons (cons server protocol) eudc-server-hotlist)) | |
1028 (eudc-install-menu) | |
1029 (eudc-save-options))) | |
1030 | |
1031 (defun eudc-bookmark-current-server () | |
1032 "Add current server to the EUDC `servers' hotlist." | |
1033 (interactive) | |
1034 (eudc-bookmark-server eudc-server eudc-protocol)) | |
1035 | |
1036 (defun eudc-save-options () | |
1037 "Save options to `eudc-options-file'." | |
1038 (interactive) | |
1039 (save-excursion | |
1040 (set-buffer (find-file-noselect eudc-options-file t)) | |
1041 (goto-char (point-min)) | |
1042 ;; delete the previous setq | |
1043 (let ((standard-output (current-buffer)) | |
1044 provide-p | |
1045 set-hotlist-p | |
1046 set-server-p) | |
1047 (catch 'found | |
1048 (while t | |
1049 (let ((sexp (condition-case nil | |
1050 (read (current-buffer)) | |
1051 (end-of-file (throw 'found nil))))) | |
1052 (if (listp sexp) | |
1053 (cond | |
1054 ((eq (car sexp) 'eudc-set-server) | |
1055 (delete-region (save-excursion | |
1056 (backward-sexp) | |
1057 (point)) | |
1058 (point)) | |
1059 (setq set-server-p t)) | |
1060 ((and (eq (car sexp) 'setq) | |
1061 (eq (eudc-cadr sexp) 'eudc-server-hotlist)) | |
1062 (delete-region (save-excursion | |
1063 (backward-sexp) | |
1064 (point)) | |
1065 (point)) | |
1066 (setq set-hotlist-p t)) | |
1067 ((and (eq (car sexp) 'provide) | |
1068 (equal (eudc-cadr sexp) '(quote eudc-options-file))) | |
1069 (setq provide-p t))) | |
1070 (if (and provide-p | |
1071 set-hotlist-p | |
1072 set-server-p) | |
1073 (throw 'found t)))))) | |
1074 (if (eq (point-min) (point-max)) | |
1075 (princ ";; This file was automatically generated by eudc.el.\n\n")) | |
1076 (or provide-p | |
1077 (princ "(provide 'eudc-options-file)\n")) | |
1078 (or (bolp) | |
1079 (princ "\n")) | |
1080 (delete-blank-lines) | |
1081 (princ "(eudc-set-server ") | |
1082 (prin1 eudc-server) | |
1083 (princ " '") | |
1084 (prin1 eudc-protocol) | |
1085 (princ " t)\n") | |
1086 (princ "(setq eudc-server-hotlist '") | |
1087 (prin1 eudc-server-hotlist) | |
1088 (princ ")\n") | |
1089 (save-buffer)))) | |
1090 | |
1091 (defun eudc-move-to-next-record () | |
1092 "Move to next record, in a buffer displaying directory query results." | |
1093 (interactive) | |
1094 (if (not (eq major-mode 'eudc-mode)) | |
1095 (error "Not in a EUDC buffer") | |
1096 (let ((pt (next-overlay-change (point)))) | |
1097 (if (< pt (point-max)) | |
1098 (goto-char (1+ pt)) | |
1099 (error "No more records after point"))))) | |
1100 | |
1101 (defun eudc-move-to-previous-record () | |
1102 "Move to previous record, in a buffer displaying directory query results." | |
1103 (interactive) | |
1104 (if (not (eq major-mode 'eudc-mode)) | |
1105 (error "Not in a EUDC buffer") | |
1106 (let ((pt (previous-overlay-change (point)))) | |
1107 (if (> pt (point-min)) | |
1108 (goto-char pt) | |
1109 (error "No more records before point"))))) | |
1110 | |
1111 ;;}}} | |
1112 | |
47939
5f47d61ffbdc
Fix typo in comment.
Juanma Barranquero <lekktu@gmail.com>
parents:
47566
diff
changeset
|
1113 ;;{{{ Menus and keymaps |
27313 | 1114 |
1115 (require 'easymenu) | |
1116 | |
1117 (defconst eudc-custom-generated-menu (cdr (custom-menu-create 'eudc))) | |
1118 | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1119 (defconst eudc-tail-menu |
27313 | 1120 `(["---" nil nil] |
93674
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1121 ["Query with Form" eudc-query-form |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1122 :help "Display a form to query the directory server"] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1123 ["Expand Inline Query" eudc-expand-inline |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1124 :help "Query the directory server, and expand the query string before point"] |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1125 ["Insert Record into BBDB" eudc-insert-record-at-point-into-bbdb |
27313 | 1126 (and (or (featurep 'bbdb) |
1127 (prog1 (locate-library "bbdb") (message ""))) | |
1128 (overlays-at (point)) | |
93674
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1129 (overlay-get (car (overlays-at (point))) 'eudc-record)) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1130 :help "Insert record at point into the BBDB database"] |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1131 ["Insert All Records into BBDB" eudc-batch-export-records-to-bbdb |
27313 | 1132 (and (eq major-mode 'eudc-mode) |
1133 (or (featurep 'bbdb) | |
93674
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1134 (prog1 (locate-library "bbdb") (message "")))) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1135 :help "Insert all the records returned by a directory query into BBDB"] |
27313 | 1136 ["---" nil nil] |
93674
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1137 ["Get Email" eudc-get-email |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1138 :help "Get the email field of NAME from the directory server"] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1139 ["Get Phone" eudc-get-phone |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1140 :help "Get the phone field of name from the directory server"] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1141 ["List Valid Attribute Names" eudc-get-attribute-list |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1142 :help "Return a list of valid attributes for the current server"] |
27313 | 1143 ["---" nil nil] |
1144 ,(cons "Customize" eudc-custom-generated-menu))) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1145 |
27313 | 1146 |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1147 (defconst eudc-server-menu |
27313 | 1148 '(["---" nil nil] |
93674
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1149 ["Bookmark Current Server" eudc-bookmark-current-server |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1150 :help "Add current server to the EUDC `servers' hotlist"] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1151 ["Edit Server List" eudc-edit-hotlist |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1152 :help "Edit the hotlist of directory servers in a specialized buffer"] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1153 ["New Server" eudc-set-server |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1154 :help "Set the directory server to SERVER using PROTOCOL"])) |
27313 | 1155 |
1156 (defun eudc-menu () | |
1157 (let (command) | |
1158 (append '("Directory Search") | |
1159 (list | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1160 (append |
27313 | 1161 '("Server") |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1162 (mapcar |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1163 (function |
27313 | 1164 (lambda (servspec) |
1165 (let* ((server (car servspec)) | |
1166 (protocol (cdr servspec)) | |
1167 (proto-name (symbol-name protocol))) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1168 (setq command (intern (concat "eudc-set-server-" |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1169 server |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1170 "-" |
27313 | 1171 proto-name))) |
1172 (if (not (fboundp command)) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1173 (fset command |
27313 | 1174 `(lambda () |
1175 (interactive) | |
1176 (eudc-set-server ,server (quote ,protocol)) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1177 (message "Selected directory server is now %s (%s)" |
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1178 ,server |
27313 | 1179 ,proto-name)))) |
1180 (vector (format "%s (%s)" server proto-name) | |
1181 command | |
1182 :style 'radio | |
1183 :selected `(equal eudc-server ,server))))) | |
1184 eudc-server-hotlist) | |
1185 eudc-server-menu)) | |
1186 eudc-tail-menu))) | |
1187 | |
1188 (defun eudc-install-menu () | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1189 (cond |
85511
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85229
diff
changeset
|
1190 ((and (featurep 'xemacs) (featurep 'menubar)) |
27313 | 1191 (add-submenu '("Tools") (eudc-menu))) |
85511
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85229
diff
changeset
|
1192 ((not (featurep 'xemacs)) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1193 (cond |
47566
65c4cd99d916
(eudc-install-menu): Use `define-key' and
John Paul Wallington <jpw@pobox.com>
parents:
47497
diff
changeset
|
1194 ((fboundp 'easy-menu-create-menu) |
65c4cd99d916
(eudc-install-menu): Use `define-key' and
John Paul Wallington <jpw@pobox.com>
parents:
47497
diff
changeset
|
1195 (define-key |
65c4cd99d916
(eudc-install-menu): Use `define-key' and
John Paul Wallington <jpw@pobox.com>
parents:
47497
diff
changeset
|
1196 global-map |
65c4cd99d916
(eudc-install-menu): Use `define-key' and
John Paul Wallington <jpw@pobox.com>
parents:
47497
diff
changeset
|
1197 [menu-bar tools directory-search] |
65c4cd99d916
(eudc-install-menu): Use `define-key' and
John Paul Wallington <jpw@pobox.com>
parents:
47497
diff
changeset
|
1198 (cons "Directory Search" |
65c4cd99d916
(eudc-install-menu): Use `define-key' and
John Paul Wallington <jpw@pobox.com>
parents:
47497
diff
changeset
|
1199 (easy-menu-create-menu "Directory Search" (cdr (eudc-menu)))))) |
27313 | 1200 ((fboundp 'easy-menu-add-item) |
1201 (let ((menu (eudc-menu))) | |
1202 (easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu) | |
1203 (cdr menu))))) | |
1204 ((fboundp 'easy-menu-create-keymaps) | |
1205 (easy-menu-define eudc-menu-map eudc-mode-map "Directory Client Menu" (eudc-menu)) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1206 (define-key |
27313 | 1207 global-map |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1208 [menu-bar tools eudc] |
27313 | 1209 (cons "Directory Search" |
1210 (easy-menu-create-keymaps "Directory Search" (cdr (eudc-menu)))))) | |
1211 (t | |
1212 (error "Unknown version of easymenu")))) | |
1213 )) | |
1214 | |
1215 | |
1216 ;;; Load time initializations : | |
1217 | |
1218 ;;; Load the options file | |
1219 (if (and (not noninteractive) | |
1220 (and (locate-library eudc-options-file) | |
59681
c77eb52a1cca
(top level): Call (message "") via progn, so that
Eli Zaretskii <eliz@gnu.org>
parents:
57828
diff
changeset
|
1221 (progn (message "") t)) ; Remove modeline message |
27313 | 1222 (not (featurep 'eudc-options-file))) |
1223 (load eudc-options-file)) | |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1224 |
27313 | 1225 ;;; Install the full menu |
1226 (unless (featurep 'infodock) | |
1227 (eudc-install-menu)) | |
1228 | |
1229 | |
1230 ;;; The following installs a short menu for EUDC at XEmacs startup. | |
1231 | |
1232 ;;;###autoload | |
1233 (defun eudc-load-eudc () | |
1234 "Load the Emacs Unified Directory Client. | |
1235 This does nothing except loading eudc by autoload side-effect." | |
1236 (interactive) | |
1237 nil) | |
1238 | |
27324
e33d394fe874
(toplevel): Define EUDC menu for Emacs.
Gerd Moellmann <gerd@gnu.org>
parents:
27320
diff
changeset
|
1239 ;;;###autoload |
93674
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1240 (cond |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1241 ((not (featurep 'xemacs)) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1242 (defvar eudc-tools-menu |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1243 (let ((map (make-sparse-keymap "Directory Search"))) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1244 (define-key map [phone] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1245 '(menu-item "Get Phone" eudc-get-phone |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1246 :help "Get the phone field of name from the directory server")) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1247 (define-key map [email] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1248 '(menu-item "Get Email" eudc-get-email |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1249 :help "Get the email field of NAME from the directory server")) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1250 (define-key map [separator-eudc-email] '("--")) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1251 (define-key map [expand-inline] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1252 '(menu-item "Expand Inline Query" eudc-expand-inline |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1253 :help "Query the directory server, and expand the query string before point")) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1254 (define-key map [query] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1255 '(menu-item "Query with Form" eudc-query-form |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1256 :help "Display a form to query the directory server")) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1257 (define-key map [separator-eudc-query] '("--")) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1258 (define-key map [new] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1259 '(menu-item "New Server" eudc-set-server |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1260 :help "Set the directory server to SERVER using PROTOCOL")) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1261 (define-key map [load] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1262 '(menu-item "Load Hotlist of Servers" eudc-load-eudc |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1263 :help "Load the Emacs Unified Directory Client")) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1264 map)) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1265 (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1266 (t |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1267 (let ((menu '("Directory Search" |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1268 ["Load Hotlist of Servers" eudc-load-eudc t] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1269 ["New Server" eudc-set-server t] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1270 ["---" nil nil] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1271 ["Query with Form" eudc-query-form t] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1272 ["Expand Inline Query" eudc-expand-inline t] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1273 ["---" nil nil] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1274 ["Get Email" eudc-get-email t] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1275 ["Get Phone" eudc-get-phone t]))) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1276 (if (not (featurep 'eudc-autoloads)) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1277 (if (featurep 'xemacs) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1278 (if (and (featurep 'menubar) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1279 (not (featurep 'infodock))) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1280 (add-submenu '("Tools") menu)) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1281 (require 'easymenu) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1282 (cond |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1283 ((fboundp 'easy-menu-add-item) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1284 (easy-menu-add-item nil '("tools") |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1285 (easy-menu-create-menu (car menu) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1286 (cdr menu)))) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1287 ((fboundp 'easy-menu-create-keymaps) |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1288 (define-key |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1289 global-map |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1290 [menu-bar tools eudc] |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1291 (cons "Directory Search" |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1292 (easy-menu-create-keymaps "Directory Search" |
44fab469d68d
* outline.el (outline-mode-menu-bar-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
1293 (cdr menu))))))))))) |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1294 |
27324
e33d394fe874
(toplevel): Define EUDC menu for Emacs.
Gerd Moellmann <gerd@gnu.org>
parents:
27320
diff
changeset
|
1295 ;;}}} |
42569
df3f717a3933
(top-level): Use eudc-xemacs-p instead of string-match on emacs-version
Pavel Janík <Pavel@Janik.cz>
parents:
27324
diff
changeset
|
1296 |
27313 | 1297 (provide 'eudc) |
1298 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93674
diff
changeset
|
1299 ;; arch-tag: e18872b6-db83-400b-869d-be54e9a4160c |
27313 | 1300 ;;; eudc.el ends here |