Mercurial > hg > xemacs-beta

comparison lisp/x-compose.el @ 209:41ff10fd062f r20-4b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b3
author cvs
date Mon, 13 Aug 2007 10:04:58 +0200
parents
children 41f2f0e326e9
comparison
equal deleted inserted replaced
208:f427b8ec4379 209:41ff10fd062f
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@netscape.com>
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 the host export.lcs.mit.edu in the
76 ;; file contrib/xkeycaps.tar.Z, which is a graphical front end to xmodmap
77 ;; that hides xmodmap's arcane syntax from you.
78
79 ;; If for some reason you don't want to have a dedicated compose key on your
80 ;; keyboard, you can use some other key as the prefix. For example, to make
81 ;; "Meta-Shift-C" act as a compose key (so that "M-C , c" would insert the
82 ;; character "ccedilla") you could do
83
84 ;; (global-set-key "\M-C" compose-map)
85
86 ;; I believe the bindings encoded in this file are the same as those used
87 ;; by OpenWindows versions 2 and 3, and DEC VT320 terminals. Please let me
88 ;; know if you think otherwise.
89
90 ;; Much thanks to Justin Bur <justin@crim.ca> for helping me understand how
91 ;; this stuff is supposed to work.
92
93 ;; You also might want to consider getting Justin's patch for the MIT Xlib
94 ;; that implements compose processing in the library. This will enable
95 ;; compose processing in applications other than emacs as well. You can
96 ;; get it from export.lcs.mit.edu in contrib/compose.tar.Z.
97
98 ;; This code has one feature that a more "builtin" Compose mechanism could
99 ;; not have: at any point you can type C-h to get a list of the possible
100 ;; completions of what you have typed so far.
101
102 ;;; Code:
103
104 (require 'x-iso8859-1)
105
106 (defun make-compose-map (map-sym)
107 (let ((map (make-sparse-keymap)))
108 (set map-sym map)
109 (set-keymap-name map map-sym)
110 ;; Required to tell XEmacs the keymaps were actually autoloaded.
111 ;; #### Make this unnecessary!
112 (fset map-sym map)))
113
114 (make-compose-map 'compose-map)
115 (make-compose-map 'compose-acute-map)
116 (make-compose-map 'compose-grave-map)
117 (make-compose-map 'compose-cedilla-map)
118 (make-compose-map 'compose-diaeresis-map)
119 (make-compose-map 'compose-circumflex-map)
120 (make-compose-map 'compose-tilde-map)
121 (make-compose-map 'compose-ring-map)
122
123 (unintern 'make-compose-map)
124
125 (define-key compose-map 'acute compose-acute-map)
126 (define-key compose-map 'grave compose-grave-map)
127 (define-key compose-map 'cedilla compose-cedilla-map)
128 (define-key compose-map 'diaeresis compose-diaeresis-map)
129 (define-key compose-map 'circumflex compose-circumflex-map)
130 (define-key compose-map 'tilde compose-tilde-map)
131 (define-key compose-map 'degree compose-ring-map)
132
133 ;;(eval-when-compile
134 ;; (defsubst define-dead-key-map (key map)
135 ;; (define-key function-key-map key map)
136 ;; (define-key compose-map key map)))
137
138 ;;;###utoload (autoload 'compose-map "x-compose" nil t 'keymap)
139 ;;;###utoload (autoload 'compose-acute-map "x-compose" nil t 'keymap)
140 ;;;###utoload (autoload 'compose-grave-map "x-compose" nil t 'keymap)
141 ;;;###utoload (autoload 'compose-cedilla-map "x-compose" nil t 'keymap)
142 ;;;###utoload (autoload 'compose-diaeresis-map "x-compose" nil t 'keymap)
143 ;;;###utoload (autoload 'compose-degree-map "x-compose" nil t 'keymap)
144 ;;;###utoload (define-key function-key-map [acute] 'compose-acute-map)
145 ;;;###utoload (define-key function-key-map [grave] 'compose-grave-map)
146 ;;;###utoload (define-key function-key-map [cedilla] 'compose-cedilla-map)
147 ;;;###utoload (define-key function-key-map [diaeresis] 'compose-diaeresis-map)
148 ;;;###utoload (define-key function-key-map [degree] 'compose-degree-map)
149 ;;;###utoload (define-key function-key-map [multi-key] 'compose-map)
150 ;;;###utoload (define-key global-map [multi-key] 'compose-map)
151
152 ;;(define-key function-key-map [multi-key] compose-map)
153
154
155 ;; The following is necessary, because one can't rebind [degree]
156 ;; and use it to insert the degree sign!
157 ;;(defun compose-insert-degree ()
158 ;; "Inserts a degree sign."
159 ;; (interactive)
160 ;; (insert ?\260))
161
162 ;; The "Dead" keys:
163 ;;
164 ;;(define-dead-key-map [acute] compose-acute-map)
165 ;;(define-dead-key-map [cedilla] compose-cedilla-map)
166 ;;(define-dead-key-map [diaeresis] compose-diaeresis-map)
167 ;;(define-dead-key-map [degree] compose-ring-map)
168
169 (define-key compose-map [acute] compose-acute-map)
170 (define-key compose-map [?'] compose-acute-map)
171 (define-key compose-map [grave] compose-grave-map)
172 (define-key compose-map [?`] compose-grave-map)
173 (define-key compose-map [cedilla] compose-cedilla-map)
174 (define-key compose-map [?,] compose-cedilla-map)
175 (define-key compose-map [diaeresis] compose-diaeresis-map)
176 (define-key compose-map [?\"] compose-diaeresis-map)
177 (define-key compose-map [circumflex] compose-circumflex-map)
178 (define-key compose-map [?^] compose-circumflex-map)
179 (define-key compose-map [tilde] compose-tilde-map)
180 (define-key compose-map [~] compose-tilde-map)
181 (define-key compose-map [degree] compose-ring-map)
182 (define-key compose-map [?*] compose-ring-map)
183
184
185 ;;; The dead keys might really be called just about anything, depending
186 ;;; on the vendor. MIT thinks that the prefixes are "SunFA_", "D", and
187 ;;; "hpmute_" for Sun, DEC, and HP respectively. However, OpenWindows 3
188 ;;; thinks that the prefixes are "SunXK_FA_", "DXK_", and "hpXK_mute_".
189 ;;; And HP (who don't mention Sun and DEC at all) use "XK_mute_".
190 ;;; Go figure.
191
192 ;;; Presumably if someone is running OpenWindows, they won't be using
193 ;;; the DEC or HP keysyms, but if they are defined then that is possible,
194 ;;; so in that case we accept them all.
195
196 ;;; If things seem not to be working, you might want to check your
197 ;;; /usr/lib/X11/XKeysymDB file to see if your vendor has an equally
198 ;;; mixed up view of what these keys should be called.
199
200 ;; Sun according to MIT:
201 ;;
202
203 ;;(when (x-valid-keysym-name-p "SunFA_Acute")
204 ;; (define-dead-key-map [SunFA_Acute] compose-acute-map)
205 ;; (define-dead-key-map [SunFA_Grave] compose-grave-map)
206 ;; (define-dead-key-map [SunFA_Cedilla] compose-cedilla-map)
207 ;; (define-dead-key-map [SunFA_Diaeresis] compose-diaeresis-map)
208 ;; (define-dead-key-map [SunFA_Circum] compose-circumflex-map)
209 ;; (define-dead-key-map [SunFA_Tilde] compose-tilde-map)
210 ;; )
211 ;;
212 ;;;; Sun according to OpenWindows 2:
213 ;;;;
214 ;;(when (x-valid-keysym-name-p "Dead_Grave")
215 ;; (define-dead-key-map [Dead_Grave] compose-grave-map)
216 ;; (define-dead-key-map [Dead_Circum] compose-circumflex-map)
217 ;; (define-dead-key-map [Dead_Tilde] compose-tilde-map)
218 ;; )
219 ;;
220 ;;;; Sun according to OpenWindows 3:
221 ;;;;
222 ;;(when (x-valid-keysym-name-p "SunXK_FA_Acute")
223 ;; (define-dead-key-map [SunXK_FA_Acute] compose-acute-map)
224 ;; (define-dead-key-map [SunXK_FA_Grave] compose-grave-map)
225 ;; (define-dead-key-map [SunXK_FA_Cedilla] compose-cedilla-map)
226 ;; (define-dead-key-map [SunXK_FA_Diaeresis] compose-diaeresis-map)
227 ;; (define-dead-key-map [SunXK_FA_Circum] compose-circumflex-map)
228 ;; (define-dead-key-map [SunXK_FA_Tilde] compose-tilde-map)
229 ;; )
230 ;;
231 ;;;; DEC according to MIT:
232 ;;;;
233 ;;(when (x-valid-keysym-name-p "Dacute_accent")
234 ;; (define-dead-key-map [Dacute_accent] compose-acute-map)
235 ;; (define-dead-key-map [Dgrave_accent] compose-grave-map)
236 ;; (define-dead-key-map [Dcedilla_accent] compose-cedilla-map)
237 ;; (define-dead-key-map [Dcircumflex_accent] compose-circumflex-map)
238 ;; (define-dead-key-map [Dtilde] compose-tilde-map)
239 ;; (define-dead-key-map [Dring_accent] compose-ring-map)
240 ;; )
241 ;;
242 ;;;; DEC according to OpenWindows 3:
243 ;;;;
244 ;;(when (x-valid-keysym-name-p "DXK_acute_accent")
245 ;; (define-dead-key-map [DXK_acute_accent] compose-acute-map)
246 ;; (define-dead-key-map [DXK_grave_accent] compose-grave-map)
247 ;; (define-dead-key-map [DXK_cedilla_accent] compose-cedilla-map)
248 ;; (define-dead-key-map [DXK_circumflex_accent] compose-circumflex-map)
249 ;; (define-dead-key-map [DXK_tilde] compose-tilde-map)
250 ;; (define-dead-key-map [DXK_ring_accent] compose-ring-map)
251 ;; )
252 ;;
253 ;;;; HP according to MIT:
254 ;;;;
255 ;;(when (x-valid-keysym-name-p "hpmute_acute")
256 ;; (define-dead-key-map [hpmute_acute] compose-acute-map)
257 ;; (define-dead-key-map [hpmute_grave] compose-grave-map)
258 ;; (define-dead-key-map [hpmute_diaeresis] compose-diaeresis-map)
259 ;; (define-dead-key-map [hpmute_asciicircum] compose-circumflex-map)
260 ;; (define-dead-key-map [hpmute_asciitilde] compose-tilde-map)
261 ;; )
262 ;;
263 ;;;; HP according to OpenWindows 3:
264 ;;;;
265 ;;(when (x-valid-keysym-name-p "hpXK_mute_acute")
266 ;; (define-dead-key-map [hpXK_mute_acute] compose-acute-map)
267 ;; (define-dead-key-map [hpXK_mute_grave] compose-grave-map)
268 ;; (define-dead-key-map [hpXK_mute_diaeresis] compose-diaeresis-map)
269 ;; (define-dead-key-map [hpXK_mute_asciicircum] compose-circumflex-map)
270 ;; (define-dead-key-map [hpXK_mute_asciitilde] compose-tilde-map)
271 ;; )
272 ;;
273 ;;;; HP according to HP-UX 8.0:
274 ;;;;
275 ;;(when (x-valid-keysym-name-p "XK_mute_acute")
276 ;; (define-dead-key-map [XK_mute_acute] compose-acute-map)
277 ;; (define-dead-key-map [XK_mute_grave] compose-grave-map)
278 ;; (define-dead-key-map [XK_mute_diaeresis] compose-diaeresis-map)
279 ;; (define-dead-key-map [XK_mute_asciicircum] compose-circumflex-map)
280 ;; (define-dead-key-map [XK_mute_asciitilde] compose-tilde-map)
281 ;; )
282 ;;
283 ;;;; Xfree seems to use lower case and a hyphen
284 ;;(when (x-valid-keysym-name-p "dead-tilde")
285 ;; (define-dead-key-map [dead-acute] compose-acute-map)
286 ;; (define-dead-key-map [dead-grave] compose-grave-map)
287 ;; (define-dead-key-map [dead-cedilla] compose-cedilla-map)
288 ;; (define-dead-key-map [dead-diaeresis] compose-diaeresis-map)
289 ;; (define-dead-key-map [dead-circum] compose-circumflex-map)
290 ;; (define-dead-key-map [dead-tilde] compose-tilde-map)
291 ;; )
292
293
294
295 ;;; The contents of the "dead key" maps. These are shared by the
296 ;;; compose-map.
297
298 (define-key compose-acute-map [space] "'")
299 (define-key compose-acute-map [?'] [acute])
300 (define-key compose-acute-map [?A] [Aacute])
301 (define-key compose-acute-map [E] [Eacute])
302 (define-key compose-acute-map [I] [Iacute])
303 (define-key compose-acute-map [O] [Oacute])
304 (define-key compose-acute-map [U] [Uacute])
305 (define-key compose-acute-map [Y] [Yacute])
306 (define-key compose-acute-map [a] [aacute])
307 (define-key compose-acute-map [e] [eacute])
308 (define-key compose-acute-map [i] [iacute])
309 (define-key compose-acute-map [o] [oacute])
310 (define-key compose-acute-map [u] [uacute])
311 (define-key compose-acute-map [y] [yacute])
312
313 (define-key compose-grave-map [space] "`")
314 (define-key compose-grave-map [?`] [grave])
315 (define-key compose-grave-map [A] [Agrave])
316 (define-key compose-grave-map [E] [Egrave])
317 (define-key compose-grave-map [I] [Igrave])
318 (define-key compose-grave-map [O] [Ograve])
319 (define-key compose-grave-map [U] [Ugrave])
320 (define-key compose-grave-map [a] [agrave])
321 (define-key compose-grave-map [e] [egrave])
322 (define-key compose-grave-map [i] [igrave])
323 (define-key compose-grave-map [o] [ograve])
324 (define-key compose-grave-map [u] [ugrave])
325
326 (define-key compose-cedilla-map [space] ",")
327 (define-key compose-cedilla-map [?,] [cedilla])
328 (define-key compose-cedilla-map [C] [Ccedilla])
329 (define-key compose-cedilla-map [c] [ccedilla])
330
331 (define-key compose-diaeresis-map [space] [diaeresis])
332 (define-key compose-diaeresis-map [?\"] [diaeresis])
333 (define-key compose-diaeresis-map [A] [Adiaeresis])
334 (define-key compose-diaeresis-map [E] [Ediaeresis])
335 (define-key compose-diaeresis-map [I] [Idiaeresis])
336 (define-key compose-diaeresis-map [O] [Odiaeresis])
337 (define-key compose-diaeresis-map [U] [Udiaeresis])
338 (define-key compose-diaeresis-map [a] [adiaeresis])
339 (define-key compose-diaeresis-map [e] [ediaeresis])
340 (define-key compose-diaeresis-map [i] [idiaeresis])
341 (define-key compose-diaeresis-map [o] [odiaeresis])
342 (define-key compose-diaeresis-map [u] [udiaeresis])
343 (define-key compose-diaeresis-map [y] [ydiaeresis])
344
345 (define-key compose-circumflex-map [space] "^")
346 (define-key compose-circumflex-map [?/] "|")
347 (define-key compose-circumflex-map [?!] [brokenbar])
348 (define-key compose-circumflex-map [?-] [macron])
349 (define-key compose-circumflex-map [?_] [macron])
350 (define-key compose-circumflex-map [?0] [degree])
351 (define-key compose-circumflex-map [?1] [onesuperior])
352 (define-key compose-circumflex-map [?2] [twosuperior])
353 (define-key compose-circumflex-map [?3] [threesuperior])
354 (define-key compose-circumflex-map [?.] [periodcentered])
355 (define-key compose-circumflex-map [A] [Acircumflex])
356 (define-key compose-circumflex-map [E] [Ecircumflex])
357 (define-key compose-circumflex-map [I] [Icircumflex])
358 (define-key compose-circumflex-map [O] [Ocircumflex])
359 (define-key compose-circumflex-map [U] [Ucircumflex])
360 (define-key compose-circumflex-map [a] [acircumflex])
361 (define-key compose-circumflex-map [e] [ecircumflex])
362 (define-key compose-circumflex-map [i] [icircumflex])
363 (define-key compose-circumflex-map [o] [ocircumflex])
364 (define-key compose-circumflex-map [u] [ucircumflex])
365
366 (define-key compose-tilde-map [space] "~")
367 (define-key compose-tilde-map [A] [Atilde])
368 (define-key compose-tilde-map [N] [Ntilde])
369 (define-key compose-tilde-map [O] [Otilde])
370 (define-key compose-tilde-map [a] [atilde])
371 (define-key compose-tilde-map [n] [ntilde])
372 (define-key compose-tilde-map [o] [otilde])
373
374 (define-key compose-ring-map [space] [degree])
375 (define-key compose-ring-map [A] [Aring])
376 (define-key compose-ring-map [a] [aring])
377
378
379 ;;; The rest of the compose-map. These are the composed characters
380 ;;; that are not accessible via "dead" keys.
381
382 (define-key compose-map " '" "'")
383 (define-key compose-map " ^" "^")
384 (define-key compose-map " `" "`")
385 (define-key compose-map " ~" "~")
386 (define-key compose-map " " [nobreakspace])
387 (define-key compose-map " \"" [diaeresis])
388 (define-key compose-map " :" [diaeresis])
389 (define-key compose-map " *" [degree])
390
391 (define-key compose-map "!!" [exclamdown])
392 (define-key compose-map "!^" [brokenbar])
393 (define-key compose-map "!S" [section])
394 (define-key compose-map "!s" [section])
395 (define-key compose-map "!P" [paragraph])
396 (define-key compose-map "!p" [paragraph])
397
398 (define-key compose-map "((" "[")
399 (define-key compose-map "(-" "{")
400
401 (define-key compose-map "))" "]")
402 (define-key compose-map ")-" "}")
403
404 (define-key compose-map "++" "#")
405 (define-key compose-map "+-" [plusminus])
406
407 (define-key compose-map "-(" "{")
408 (define-key compose-map "-)" "}")
409 (define-key compose-map "--" "-")
410 (define-key compose-map "-L" [sterling])
411 (define-key compose-map "-l" [sterling])
412 (define-key compose-map "-Y" [yen])
413 (define-key compose-map "-y" [yen])
414 (define-key compose-map "-," [notsign])
415 (define-key compose-map "-|" [notsign])
416 (define-key compose-map "-^" [macron])
417 (define-key compose-map "-+" [plusminus])
418 (define-key compose-map "-:" [division])
419 (define-key compose-map "-D" [ETH])
420 (define-key compose-map "-d" [eth])
421 (define-key compose-map "-a" [ordfeminine])
422
423 (define-key compose-map ".^" [periodcentered])
424
425 (define-key compose-map "//" "\\")
426 (define-key compose-map "/<" "\\")
427 (define-key compose-map "/^" "|")
428 (define-key compose-map "/C" [cent])
429 (define-key compose-map "/c" [cent])
430 (define-key compose-map "/U" [mu])
431 (define-key compose-map "/u" [mu])
432 (define-key compose-map "/O" [Ooblique])
433 (define-key compose-map "/o" [oslash])
434
435 (define-key compose-map "0X" [currency])
436 (define-key compose-map "0x" [currency])
437 (define-key compose-map "0S" [section])
438 (define-key compose-map "0s" [section])
439 (define-key compose-map "0C" [copyright])
440 (define-key compose-map "0c" [copyright])
441 (define-key compose-map "0R" [registered])
442 (define-key compose-map "0r" [registered])
443 (define-key compose-map "0^" [degree])
444
445 (define-key compose-map "1^" [onesuperior])
446 (define-key compose-map "14" [onequarter])
447 (define-key compose-map "12" [onehalf])
448
449 (define-key compose-map "2^" [twosuperior])
450
451 (define-key compose-map "3^" [threesuperior])
452 (define-key compose-map "34" [threequarters])
453
454 (define-key compose-map ":-" [division])
455
456 (define-key compose-map "</" "\\")
457 (define-key compose-map "<<" [guillemotleft])
458
459 (define-key compose-map "=L" [sterling])
460 (define-key compose-map "=l" [sterling])
461 (define-key compose-map "=Y" [yen])
462 (define-key compose-map "=y" [yen])
463
464 (define-key compose-map ">>" [guillemotright])
465
466 (define-key compose-map "??" [questiondown])
467
468 (define-key compose-map "AA" "@")
469 (define-key compose-map "Aa" "@")
470 (define-key compose-map "A_" [ordfeminine])
471 (define-key compose-map "A`" [Agrave])
472 (define-key compose-map "A'" [Aacute])
473 (define-key compose-map "A^" [Acircumflex])
474 (define-key compose-map "A~" [Atilde])
475 (define-key compose-map "A\"" [Adiaeresis])
476 (define-key compose-map "A*" [Aring])
477 (define-key compose-map "AE" [AE])
478
479 (define-key compose-map "C/" [cent])
480 (define-key compose-map "C|" [cent])
481 (define-key compose-map "C0" [copyright])
482 (define-key compose-map "CO" [copyright])
483 (define-key compose-map "Co" [copyright])
484 (define-key compose-map "C," [Ccedilla])
485
486 (define-key compose-map "D-" [ETH])
487
488 (define-key compose-map "E`" [Egrave])
489 (define-key compose-map "E'" [Eacute])
490 (define-key compose-map "E^" [Ecircumflex])
491 (define-key compose-map "E\"" [Ediaeresis])
492
493 (define-key compose-map "I`" [Igrave])
494 (define-key compose-map "I'" [Iacute])
495 (define-key compose-map "I^" [Icircumflex])
496 (define-key compose-map "I\"" [Idiaeresis])
497
498 (define-key compose-map "L-" [sterling])
499 (define-key compose-map "L=" [sterling])
500
501 (define-key compose-map "N~" [Ntilde])
502
503 (define-key compose-map "OX" [currency])
504 (define-key compose-map "Ox" [currency])
505 (define-key compose-map "OS" [section])
506 (define-key compose-map "Os" [section])
507 (define-key compose-map "OC" [copyright])
508 (define-key compose-map "Oc" [copyright])
509 (define-key compose-map "OR" [registered])
510 (define-key compose-map "Or" [registered])
511 (define-key compose-map "O_" [masculine])
512 (define-key compose-map "O`" [Ograve])
513 (define-key compose-map "O'" [Oacute])
514 (define-key compose-map "O^" [Ocircumflex])
515 (define-key compose-map "O~" [Otilde])
516 (define-key compose-map "O\"" [Odiaeresis])
517 (define-key compose-map "O/" [Ooblique])
518
519 (define-key compose-map "P!" [paragraph])
520
521 (define-key compose-map "R0" [registered])
522 (define-key compose-map "RO" [registered])
523 (define-key compose-map "Ro" [registered])
524
525 (define-key compose-map "S!" [section])
526 (define-key compose-map "S0" [section])
527 (define-key compose-map "SO" [section])
528 (define-key compose-map "So" [section])
529 (define-key compose-map "SS" [ssharp])
530
531 (define-key compose-map "TH" [THORN])
532
533 (define-key compose-map "U`" [Ugrave])
534 (define-key compose-map "U'" [Uacute])
535 (define-key compose-map "U^" [Ucircumflex])
536 (define-key compose-map "U\"" [Udiaeresis])
537
538 (define-key compose-map "X0" [currency])
539 (define-key compose-map "XO" [currency])
540 (define-key compose-map "Xo" [currency])
541
542 (define-key compose-map "Y-" [yen])
543 (define-key compose-map "Y=" [yen])
544 (define-key compose-map "Y'" [Yacute])
545
546 (define-key compose-map "_A" [ordfeminine])
547 (define-key compose-map "_a" [ordfeminine])
548 (define-key compose-map "_^" [macron])
549 (define-key compose-map "_O" [masculine])
550 (define-key compose-map "_o" [masculine])
551
552 (define-key compose-map "aA" "@")
553 (define-key compose-map "aa" "@")
554 (define-key compose-map "a_" [ordfeminine])
555 (define-key compose-map "a-" [ordfeminine])
556 (define-key compose-map "a`" [agrave])
557 (define-key compose-map "a'" [aacute])
558 (define-key compose-map "a^" [acircumflex])
559 (define-key compose-map "a~" [atilde])
560 (define-key compose-map "a\"" [adiaeresis])
561 (define-key compose-map "a*" [aring])
562 (define-key compose-map "ae" [ae])
563
564 (define-key compose-map "c/" [cent])
565 (define-key compose-map "c|" [cent])
566 (define-key compose-map "c0" [copyright])
567 (define-key compose-map "cO" [copyright])
568 (define-key compose-map "co" [copyright])
569 (define-key compose-map "c," [ccedilla])
570
571 (define-key compose-map "d-" [eth])
572
573 (define-key compose-map "e`" [egrave])
574 (define-key compose-map "e'" [eacute])
575 (define-key compose-map "e^" [ecircumflex])
576 (define-key compose-map "e\"" [ediaeresis])
577
578 (define-key compose-map "i`" [igrave])
579 (define-key compose-map "i'" [iacute])
580 (define-key compose-map "i^" [icircumflex])
581 (define-key compose-map "i\"" [idiaeresis])
582 (define-key compose-map "i:" [idiaeresis])
583
584 (define-key compose-map "l-" [sterling])
585 (define-key compose-map "l=" [sterling])
586
587 (define-key compose-map "n~" [ntilde])
588
589 (define-key compose-map "oX" [currency])
590 (define-key compose-map "ox" [currency])
591 (define-key compose-map "oC" [copyright])
592 (define-key compose-map "oc" [copyright])
593 (define-key compose-map "oR" [registered])
594 (define-key compose-map "or" [registered])
595 (define-key compose-map "oS" [section])
596 (define-key compose-map "os" [section])
597 (define-key compose-map "o_" [masculine])
598 (define-key compose-map "o`" [ograve])
599 (define-key compose-map "o'" [oacute])
600 (define-key compose-map "o^" [ocircumflex])
601 (define-key compose-map "o~" [otilde])
602 (define-key compose-map "o\"" [odiaeresis])
603 (define-key compose-map "o/" [oslash])
604
605 (define-key compose-map "p!" [paragraph])
606
607 (define-key compose-map "r0" [registered])
608 (define-key compose-map "rO" [registered])
609 (define-key compose-map "ro" [registered])
610
611 (define-key compose-map "s!" [section])
612 (define-key compose-map "s0" [section])
613 (define-key compose-map "sO" [section])
614 (define-key compose-map "so" [section])
615 (define-key compose-map "ss" [ssharp])
616
617 (define-key compose-map "th" [thorn])
618
619 (define-key compose-map "u`" [ugrave])
620 (define-key compose-map "u'" [uacute])
621 (define-key compose-map "u^" [ucircumflex])
622 (define-key compose-map "u\"" [udiaeresis])
623 (define-key compose-map "u/" [mu])
624
625 (define-key compose-map "x0" [currency])
626 (define-key compose-map "xO" [currency])
627 (define-key compose-map "xo" [currency])
628 (define-key compose-map "xx" [multiply])
629
630 (define-key compose-map "y-" [yen])
631 (define-key compose-map "y=" [yen])
632 (define-key compose-map "y'" [yacute])
633 (define-key compose-map "y\"" [ydiaeresis])
634
635 (define-key compose-map "|C" [cent])
636 (define-key compose-map "|c" [cent])
637 (define-key compose-map "||" [brokenbar])
638
639
640 ;; Suppose we type these three physical keys: [Multi_key " a]
641 ;; Xlib can deliver these keys as the following sequences of keysyms:
642 ;;
643 ;; - [Multi_key " a] (no surprise here)
644 ;; - [adiaeresis] (OK, Xlib is doing compose processing for us)
645 ;; - [Multi_key " adiaeresis] (Huh?)
646 ;;
647 ;; It is the last possibility that is arguably a bug. Xlib can't
648 ;; decide whether it's really doing compose processing or not (or
649 ;; actually, different parts of Xlib disagree).
650 ;;
651 ;; So we'll just convert [Multi_key " adiaeresis] to [adiaeresis]
652 (defun xlib-input-method-bug-workaround (keymap)
653 (map-keymap
654 (lambda (key value)
655 (cond
656 ((keymapp value)
657 (xlib-input-method-bug-workaround value))
658 ((and (sequencep value)
659 (eq 1 (length value))
660 (null (lookup-key keymap value)))
661 (define-key keymap value value))))
662 keymap))
663 (xlib-input-method-bug-workaround compose-map)
664 (unintern 'xlib-input-method-bug-workaround)
665
666 ;; While we're at it, a similar mechanism will make colon equivalent
667 ;; to doublequote for diaeresis processing. Some Xlibs do this.
668 (defun alias-colon-to-doublequote (keymap)
669 (map-keymap
670 (lambda (key value)
671 (when (keymapp value)
672 (alias-colon-to-doublequote value))
673 (when (eq key '\")
674 (define-key keymap ":" value)))
675 keymap))
676 (alias-colon-to-doublequote compose-map)
677 (unintern 'alias-colon-to-doublequote)
678
679 ;;; Electric dead keys: making a' mean a-acute.
680
681
682 (defun electric-diacritic (&optional count)
683 "Modify the previous character with an accent.
684 For example, if `:' is bound to this command, then typing `a:'
685 will first insert `a' and then turn it into `\344' (adiaeresis).
686 The keys to which this command may be bound (and the accents
687 which it understands) are:
688
689 ' (acute) \301\311\315\323\332\335 \341\351\355\363\372\375
690 ` (grave) \300\310\314\322\331 \340\350\354\362\371
691 : (diaeresis) \304\313\317\326\334 \344\353\357\366\374\377
692 ^ (circumflex) \302\312\316\324\333 \342\352\356\364\373
693 , (cedilla) \307\347
694 . (ring) \305\345"
695 (interactive "p")
696 (or count (setq count 1))
697
698 (if (not (eq last-command 'self-insert-command))
699 ;; Only do the magic if the two chars were typed in succession.
700 (self-insert-command count)
701
702 ;; This is so that ``a : C-x u'' will transform `adiaeresis' back into `a:'
703 (self-insert-command count)
704 (undo-boundary)
705 (delete-char (- count))
706
707 (let* ((c last-command-char)
708 (map (cond ((eq c ?') compose-acute-map)
709 ((eq c ?`) compose-grave-map)
710 ((eq c ?,) compose-cedilla-map)
711 ((eq c ?:) compose-diaeresis-map)
712 ((eq c ?^) compose-circumflex-map)
713 ((eq c ?~) compose-tilde-map)
714 ((eq c ?.) compose-ring-map)
715 (t (error "unknown diacritic: %s (%c)" c c))))
716 (base-char (preceding-char))
717 (mod-char (and (>= (downcase base-char) ?a) ; only do alphabetics?
718 (<= (downcase base-char) ?z)
719 (lookup-key map (make-string 1 base-char)))))
720 (if (and (vectorp mod-char) (= (length mod-char) 1))
721 (setq mod-char (aref mod-char 0)))
722 (if (and mod-char (symbolp mod-char))
723 (setq mod-char (or (get mod-char character-set-property) mod-char)))
724 (if (and mod-char (> count 0))
725 (delete-char -1)
726 (setq mod-char c))
727 (while (> count 0)
728 (insert mod-char)
729 (setq count (1- count))))))
730
731 ;; should "::" mean "¨" and ": " mean ":"?
732 ;; should we also do
733 ;; (?~
734 ;; (?A "\303")
735 ;; (?C "\307")
736 ;; (?D "\320")
737 ;; (?N "\321")
738 ;; (?O "\325")
739 ;; (?a "\343")
740 ;; (?c "\347")
741 ;; (?d "\360")
742 ;; (?n "\361")
743 ;; (?o "\365")
744 ;; (?> "\273")
745 ;; (?< "\253")
746 ;; (? "~")) ; no special code
747 ;; (?\/
748 ;; (?A "\305") ;; A-with-ring (Norwegian and Danish)
749 ;; (?E "\306") ;; AE-ligature (Norwegian and Danish)
750 ;; (?O "\330")
751 ;; (?a "\345") ;; a-with-ring (Norwegian and Danish)
752 ;; (?e "\346") ;; ae-ligature (Norwegian and Danish)
753 ;; (?o "\370")
754 ;; (? "/")) ; no special code
755
756
757 ;;; Providing help in the middle of a compose sequence. (Way cool.)
758
759 (eval-when-compile
760 (defsubst next-composable-event ()
761 (let (event)
762 (while (progn
763 (setq event (next-command-event))
764 (not (or (key-press-event-p event)
765 (button-press-event-p event))))
766 (dispatch-event event))
767 event)))
768
769 (defun compose-help (ignore-prompt)
770 (let* ((keys (apply 'vector (nbutlast (append (this-command-keys) nil))))
771 (map (or (lookup-key function-key-map keys)
772 (error "can't find map? %s %s" keys (this-command-keys))))
773 binding)
774 (save-excursion
775 (with-output-to-temp-buffer "*Help*"
776 (set-buffer "*Help*")
777 (erase-buffer)
778 (message "Working...")
779 (setq ctl-arrow 'compose) ; non-t-non-nil
780 (insert "You are typing a compose sequence. So far you have typed: ")
781 (insert (key-description keys))
782 (insert "\nCompletions from here are:\n\n")
783 (map-keymap 'compose-help-mapper map t)
784 (message "? ")))
785 (while (keymapp map)
786 (setq binding (lookup-key map (vector (next-composable-event))))
787 (if (null binding)
788 (message "No such key in keymap. Try again.")
789 (setq map binding)))
790 binding))
791
792 (put 'compose-help 'isearch-command t) ; so that it doesn't terminate isearch
793
794 (defun compose-help-mapper (key binding)
795 (if (and (symbolp key)
796 (get key character-set-property))
797 (setq key (get key character-set-property)))
798 (if (eq binding 'compose-help) ; suppress that...
799 nil
800 (if (keymapp binding)
801 (let ((p (point)))
802 (map-keymap 'compose-help-mapper binding t)
803 (goto-char p)
804 (while (not (eobp))
805 (if (characterp key)
806 (insert (make-string 1 key))
807 (insert (single-key-description key)))
808 (insert " ")
809 (forward-line 1)))
810 (if (characterp key)
811 (insert (make-string 1 key))
812 (insert (single-key-description key)))
813 (indent-to 16)
814 (let ((code (and (vectorp binding)
815 (= 1 (length binding))
816 (get (aref binding 0) character-set-property))))
817 (if code
818 (insert (make-string 1 code))
819 (if (stringp binding)
820 (insert binding)
821 (insert (prin1-to-string binding)))))
822 (when (and (vectorp binding) (= 1 (length binding)))
823 (indent-to 32)
824 (insert (symbol-name (aref binding 0)))))
825 (insert "\n")))
826
827 ;; define it at top-level in the compose map...
828 ;;(define-key compose-map [(control h)] 'compose-help)
829 ;;(define-key compose-map [help] 'compose-help)
830 ;; and then define it in each sub-map of the compose map.
831 (map-keymap
832 (lambda (key binding)
833 (when (keymapp binding)
834 ;; (define-key binding [(control h)] 'compose-help)
835 ;; (define-key binding [help] 'compose-help)
836 ))
837 compose-map nil)
838
839 ;; Make redisplay display the accented letters
840 (if (memq (default-value 'ctl-arrow) '(t nil))
841 (setq-default ctl-arrow 'iso-8859/1))
842
843
844 (provide 'x-compose)
845
846 ;;; x-compose.el ends here