1 ;;; dui.el --- Dictionary user interface
3 ;; Copyright (C) 1998, 2002 Free Software Foundation, Inc.
5 ;; Author: Stephen J. Turnbull <stephen@xemacs.org>
6 ;; Keywords: mule, dictionary
9 ;; This file is part of XEmacs.
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your
14 ;; option) any later version.
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; if not, write to the Free Software Foundation,
23 ;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
27 ;; Some code that provides support for dictionary lookup and manipulations
28 ;; (such as inserting definitions and maintaining a private dictionary).
29 ;; Originally written in support of edict.el, by Per Hammarlund
30 ;; <perham@nada.kth.se>, but since generalized.
36 ;; 1998-03-27 Stephen Turnbull <stephen@xemacs.org>
37 ;; (created): broken out from monolithic edict.el
41 ;;; Dictionary lookup minor mode (dl-mode)
43 ;; User customization variables
46 "Customization group for dl-mode interface to edict.el."
49 ;; #### Customize me later!
50 (defvar dl-mode-prefix '[(control ?c) (?\$)]
51 "*Prefix key sequence for dl-mode command keys.
53 After loading, change the mode's prefix by using dl-mode-set-prefix;
54 setq'ing this variable can't work.")
56 (defcustom dl-mode-line-string " dl"
57 "*String indicating activation of dl minor mode in the modeline.
59 Set to nil to inhibit modeline display."
61 (const :tag "none" nil))
64 ;; A convention for modes; here honored by observance, not breach.
66 (defvar dl-mode-hook nil
67 "*A normal hook called at the end of the dl-mode activation process.
69 If you can think of a use for this, you're more clever than I.")
71 ;; Auxiliary customizations
73 (defcustom dl-conflict-warning "Binding conflict: %s -> %s."
74 "*Format string warning about key sequences with conflicting bindings.
76 Must contain two `%s' descriptors. The first formats the key sequence,
77 the second the description of the existing binding."
81 ;; #### Add code to check that the level is OK?
82 (defcustom dl-warn-conflict-verbosity 3
83 "*Controls verbosity of binding conflict warnings.
85 0 turns off warnings entirely.
86 1 issues a warning for each binding conflict (including sub-keymaps).
87 2 prints a summary message with a count of conflicts (not including
88 sub-keymaps, only keys in those maps that have conflicts).
89 3 adds verbose detail about what is being done.
91 Each positive level performs all actions of lower levels."
95 ;; The basic mode conventions.
97 ;; Mode flag and keymaps
99 (defvar dl-mode nil "Activation flag for dl-mode.")
101 (defvar dl-mode-submap nil
102 "Sub-keymap for dl-mode.
104 All key sequences are prefixed by the sequence defined in dl-mode-map.")
106 (defvar dl-mode-map nil
107 "Keymap for dl-mode. Holds the prefix key for dl-mode functions.
109 Its value will be installed into minor-mode-map-alist. Prefix cannot
110 be altered by setq'ing dl-mode-map. Use dl-mode-set-prefix instead.")
114 ;; The side effect is arguably not a feature :-)
117 (defun dl-mode (&optional arg)
118 "Minor mode for dictionary lookup, with interfaces to dictionary utilities.
120 Null ARG toggles the mode, positive ARG turns the mode on, negative ARG
123 When the mode is already off, (dl-mode -1) has the side effect of checking
124 and reporting any conflicting bindings.
130 ;; dl-warn-binding-conflicts doesn't make sense when the mode is active
132 (dl-warn-binding-conflicts dl-mode-map))
133 (setq dl-mode (if (null arg) (not dl-mode)
134 (> (prefix-numeric-value arg) 0)))
135 (run-hooks dl-mode-hook))
137 ;; Internal mode data
143 (define-prefix-command 'dl-mode-submap) ;
144 (define-key dl-mode-submap '[ ?s ] 'dui-invoke-search-method)
145 (define-key dl-mode-submap '[ ?i ] 'dui-invoke-insert-method)
146 ;; Hmm ... I don't think there are any of these :-P
147 ;;(define-key dl-mode-submap '[ ?e ] 'dui-invoke-edit-method)
148 (define-key dl-mode-submap '[ ?d ] 'dui-describe-method)
153 ;; Set the mode prefix
155 ;; This can't be done simply by setq'ing dl-mode-map; minor-mode-map-alist
156 ;; does not refer to that variable but contains a copy of its value.
158 (defun dl-mode-set-prefix (key &optional context)
159 "Set the prefix key sequence for dl-mode to KEY.
161 Return the new dl-mode-map. When called interactively read KEY from
162 the minibuffer (as a string; keys not bound to `self-insert' must be
163 quoted with C-q). If you need more flexibility than ASCII gives, you'll
164 have to use the `eval-expression' interface.
166 Example: `\\[dl-mode-set-prefix] C-q C-c $ RET' returns the prefix key
167 to the default `C-c $'.
169 Allowed values of CONTEXT:
170 NIL substitute a map containing KEY in minor-mode-map-alist.
171 adding-minor-mode manipulation of minor-mode-map-alist is done elsewhere."
173 ;; Should read key events but I don't know how to make that work.
174 (interactive "Key sequence (quote control characters with ^Q): ")
176 (setq dl-mode-map (make-sparse-keymap))
177 (define-key dl-mode-map key 'dl-mode-submap)
178 (cond ((null context)
179 (let ((slot (assq 'dl-mode minor-mode-map-alist)))
180 (setq minor-mode-map-alist
181 (cons (cons 'dl-mode dl-mode-map)
183 (delete slot minor-mode-map-alist)
184 minor-mode-map-alist)))))
185 ((equal context 'adding-minor-mode))
186 (t (error "Illegal context `%s' in dl-mode-set-prefix." context)))
189 ;; Deal with binding conflicts
191 ;; Search keymaps for binding conflicts for each key in the mode's keymap.
192 ;; Current implementation searches only active keymaps; it won't tell
193 ;; about inactive keymaps, including those of minor modes that might be
194 ;; invoked later or (worse) major modes already invoked in other buffers.
196 (defun dl-warn-binding-conflicts (map)
197 "Warn about key bindings that will conflict with those in MAP.
199 Results will be non-sensical if MAP is invoked via a prefix or is
200 already active. The current implementation only looks in the active
201 keymaps. Maps of inactive minor modes and local maps major modes of
202 other buffers will not be searched (although the latter will be shadowed
203 since dl-mode is a global variable)."
204 (if (null (featurep 'xemacs))
205 ;; `map-keymap' doesn't exist in the FSF's Emacs
206 (message "Keymap shadow checking not supported under\n%s"
209 (if (> dl-warn-conflict-verbosity 1)
211 (message "Checking for conflicting bindings...")
212 (if (> dl-warn-conflict-verbosity 2)
213 (message "Examining accessible maps of map:\n `%s'" map))))
214 ;; A map is accessible from itself
215 (mapcar (lambda (slot)
216 (let ((prefix (car slot))
218 (if (> dl-warn-conflict-verbosity 2)
219 (message "Examining keys of map:\n `%s'" map))
220 (map-keymap (lambda (key binding)
221 (let* ((key (vconcat prefix (vector key)))
222 (binding (key-binding key)))
224 (> dl-warn-conflict-verbosity 0))
226 (if (not (keymapp binding))
227 (setq found (1+ found)))
228 (message dl-conflict-warning
231 (accessible-keymaps map))
232 (if (> dl-warn-conflict-verbosity 1)
233 (message "Checking for conflicting bindings...done%s"
235 (format ". Found %d." found)
238 ;; Register the mode with Emacs
239 ;; `add-minor-mode' doesn't exist in Emacs 20.2 :-(
240 (or (assq 'dl-mode minor-mode-alist)
241 (setq minor-mode-alist
242 (cons (list 'dl-mode dl-mode-line-string) minor-mode-alist)))
243 (dl-mode-set-prefix dl-mode-prefix)
245 ;;; end of dictionary lookup minor mode
247 (defcustom dui-warn-previously-registered-methods-p t
248 "*Warn about previously registered methods."
252 ;; [SJT: OK, ispell uses M-$, and LEIM and Wnn both use C-\. I see
253 ;; all three processes (spell-check, localized input methods, and
254 ;; dictionary lookup) as being aspects of high-level dictionary-
255 ;; based natural language input. I would like to overload the same
256 ;; mode-toggle for all of them. I see IMs as being primary (analogous
257 ;; to a minor mode), while the checking functions are secondary and/or
258 ;; transient. Unfortunately, both ispell and LEIM use prefix args to
259 ;; modify the toggle's behavior. But all of "C-$", "C-c $", "C-c \",
260 ;; and "C-c \" are undefined.
261 ;; I see the interface as follows.
262 ;; The main-entry point is the the transient function (ispell-word,
263 ;; edict-lookup-*), accessed via the un-prefixed key.
264 ;; The prefixed key would give a short choice menu, in the echo area.
265 ;; A short-list of defaults would be alternative transient functions,
266 ;; plus the choices to add or delete from the menu, or to do more
267 ;; complicated maintenance (eg, customize, once we have an interface.)
269 ;; #### Need to define the call interface for the functions.
270 (defvar dui-method-history nil
271 "List of recently used dictionary methods.")
273 ;; Maybe would like to do something like the following?
274 ;An alist containing elements of the form (METHOD &rest LISTS).
276 ;METHOD is a unique string naming the dictionary method. Each element
277 ;of LISTS is a list of the form (TYPE DESCRIPTION INVOCATION &rest
278 ;ARGS), where TYPE is a symbol (one of 'search, 'insert, or 'edit)
279 ;indicating the context where this invocation is used, DESCRIPTION is a
280 ;string describing this method, INVOCATION is a function to call to
281 ;invoke this method, and the function will be applied to (cons TYPE
283 ;; #### a custom interface might be nice
284 (defvar dui-method-alist nil
285 "*Registry of dictionary methods and utilities.
287 An alist containing elements of the form (METHOD TYPE DESCRIPTION
288 INVOCATION &rest ARGS).
290 METHOD is a unique string naming the dictionary method. TYPE is a
291 symbol (one of 'search, 'insert, or 'edit) indicating the context
292 where this invocation is used, DESCRIPTION is a string describing this
293 method, INVOCATION is a function to call to invoke this method, and
294 the function will be applied to (cons TYPE ARGS).")
296 ;; Method component access functions
297 (defun dui-get-method-name (slot) (nth 0 slot))
298 (defun dui-get-method-type (slot) (nth 1 slot))
299 (defun dui-get-method-description (slot) (nth 2 slot))
300 (defun dui-get-method-invocation (slot) (nth 3 slot))
301 (defun dui-get-method-args (slot) (nthcdr 4 slot))
303 ;; Flush any old errors hanging around on reload.
304 (defconst dui-registration-errors nil
305 "String containing description of method registration problems.")
307 (defun dui-register-method
308 (method type invocation description &rest args)
309 "Register a dictionary method.
311 METHOD is a unique string naming the dictionary method. TYPE
312 indicates the context in which the method is used (a symbol, one of
313 'search, 'insert, or 'edit). INVOCATION is a function to call to
314 invoke this method, which is applied to ARGS. DESCRIPTION is a string
315 describing this method. The same INVOCATION function may be
316 registered in different contexts with different descriptions and
317 argument lists, but must have a different METHOD name in each context.
319 It may be useful to include METHOD as an element of ARGS to allow the
320 INVOCATION function to be used by several slightly different methods."
321 (if (assoc method dui-method-alist)
322 (setq dui-registration-errors
323 (concat dui-registration-errors
324 (format "%s\n" method)))
325 (setq dui-method-alist
326 (cons (append (list method type description invocation) args)
329 ;; #### should this filter on type? probably not.
330 (defun dui-remove-method (method)
331 "Remove a dictionary method from the registry."
332 (interactive (completing-read "Remove method: " dui-method-alist nil t))
333 (setq dui-method-alist
334 (delete (assoc method dui-method-alist)
337 (defun dui-filter (type list)
338 "Return the sub-list of methods from LIST whose type is TYPE."
340 (mapcar #'(lambda (method)
341 (if (eq (dui-get-method-type (assoc method dui-method-alist)) type)
346 (defun dui-read-method (type prompt &optional default)
347 "Read the name of a dictionary method from the minibuffer.
349 If DEFAULT is non-nil, use that as the default, substituting it into
350 PROMPT at the first `%s'.
352 Signals an error on null input. The return value is a string."
353 (if default (setq prompt (format prompt default)))
354 (let* ((completion-ignore-case t)
355 ;; This binding is necessary if dui-method-history
356 ;; is buffer local. For the name of the variable, see comments
357 ;; in lisp/minibuf.el on `read-from-minibuffer'; it's dynamic
359 (naming-this-symbol-simply-history-loses
360 (dui-filter 'search dui-method-history))
361 ;; Ah, bogosity. Oberhasli croaks with wta listp, history.
362 ;; For now leave it in anyway.
363 (method (completing-read prompt dui-method-alist nil t nil
364 'naming-this-symbol-simply-history-loses)))
365 ;;(method (completing-read prompt dui-method-alist nil t)))
366 (if (and (> (length method) 0)
367 (eq (dui-get-method-type (assoc method dui-method-alist)) type))
369 (error "No valid method was specified"))))
371 ;; #### Make a method for defining additional keymap entries for folks
372 ;; who want secondary dictionaries available.
373 (defun dui-invoke-method (type ask)
374 "Invoke a dictionary method.
376 With ASK non-nil, read a method of type TYPE from the minibuffer and
379 With ASK null, invoke the last selected method, if there is one,
380 otherwise read from minibuffer and invoke."
382 (let* ((default (car (dui-filter type dui-method-history)))
383 (method (if (or ask (not default))
387 "Method (default %s): "
391 (slot (assoc method dui-method-alist))
392 (invocation (dui-get-method-invocation slot))
393 (args (dui-get-method-args slot)))
394 (setq dui-method-history
395 (cons method (delete method dui-method-history)))
396 (apply invocation args)))
398 ;; #### `dui-invoke-insert-method' and `dui-invoke-edit-method' probably
399 ;; don't need defaults or histories. Instead, they should be part
400 ;; of the information associated with the search method and they
401 ;; should be automatically invoked depending on the success or
402 ;; failure of the search mehtod. (Insert methods should only be
403 ;; invoked if the appropriate user variable is set.)
405 (defun dui-invoke-search-method (ask)
406 "Invokes a dictionary lookup method.
408 If ASK is non-nil, reads a method from the minibuffer. Otherwise invokes the
409 current default search method.
411 \\[dui-describe-method] gives help for individual methods."
413 (dui-invoke-method 'search ask))
416 (defun dui-invoke-insert-method (ask)
417 "Invokes a method to add a dictionary entry.
419 If ASK is non-nil, reads a method from the minibuffer. Otherwise invokes the
420 current default insert method.
422 \\[dui-describe-method] gives help for individual methods."
424 (dui-invoke-method 'insert ask))
427 (defun dui-invoke-edit-method (ask)
428 "Invokes a dictionary editing method.
430 If ASK is non-nil, reads a method from the minibuffer. Otherwise invokes the
431 current default edit method.
433 \\[dui-describe-method] gives help for individual methods."
435 (dui-invoke-method 'edit ask))
438 (defun dui-describe-method (method)
439 "Shows the docstring for METHOD (a string) in a temporary buffer."
440 (interactive (completing-read "Describe method: " dui-method-alist nil t))
441 (with-output-to-temp-buffer
442 (princ (dui-get-method-description method))))
444 (defun dui-princ-errors ()
445 (if (and dui-warn-previously-registered-methods-p
446 dui-registration-errors)
448 (princ "Methods are already registered by the following names.
449 If you wish to register a new method under one of these names, please use
450 `dui-remove-method' first.
452 (princ dui-registration-errors)
453 (setq dui-registration-errors nil))))
457 ;; load up the default methods
458 ;; must come after the provide call to dui
459 (require 'dui-registry)