annotate lisp/net/eudc.el @ 43128:d7ccb71bc97c

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