This commit was manufactured by cvs2svn to create tag 'r21-4-22-chise-
[chise/xemacs-chise.git.1] / lisp / x-compose.el
1 ;;; x-compose.el --- Compose-key processing in XEmacs
2
3 ;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc.
4
5 ;; Author: Jamie Zawinski <jwz@jwz.org>
6 ;; Maintainer: XEmacs Development Team
7 ;; Rewritten by Martin Buchholz far too many times.
8 ;;
9 ;; Changed: 11 Jun 1997 by Heiko Muenkel <muenkel@tnt.uni-hannover.de>
10 ;;      The degree sign couldn't be inserted with the old version.
11 ;; Keywords: i18n
12
13 ;; This file is part of XEmacs.
14
15 ;; XEmacs is free software; you can redistribute it and/or modify it
16 ;; under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; any later version.
19
20 ;; XEmacs is distributed in the hope that it will be useful, but
21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
23 ;; General Public License for more details.
24
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with XEmacs; see the file COPYING.  If not, write to the
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28 ;; Boston, MA 02111-1307, USA.
29
30 ;;; Synched up with: Not in FSF.
31
32 ;;; Commentary:
33
34 ;; created by jwz, 14-jun-92.
35 ;;; changed by Jan Vroonhof, July 1997: Use function-key-map instead
36 ;;;                                     of global map.
37 ;;;                                     Preliminary support for
38 ;;;                                     XFree86 deadkeys
39
40 ;; This file implements DEC-, OpenWindows-, and HP-compatible "Compose"
41 ;; processing for XEmacs.
42
43 ;; If you are running a version of X which already does compose processing,
44 ;; then you don't need this file.  But the MIT R4 and R5 distributions don't
45 ;; do compose processing, so you may want to fake it by using this code.
46
47 ;; The basic idea is that there are several ways to generate keysyms which
48 ;; do not have keys devoted to them on your keyboard.
49
50 ;; The first method is by using "dead" keys.  A dead key is a key which,
51 ;; when typed, does not insert a character.  Instead it modifies the
52 ;; following character typed.  So if you typed "dead-tilde" followed by "A",
53 ;; then "A-tilde" would be inserted.  Of course, this requires you to modify
54 ;; your keyboard to include a "dead-tilde" key on it somewhere.
55
56 ;; The second method is by using a "Compose" key.  With a Compose key, you
57 ;; would type "Compose" then "tilde" then "A" to insert "A-tilde".
58
59 ;; There are a small number of dead keys: acute, grave, cedilla, diaeresis,
60 ;; circumflex, tilde, and ring.  There are a larger number of accented and
61 ;; other characters accessible via the Compose key, so both are useful.
62
63 ;; To use this code, you will need to have a Compose key on your keyboard.
64 ;; The default configuration of most X keyboards doesn't contain one.  You
65 ;; can, for example, turn the right "Meta" key into a "Compose" key with
66 ;; this command:
67
68 ;;    xmodmap -e "remove mod1 = Meta_R" -e "keysym Meta_R = Multi_key"
69
70 ;; Multi-key is the name that X (and emacs) know the "Compose" key by.
71 ;; The "remove..." command is necessary because the "Compose" key must not
72 ;; have any modifier bits associated with it.  This exact command may not
73 ;; work, depending on what system and keyboard you are using.  If it
74 ;; doesn't, you'll have to read the man page for xmodmap.  You might want
75 ;; to get the "xkeycaps" program from
76 ;; <URL:http://www.jwz.org/xkeycaps/>,
77 ;; which is a graphical front end to xmodmap
78 ;; that hides xmodmap's arcane syntax from you.
79
80 ;; If for some reason you don't want to have a dedicated compose key on your
81 ;; keyboard, you can use some other key as the prefix.  For example, to make
82 ;; "Meta-Shift-C" act as a compose key (so that "M-C , c" would insert the
83 ;; character "ccedilla") you could do
84
85 ;;    (global-set-key "\M-C" compose-map)
86
87 ;; I believe the bindings encoded in this file are the same as those used
88 ;; by OpenWindows versions 2 and 3, and DEC VT320 terminals.  Please let me
89 ;; know if you think otherwise.
90
91 ;; Much thanks to Justin Bur <justin@crim.ca> for helping me understand how
92 ;; this stuff is supposed to work.
93
94 ;; You also might want to consider getting Justin's patch for the MIT Xlib
95 ;; that implements compose processing in the library.  This will enable
96 ;; compose processing in applications other than emacs as well.  You can
97 ;; get it from export.lcs.mit.edu in contrib/compose.tar.Z.
98
99 ;; This code has one feature that a more "builtin" Compose mechanism could
100 ;; not have: at any point you can type C-h to get a list of the possible
101 ;; completions of what you have typed so far.
102
103 ;;; Code:
104
105 (require 'x-iso8859-1)
106
107 (macrolet
108     ((define-compose-map (keymap-symbol)
109        `(progn
110           (defconst ,keymap-symbol (make-sparse-keymap ',keymap-symbol))
111           ;; Required to tell XEmacs the keymaps were actually autoloaded.
112           ;; #### Make this unnecessary!
113           (fset ',keymap-symbol ,keymap-symbol))))
114
115   (define-compose-map compose-map)
116   (define-compose-map compose-acute-map)
117   (define-compose-map compose-grave-map)
118   (define-compose-map compose-cedilla-map)
119   (define-compose-map compose-diaeresis-map)
120   (define-compose-map compose-circumflex-map)
121   (define-compose-map compose-tilde-map)
122   (define-compose-map compose-ring-map))
123
124 (define-key compose-map 'acute      compose-acute-map)
125 (define-key compose-map 'grave      compose-grave-map)
126 (define-key compose-map 'cedilla    compose-cedilla-map)
127 (define-key compose-map 'diaeresis  compose-diaeresis-map)
128 (define-key compose-map 'circumflex compose-circumflex-map)
129 (define-key compose-map 'tilde      compose-tilde-map)
130 (define-key compose-map 'degree     compose-ring-map)
131
132 ;;(define-key function-key-map [multi-key] compose-map)
133
134 ;; The following is necessary, because one can't rebind [degree]
135 ;; and use it to insert the degree sign!
136 ;;(defun compose-insert-degree ()
137 ;;  "Inserts a degree sign."
138 ;;  (interactive)
139 ;;  (insert ?\260))
140
141 (define-key compose-map [acute]         compose-acute-map)
142 (define-key compose-map [?']            compose-acute-map)
143 (define-key compose-map [grave]         compose-grave-map)
144 (define-key compose-map [?`]            compose-grave-map)
145 (define-key compose-map [cedilla]       compose-cedilla-map)
146 (define-key compose-map [?,]            compose-cedilla-map)
147 (define-key compose-map [diaeresis]     compose-diaeresis-map)
148 (define-key compose-map [?\"]           compose-diaeresis-map)
149 (define-key compose-map [circumflex]    compose-circumflex-map)
150 (define-key compose-map [?^]            compose-circumflex-map)
151 (define-key compose-map [tilde]         compose-tilde-map)
152 (define-key compose-map [~]             compose-tilde-map)
153 (define-key compose-map [degree]        compose-ring-map)
154 (define-key compose-map [?*]            compose-ring-map)
155
156 \f
157 ;;; The contents of the "dead key" maps.  These are shared by the
158 ;;; compose-map.
159
160 (define-key compose-acute-map [space]   "'")
161 (define-key compose-acute-map [?']      [acute])
162 (define-key compose-acute-map [?A]      [Aacute])
163 (define-key compose-acute-map [E]       [Eacute])
164 (define-key compose-acute-map [I]       [Iacute])
165 (define-key compose-acute-map [O]       [Oacute])
166 (define-key compose-acute-map [U]       [Uacute])
167 (define-key compose-acute-map [Y]       [Yacute])
168 (define-key compose-acute-map [a]       [aacute])
169 (define-key compose-acute-map [e]       [eacute])
170 (define-key compose-acute-map [i]       [iacute])
171 (define-key compose-acute-map [o]       [oacute])
172 (define-key compose-acute-map [u]       [uacute])
173 (define-key compose-acute-map [y]       [yacute])
174
175 (define-key compose-grave-map [space]   "`")
176 (define-key compose-grave-map [?`]      [grave])
177 (define-key compose-grave-map [A]       [Agrave])
178 (define-key compose-grave-map [E]       [Egrave])
179 (define-key compose-grave-map [I]       [Igrave])
180 (define-key compose-grave-map [O]       [Ograve])
181 (define-key compose-grave-map [U]       [Ugrave])
182 (define-key compose-grave-map [a]       [agrave])
183 (define-key compose-grave-map [e]       [egrave])
184 (define-key compose-grave-map [i]       [igrave])
185 (define-key compose-grave-map [o]       [ograve])
186 (define-key compose-grave-map [u]       [ugrave])
187
188 (define-key compose-cedilla-map [space] ",")
189 (define-key compose-cedilla-map [?,]    [cedilla])
190 (define-key compose-cedilla-map [C]     [Ccedilla])
191 (define-key compose-cedilla-map [c]     [ccedilla])
192
193 (define-key compose-diaeresis-map [space] [diaeresis])
194 (define-key compose-diaeresis-map [?\"] [diaeresis])
195 (define-key compose-diaeresis-map [A]   [Adiaeresis])
196 (define-key compose-diaeresis-map [E]   [Ediaeresis])
197 (define-key compose-diaeresis-map [I]   [Idiaeresis])
198 (define-key compose-diaeresis-map [O]   [Odiaeresis])
199 (define-key compose-diaeresis-map [U]   [Udiaeresis])
200 (define-key compose-diaeresis-map [a]   [adiaeresis])
201 (define-key compose-diaeresis-map [e]   [ediaeresis])
202 (define-key compose-diaeresis-map [i]   [idiaeresis])
203 (define-key compose-diaeresis-map [o]   [odiaeresis])
204 (define-key compose-diaeresis-map [u]   [udiaeresis])
205 (define-key compose-diaeresis-map [y]   [ydiaeresis])
206
207 (define-key compose-circumflex-map [space] "^")
208 (define-key compose-circumflex-map [?/] "|")
209 (define-key compose-circumflex-map [?!] [brokenbar])
210 (define-key compose-circumflex-map [?-] [macron])
211 (define-key compose-circumflex-map [?_] [macron])
212 (define-key compose-circumflex-map [?0] [degree])
213 (define-key compose-circumflex-map [?1] [onesuperior])
214 (define-key compose-circumflex-map [?2] [twosuperior])
215 (define-key compose-circumflex-map [?3] [threesuperior])
216 (define-key compose-circumflex-map [?.] [periodcentered])
217 (define-key compose-circumflex-map [A]  [Acircumflex])
218 (define-key compose-circumflex-map [E]  [Ecircumflex])
219 (define-key compose-circumflex-map [I]  [Icircumflex])
220 (define-key compose-circumflex-map [O]  [Ocircumflex])
221 (define-key compose-circumflex-map [U]  [Ucircumflex])
222 (define-key compose-circumflex-map [a]  [acircumflex])
223 (define-key compose-circumflex-map [e]  [ecircumflex])
224 (define-key compose-circumflex-map [i]  [icircumflex])
225 (define-key compose-circumflex-map [o]  [ocircumflex])
226 (define-key compose-circumflex-map [u]  [ucircumflex])
227
228 (define-key compose-tilde-map [space]   "~")
229 (define-key compose-tilde-map [A]       [Atilde])
230 (define-key compose-tilde-map [N]       [Ntilde])
231 (define-key compose-tilde-map [O]       [Otilde])
232 (define-key compose-tilde-map [a]       [atilde])
233 (define-key compose-tilde-map [n]       [ntilde])
234 (define-key compose-tilde-map [o]       [otilde])
235
236 (define-key compose-ring-map [space]    [degree])
237 (define-key compose-ring-map [A]        [Aring])
238 (define-key compose-ring-map [a]        [aring])
239
240 \f
241 ;;; The rest of the compose-map.  These are the composed characters
242 ;;; that are not accessible via "dead" keys.
243
244 (define-key compose-map " '"    "'")
245 (define-key compose-map " ^"    "^")
246 (define-key compose-map " `"    "`")
247 (define-key compose-map " ~"    "~")
248 (define-key compose-map "  "    [nobreakspace])
249 (define-key compose-map " \""   [diaeresis])
250 (define-key compose-map " :"    [diaeresis])
251 (define-key compose-map " *"    [degree])
252
253 (define-key compose-map "!!"    [exclamdown])
254 (define-key compose-map "!^"    [brokenbar])
255 (define-key compose-map "!S"    [section])
256 (define-key compose-map "!s"    [section])
257 (define-key compose-map "!P"    [paragraph])
258 (define-key compose-map "!p"    [paragraph])
259
260 (define-key compose-map "(("    "[")
261 (define-key compose-map "(-"    "{")
262
263 (define-key compose-map "))"    "]")
264 (define-key compose-map ")-"    "}")
265
266 (define-key compose-map "++"    "#")
267 (define-key compose-map "+-"    [plusminus])
268
269 (define-key compose-map "-("    "{")
270 (define-key compose-map "-)"    "}")
271 (define-key compose-map "--"    "-")
272 (define-key compose-map "-L"    [sterling])
273 (define-key compose-map "-l"    [sterling])
274 (define-key compose-map "-Y"    [yen])
275 (define-key compose-map "-y"    [yen])
276 (define-key compose-map "-,"    [notsign])
277 (define-key compose-map "-|"    [notsign])
278 (define-key compose-map "-^"    [macron])
279 (define-key compose-map "-+"    [plusminus])
280 (define-key compose-map "-:"    [division])
281 (define-key compose-map "-D"    [ETH])
282 (define-key compose-map "-d"    [eth])
283 (define-key compose-map "-a"    [ordfeminine])
284
285 (define-key compose-map ".^"    [periodcentered])
286
287 (define-key compose-map "//"    "\\")
288 (define-key compose-map "/<"    "\\")
289 (define-key compose-map "/^"    "|")
290 (define-key compose-map "/C"    [cent])
291 (define-key compose-map "/c"    [cent])
292 (define-key compose-map "/U"    [mu])
293 (define-key compose-map "/u"    [mu])
294 (define-key compose-map "/O"    [Ooblique])
295 (define-key compose-map "/o"    [oslash])
296
297 (define-key compose-map "0X"    [currency])
298 (define-key compose-map "0x"    [currency])
299 (define-key compose-map "0S"    [section])
300 (define-key compose-map "0s"    [section])
301 (define-key compose-map "0C"    [copyright])
302 (define-key compose-map "0c"    [copyright])
303 (define-key compose-map "0R"    [registered])
304 (define-key compose-map "0r"    [registered])
305 (define-key compose-map "0^"    [degree])
306
307 (define-key compose-map "1^"    [onesuperior])
308 (define-key compose-map "14"    [onequarter])
309 (define-key compose-map "12"    [onehalf])
310
311 (define-key compose-map "2^"    [twosuperior])
312
313 (define-key compose-map "3^"    [threesuperior])
314 (define-key compose-map "34"    [threequarters])
315
316 (define-key compose-map ":-"    [division])
317
318 (define-key compose-map "</"    "\\")
319 (define-key compose-map "<<"    [guillemotleft])
320
321 (define-key compose-map "=L"    [sterling])
322 (define-key compose-map "=l"    [sterling])
323 (define-key compose-map "=Y"    [yen])
324 (define-key compose-map "=y"    [yen])
325
326 (define-key compose-map ">>"    [guillemotright])
327
328 (define-key compose-map "??"    [questiondown])
329
330 (define-key compose-map "AA"    "@")
331 (define-key compose-map "Aa"    "@")
332 (define-key compose-map "A_"    [ordfeminine])
333 (define-key compose-map "A`"    [Agrave])
334 (define-key compose-map "A'"    [Aacute])
335 (define-key compose-map "A^"    [Acircumflex])
336 (define-key compose-map "A~"    [Atilde])
337 (define-key compose-map "A\""   [Adiaeresis])
338 (define-key compose-map "A*"    [Aring])
339 (define-key compose-map "AE"    [AE])
340
341 (define-key compose-map "C/"    [cent])
342 (define-key compose-map "C|"    [cent])
343 (define-key compose-map "C0"    [copyright])
344 (define-key compose-map "CO"    [copyright])
345 (define-key compose-map "Co"    [copyright])
346 (define-key compose-map "C,"    [Ccedilla])
347
348 (define-key compose-map "D-"    [ETH])
349
350 (define-key compose-map "E`"    [Egrave])
351 (define-key compose-map "E'"    [Eacute])
352 (define-key compose-map "E^"    [Ecircumflex])
353 (define-key compose-map "E\""   [Ediaeresis])
354
355 (define-key compose-map "I`"    [Igrave])
356 (define-key compose-map "I'"    [Iacute])
357 (define-key compose-map "I^"    [Icircumflex])
358 (define-key compose-map "I\""   [Idiaeresis])
359
360 (define-key compose-map "L-"    [sterling])
361 (define-key compose-map "L="    [sterling])
362
363 (define-key compose-map "N~"    [Ntilde])
364
365 (define-key compose-map "OX"    [currency])
366 (define-key compose-map "Ox"    [currency])
367 (define-key compose-map "OS"    [section])
368 (define-key compose-map "Os"    [section])
369 (define-key compose-map "OC"    [copyright])
370 (define-key compose-map "Oc"    [copyright])
371 (define-key compose-map "OR"    [registered])
372 (define-key compose-map "Or"    [registered])
373 (define-key compose-map "O_"    [masculine])
374 (define-key compose-map "O`"    [Ograve])
375 (define-key compose-map "O'"    [Oacute])
376 (define-key compose-map "O^"    [Ocircumflex])
377 (define-key compose-map "O~"    [Otilde])
378 (define-key compose-map "O\""   [Odiaeresis])
379 (define-key compose-map "O/"    [Ooblique])
380
381 (define-key compose-map "P!"    [paragraph])
382
383 (define-key compose-map "R0"    [registered])
384 (define-key compose-map "RO"    [registered])
385 (define-key compose-map "Ro"    [registered])
386
387 (define-key compose-map "S!"    [section])
388 (define-key compose-map "S0"    [section])
389 (define-key compose-map "SO"    [section])
390 (define-key compose-map "So"    [section])
391 (define-key compose-map "SS"    [ssharp])
392
393 (define-key compose-map "TH"    [THORN])
394
395 (define-key compose-map "U`"    [Ugrave])
396 (define-key compose-map "U'"    [Uacute])
397 (define-key compose-map "U^"    [Ucircumflex])
398 (define-key compose-map "U\""   [Udiaeresis])
399
400 (define-key compose-map "X0"    [currency])
401 (define-key compose-map "XO"    [currency])
402 (define-key compose-map "Xo"    [currency])
403
404 (define-key compose-map "Y-"    [yen])
405 (define-key compose-map "Y="    [yen])
406 (define-key compose-map "Y'"    [Yacute])
407
408 (define-key compose-map "_A"    [ordfeminine])
409 (define-key compose-map "_a"    [ordfeminine])
410 (define-key compose-map "_^"    [macron])
411 (define-key compose-map "_O"    [masculine])
412 (define-key compose-map "_o"    [masculine])
413
414 (define-key compose-map "aA"    "@")
415 (define-key compose-map "aa"    "@")
416 (define-key compose-map "a_"    [ordfeminine])
417 (define-key compose-map "a-"    [ordfeminine])
418 (define-key compose-map "a`"    [agrave])
419 (define-key compose-map "a'"    [aacute])
420 (define-key compose-map "a^"    [acircumflex])
421 (define-key compose-map "a~"    [atilde])
422 (define-key compose-map "a\""   [adiaeresis])
423 (define-key compose-map "a*"    [aring])
424 (define-key compose-map "ae"    [ae])
425
426 (define-key compose-map "c/"    [cent])
427 (define-key compose-map "c|"    [cent])
428 (define-key compose-map "c0"    [copyright])
429 (define-key compose-map "cO"    [copyright])
430 (define-key compose-map "co"    [copyright])
431 (define-key compose-map "c,"    [ccedilla])
432
433 (define-key compose-map "d-"    [eth])
434
435 (define-key compose-map "e`"    [egrave])
436 (define-key compose-map "e'"    [eacute])
437 (define-key compose-map "e^"    [ecircumflex])
438 (define-key compose-map "e\""   [ediaeresis])
439
440 (define-key compose-map "i`"    [igrave])
441 (define-key compose-map "i'"    [iacute])
442 (define-key compose-map "i^"    [icircumflex])
443 (define-key compose-map "i\""   [idiaeresis])
444 (define-key compose-map "i:"    [idiaeresis])
445
446 (define-key compose-map "l-"    [sterling])
447 (define-key compose-map "l="    [sterling])
448
449 (define-key compose-map "n~"    [ntilde])
450
451 (define-key compose-map "oX"    [currency])
452 (define-key compose-map "ox"    [currency])
453 (define-key compose-map "oC"    [copyright])
454 (define-key compose-map "oc"    [copyright])
455 (define-key compose-map "oR"    [registered])
456 (define-key compose-map "or"    [registered])
457 (define-key compose-map "oS"    [section])
458 (define-key compose-map "os"    [section])
459 (define-key compose-map "o_"    [masculine])
460 (define-key compose-map "o`"    [ograve])
461 (define-key compose-map "o'"    [oacute])
462 (define-key compose-map "o^"    [ocircumflex])
463 (define-key compose-map "o~"    [otilde])
464 (define-key compose-map "o\""   [odiaeresis])
465 (define-key compose-map "o/"    [oslash])
466
467 (define-key compose-map "p!"    [paragraph])
468
469 (define-key compose-map "r0"    [registered])
470 (define-key compose-map "rO"    [registered])
471 (define-key compose-map "ro"    [registered])
472
473 (define-key compose-map "s!"    [section])
474 (define-key compose-map "s0"    [section])
475 (define-key compose-map "sO"    [section])
476 (define-key compose-map "so"    [section])
477 (define-key compose-map "ss"    [ssharp])
478
479 (define-key compose-map "th"    [thorn])
480
481 (define-key compose-map "u`"    [ugrave])
482 (define-key compose-map "u'"    [uacute])
483 (define-key compose-map "u^"    [ucircumflex])
484 (define-key compose-map "u\""   [udiaeresis])
485 (define-key compose-map "u/"    [mu])
486
487 (define-key compose-map "x0"    [currency])
488 (define-key compose-map "xO"    [currency])
489 (define-key compose-map "xo"    [currency])
490 (define-key compose-map "xx"    [multiply])
491
492 (define-key compose-map "y-"    [yen])
493 (define-key compose-map "y="    [yen])
494 (define-key compose-map "y'"    [yacute])
495 (define-key compose-map "y\""   [ydiaeresis])
496
497 (define-key compose-map "|C"    [cent])
498 (define-key compose-map "|c"    [cent])
499 (define-key compose-map "||"    [brokenbar])
500
501 \f
502 ;; Suppose we type these three physical keys: [Multi_key " a]
503 ;; Xlib can deliver these keys as the following sequences of keysyms:
504 ;;
505 ;; - [Multi_key " a] (no surprise here)
506 ;; - [adiaeresis] (OK, Xlib is doing compose processing for us)
507 ;; - [Multi_key " adiaeresis] (Huh?)
508 ;;
509 ;; It is the last possibility that is arguably a bug.  Xlib can't
510 ;; decide whether it's really doing compose processing or not (or
511 ;; actually, different parts of Xlib disagree).
512 ;;
513 ;; So we'll just convert [Multi_key " adiaeresis] to [adiaeresis]
514 (defun xlib-input-method-bug-workaround (keymap)
515   (map-keymap
516    (lambda (key value)
517      (cond
518       ((keymapp value)
519        (xlib-input-method-bug-workaround value))
520       ((and (sequencep value)
521             (eq 1 (length value))
522             (null (lookup-key keymap value)))
523        (define-key keymap value value))))
524    keymap
525    ;; #### It is currently not safe to add definitions to a keymap in
526    ;; map-keymap, due to a bug in map-keymap (dangling pointer to freed
527    ;; memory on a rehash).  So we sort, which has the side effect of
528    ;; mapping over a copy of the original hash-table.
529    t))
530 (xlib-input-method-bug-workaround compose-map)
531 (unintern 'xlib-input-method-bug-workaround)
532
533 ;; While we're at it, a similar mechanism will make colon equivalent
534 ;; to doublequote for diaeresis processing.  Some Xlibs do this.
535 (defun alias-colon-to-doublequote (keymap)
536   (map-keymap
537    (lambda (key value)
538      (when (keymapp value)
539        (alias-colon-to-doublequote value))
540      (when (eq key '\")
541        (define-key keymap ":" value)))
542    keymap
543    ;; #### It is currently not safe to add definitions to a keymap in
544    ;; map-keymap, due to a bug in map-keymap (dangling pointer to freed
545    ;; memory on a rehash).  So we sort, which has the side effect of
546    ;; mapping over a copy of the original hash-table.
547    t))
548 (alias-colon-to-doublequote compose-map)
549 (unintern 'alias-colon-to-doublequote)
550
551 ;;; Electric dead keys: making a' mean a-acute.
552
553 \f
554 (defun electric-diacritic (&optional count)
555   "Modify the previous character with an accent.
556 For example, if `:' is bound to this command, then typing `a:'
557 will first insert `a' and then turn it into `\344' (adiaeresis).
558 The keys to which this command may be bound (and the accents
559 which it understands) are:
560
561    '  (acute)       \301\311\315\323\332\335 \341\351\355\363\372\375
562    `  (grave)       \300\310\314\322\331 \340\350\354\362\371
563    :  (diaeresis)   \304\313\317\326\334 \344\353\357\366\374\377
564    ^  (circumflex)  \302\312\316\324\333 \342\352\356\364\373
565    ,  (cedilla)     \307\347
566    .  (ring)        \305\345"
567   (interactive "p")
568   (or count (setq count 1))
569
570   (if (not (eq last-command 'self-insert-command))
571       ;; Only do the magic if the two chars were typed in succession.
572       (self-insert-command count)
573
574     ;; This is so that ``a : C-x u'' will transform `adiaeresis' back into `a:'
575     (self-insert-command count)
576     (undo-boundary)
577     (delete-char (- count))
578
579     (let* ((c last-command-char)
580            (map (cond ((eq c ?') compose-acute-map)
581                       ((eq c ?`) compose-grave-map)
582                       ((eq c ?,) compose-cedilla-map)
583                       ((eq c ?:) compose-diaeresis-map)
584                       ((eq c ?^) compose-circumflex-map)
585                       ((eq c ?~) compose-tilde-map)
586                       ((eq c ?.) compose-ring-map)
587                       (t (error "unknown diacritic: %s (%c)" c c))))
588            (base-char (preceding-char))
589            (mod-char (and (>= (downcase base-char) ?a) ; only do alphabetics?
590                           (<= (downcase base-char) ?z)
591                           (lookup-key map (make-string 1 base-char)))))
592       (if (and (vectorp mod-char) (= (length mod-char) 1))
593           (setq mod-char (aref mod-char 0)))
594       (if (and mod-char (symbolp mod-char))
595           (setq mod-char (or (get mod-char character-set-property) mod-char)))
596       (if (and mod-char (> count 0))
597           (delete-char -1)
598         (setq mod-char c))
599       (while (> count 0)
600         (insert mod-char)
601         (setq count (1- count))))))
602
603 ;; should "::" mean "ยจ" and ": " mean ":"?
604 ;; should we also do
605 ;;    (?~
606 ;;     (?A "\303")
607 ;;     (?C "\307")
608 ;;     (?D "\320")
609 ;;     (?N "\321")
610 ;;     (?O "\325")
611 ;;     (?a "\343")
612 ;;     (?c "\347")
613 ;;     (?d "\360")
614 ;;     (?n "\361")
615 ;;     (?o "\365")
616 ;;     (?> "\273")
617 ;;     (?< "\253")
618 ;;     (?  "~")) ; no special code
619 ;;    (?\/
620 ;;     (?A "\305") ;; A-with-ring (Norwegian and Danish)
621 ;;     (?E "\306") ;; AE-ligature (Norwegian and Danish)
622 ;;     (?O "\330")
623 ;;     (?a "\345") ;; a-with-ring (Norwegian and Danish)
624 ;;     (?e "\346") ;; ae-ligature (Norwegian and Danish)
625 ;;     (?o "\370")
626 ;;     (?  "/")) ; no special code
627
628 \f
629 ;;; Providing help in the middle of a compose sequence.  (Way cool.)
630
631 (eval-when-compile
632   (defsubst next-composable-event ()
633     (let (event)
634       (while (progn
635                (setq event (next-command-event))
636                (not (or (key-press-event-p event)
637                         (button-press-event-p event))))
638         (dispatch-event event))
639       event)))
640
641 (defun compose-help (ignore-prompt)
642   (let* ((keys (apply 'vector (nbutlast (append (this-command-keys) nil))))
643          (map (or (lookup-key function-key-map keys)
644                   (error "can't find map?  %s %s" keys (this-command-keys))))
645          binding)
646     (save-excursion
647       (with-output-to-temp-buffer "*Help*"
648         (set-buffer "*Help*")
649         (erase-buffer)
650         (message "Working...")
651         (setq ctl-arrow 'compose) ; non-t-non-nil
652         (insert "You are typing a compose sequence.  So far you have typed: ")
653         (insert (key-description keys))
654         (insert "\nCompletions from here are:\n\n")
655         (map-keymap 'compose-help-mapper map t)
656         (message "? ")))
657     (while (keymapp map)
658       (setq binding (lookup-key map (vector (next-composable-event))))
659       (if (null binding)
660           (message "No such key in keymap. Try again.")
661         (setq map binding)))
662     binding))
663
664 (put 'compose-help 'isearch-command t)  ; so that it doesn't terminate isearch
665
666 (defun compose-help-mapper (key binding)
667   (if (and (symbolp key)
668            (get key character-set-property))
669       (setq key (get key character-set-property)))
670   (if (eq binding 'compose-help) ; suppress that...
671       nil
672     (if (keymapp binding)
673         (let ((p (point)))
674           (map-keymap 'compose-help-mapper binding t)
675           (goto-char p)
676           (while (not (eobp))
677             (if (characterp key)
678                 (insert (make-string 1 key))
679               (insert (single-key-description key)))
680             (insert " ")
681             (forward-line 1)))
682       (if (characterp key)
683           (insert (make-string 1 key))
684         (insert (single-key-description key)))
685       (indent-to 16)
686       (let ((code (and (vectorp binding)
687                        (= 1 (length binding))
688                        (get (aref binding 0) character-set-property))))
689         (if code
690             (insert (make-string 1 code))
691           (if (stringp binding)
692               (insert binding)
693             (insert (prin1-to-string binding)))))
694       (when (and (vectorp binding) (= 1 (length binding)))
695         (indent-to 32)
696         (insert (symbol-name (aref binding 0)))))
697     (insert "\n")))
698
699 ;; define it at top-level in the compose map...
700 ;;(define-key compose-map [(control h)] 'compose-help)
701 ;;(define-key compose-map [help]        'compose-help)
702 ;; and then define it in each sub-map of the compose map.
703 (map-keymap
704  (lambda (key binding)
705    (when (keymapp binding)
706 ;;     (define-key binding [(control h)] 'compose-help)
707 ;;     (define-key binding [help]        'compose-help)
708      ))
709  compose-map)
710
711 ;; Make redisplay display the accented letters
712 (if (memq (default-value 'ctl-arrow) '(t nil))
713     (setq-default ctl-arrow 'iso-8859/1))
714
715 \f
716 (provide 'x-compose)
717
718 ;;; x-compose.el ends here