home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / x11 / x-compose.el next >
Encoding:
Text File  |  1995-05-05  |  29.9 KB  |  776 lines
  1. ;; Compose-key processing in emacs.
  2. ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of XEmacs.
  5.  
  6. ;; XEmacs is free software; you can redistribute it and/or modify it
  7. ;; under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 2, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; XEmacs is distributed in the hope that it will be useful, but
  12. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14. ;; General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  18. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. ;;; created by jwz, 14-jun-92.
  21.  
  22. ;;; This file implements DEC-, OpenWindows-, and HP-compatible "Compose"
  23. ;;; processing for XEmacs.  
  24. ;;;
  25. ;;; If you are running a version of X which already does compose processing,
  26. ;;; then you don't need this file.  But the MIT R4 and R5 distributions don't
  27. ;;; do compose processing, so you may want to fake it by using this code.
  28. ;;;
  29. ;;; The basic idea is that there are several ways to generate keysyms which
  30. ;;; do not have keys devoted to them on your keyboard.
  31. ;;;
  32. ;;; The first method is by using "dead" keys.  A dead key is a key which,
  33. ;;; when typed, does not insert a character.  Instead it modifies the
  34. ;;; following character typed.  So if you typed "dead-tilde" followed by "A",
  35. ;;; then "A-tilde" would be inserted.  Of course, this requires you to modify
  36. ;;; your keyboard to include a "dead-tilde" key on it somewhere.
  37. ;;;
  38. ;;; The second method is by using a "Compose" key.  With a Compose key, you
  39. ;;; would type "Compose" then "tilde" then "A" to insert "A-tilde".
  40. ;;;
  41. ;;; There are a small number of dead keys: acute, grave, cedilla, diaeresis,
  42. ;;; circumflex, tilde, and ring.  There are a larger number of accented and
  43. ;;; other characters accessible via the Compose key, so both are useful.
  44. ;;;
  45. ;;; To use this code, you will need to have a Compose key on your keyboard.
  46. ;;; The default configuration of most X keyboards doesn't contain one.  You
  47. ;;; can, for example, turn the right "Meta" key into a "Compose" key with
  48. ;;; this command:
  49. ;;;
  50. ;;;    xmodmap -e "remove mod1 = Meta_R" -e "keysym Meta_R = Multi_key"
  51. ;;;
  52. ;;; Multi_key is the name that X (and emacs) know the "Compose" key by.
  53. ;;; The "remove..." command is necessary because the "Compose" key must not
  54. ;;; have any modifier bits associated with it.  This exact command may not
  55. ;;; work, depending on what system and keyboard you are using.  If it
  56. ;;; doesn't, you'll have to read the man page for xmodmap.  You might want
  57. ;;; to get the "xkeycaps" program from the host export.lcs.mit.edu in the
  58. ;;; file contrib/xkeycaps.tar.Z, which is a graphical front end to xmodmap
  59. ;;; that hides xmodmap's arcane syntax from you.
  60. ;;;
  61. ;;; If for some reason you don't want to have a dedicated compose key on your
  62. ;;; keyboard, you can use some other key as the prefix.  For example, to make
  63. ;;; "Meta-Shift-C" act as a compose key (so that "M-C , c" would insert the
  64. ;;; character "ccedilla") you could do
  65. ;;;
  66. ;;;    (global-set-key "\M-C" compose-map)
  67. ;;;
  68. ;;; I believe the bindings encoded in this file are the same as those used
  69. ;;; by OpenWindows versions 2 and 3, and DEC VT320 terminals.  Please let me
  70. ;;; know if you think otherwise.
  71. ;;;
  72. ;;; Much thanks to Justin Bur <justin@crim.ca> for helping me understand how
  73. ;;; this stuff is supposed to work.
  74. ;;;
  75. ;;; You also might want to consider getting Justin's patch for the MIT Xlib
  76. ;;; that implements compose processing in the library.  This will enable
  77. ;;; compose processing in applications other than emacs as well.  You can
  78. ;;; get it from export.lcs.mit.edu in contrib/compose.tar.Z.
  79.  
  80. ;;; This code has one feature that a more "builtin" Compose mechanism could
  81. ;;; not have: at any point you can type C-h to get a list of the possible
  82. ;;; completions of what you have typed so far.
  83.  
  84. (require 'x-iso8859-1)
  85.  
  86. (defvar compose-map        (make-keymap))
  87. (defvar compose-acute-map    (make-sparse-keymap))
  88. (defvar compose-grave-map    (make-sparse-keymap))
  89. (defvar compose-cedilla-map    (make-sparse-keymap))
  90. (defvar compose-diaeresis-map    (make-sparse-keymap))
  91. (defvar compose-circumflex-map    (make-sparse-keymap))
  92. (defvar compose-tilde-map    (make-sparse-keymap))
  93. (defvar compose-ring-map    (make-sparse-keymap))
  94.  
  95. ;;; The command `compose-key' exists so that this file may be autoloaded.
  96. ;;;this doesn't work yet###autoload
  97. (define-function 'compose-key compose-map)
  98.  
  99. ;; The "Compose" key:
  100. ;; (keysym is lower case because we downcase everything in the Symbol font...)
  101. ;;
  102. ;;;this doesn't work yet###autoload
  103. (define-key global-map [multi_key]    'compose-key)
  104.  
  105. ;; The "Dead" keys:
  106. ;;
  107. (define-key global-map [acute]        compose-acute-map)
  108. (define-key global-map [cedilla]    compose-cedilla-map)
  109. (define-key global-map [diaeresis]    compose-diaeresis-map)
  110. (define-key global-map [degree]        compose-ring-map)
  111.  
  112. ;; The dead keys as seen by the "Compose" map:
  113. ;;
  114. (define-key compose-map [acute]        compose-acute-map)
  115. (define-key compose-map [cedilla]    compose-cedilla-map)
  116. (define-key compose-map [diaeresis]    compose-diaeresis-map)
  117. (define-key compose-map [degree]    compose-ring-map)
  118.  
  119. (define-key compose-map "'"        compose-acute-map)
  120. (define-key compose-map "`"        compose-grave-map)
  121. (define-key compose-map ","        compose-cedilla-map)
  122. (define-key compose-map "\""        compose-diaeresis-map)
  123. (define-key compose-map "^"        compose-circumflex-map)
  124. (define-key compose-map "~"        compose-tilde-map)
  125. (define-key compose-map "*"        compose-ring-map)
  126.  
  127.  
  128. ;;; The dead keys might really be called just about anything, depending
  129. ;;; on the vendor.  MIT thinks that the prefixes are "SunFA_", "D", and
  130. ;;; "hpmute_" for Sun, DEC, and HP respectively.  However, OpenWindows 3
  131. ;;; thinks that the prefixes are "SunXK_FA_", "DXK_", and "hpXK_mute_".
  132. ;;; And HP (who don't mention Sun and DEC at all) use "XK_mute_".
  133. ;;; Go figure.
  134.  
  135. ;;; Presumably if someone is running OpenWindows, they won't be using
  136. ;;; the DEC or HP keysyms, but if they are defined then that is possible,
  137. ;;; so in that case we accept them all.
  138.  
  139. ;;; If things seem not to be working, you might want to check your
  140. ;;; /usr/lib/X11/XKeysymDB file to see if your vendor has an equally
  141. ;;; mixed up view of what these keys should be called.
  142.  
  143. ;; Sun according to MIT:
  144. ;;
  145. (cond ((x-valid-keysym-name-p "SunFA_Acute")
  146.        (define-key global-map  [SunFA_Acute]        compose-acute-map)
  147.        (define-key compose-map [SunFA_Acute]        compose-acute-map)
  148.        (define-key global-map  [SunFA_Grave]        compose-grave-map)
  149.        (define-key compose-map [SunFA_Grave]        compose-grave-map)
  150.        (define-key global-map  [SunFA_Cedilla]        compose-cedilla-map)
  151.        (define-key compose-map [SunFA_Cedilla]        compose-cedilla-map)
  152.        (define-key global-map  [SunFA_Diaeresis]    compose-diaeresis-map)
  153.        (define-key compose-map [SunFA_Diaeresis]    compose-diaeresis-map)
  154.        (define-key global-map  [SunFA_Circum]        compose-circumflex-map)
  155.        (define-key compose-map [SunFA_Circum]        compose-circumflex-map)
  156.        (define-key global-map  [SunFA_Tilde]        compose-tilde-map)
  157.        (define-key compose-map [SunFA_Tilde]        compose-tilde-map)
  158.        ))
  159.  
  160. ;; Sun according to OpenWindows 2:
  161. ;;
  162. (cond ((x-valid-keysym-name-p "Dead_Grave")
  163.        (define-key global-map  [Dead_Grave]        compose-grave-map)
  164.        (define-key compose-map [Dead_Grave]        compose-grave-map)
  165.        (define-key global-map  [Dead_Circum]        compose-circumflex-map)
  166.        (define-key compose-map [Dead_Circum]        compose-circumflex-map)
  167.        (define-key global-map  [Dead_Tilde]        compose-tilde-map)
  168.        (define-key compose-map [Dead_Tilde]        compose-tilde-map)
  169.        ))
  170.  
  171. ;; Sun according to OpenWindows 3:
  172. ;;
  173. (cond ((x-valid-keysym-name-p "SunXK_FA_Acute")
  174.        (define-key global-map  [SunXK_FA_Acute]        compose-acute-map)
  175.        (define-key compose-map [SunXK_FA_Acute]        compose-acute-map)
  176.        (define-key global-map  [SunXK_FA_Grave]        compose-grave-map)
  177.        (define-key compose-map [SunXK_FA_Grave]        compose-grave-map)
  178.        (define-key global-map  [SunXK_FA_Cedilla]    compose-cedilla-map)
  179.        (define-key compose-map [SunXK_FA_Cedilla]    compose-cedilla-map)
  180.        (define-key global-map  [SunXK_FA_Diaeresis]    compose-diaeresis-map)
  181.        (define-key compose-map [SunXK_FA_Diaeresis]    compose-diaeresis-map)
  182.        (define-key global-map  [SunXK_FA_Circum]    compose-circumflex-map)
  183.        (define-key compose-map [SunXK_FA_Circum]    compose-circumflex-map)
  184.        (define-key global-map  [SunXK_FA_Tilde]        compose-tilde-map)
  185.        (define-key compose-map [SunXK_FA_Tilde]        compose-tilde-map)
  186.        ))
  187.  
  188. ;; DEC according to MIT:
  189. ;;
  190. (cond ((x-valid-keysym-name-p "Dacute_accent")
  191.        (define-key global-map  [Dacute_accent]        compose-acute-map)
  192.        (define-key compose-map [Dacute_accent]        compose-acute-map)
  193.        (define-key global-map  [Dgrave_accent]        compose-grave-map)
  194.        (define-key compose-map [Dgrave_accent]        compose-grave-map)
  195.        (define-key global-map  [Dcedilla_accent]    compose-cedilla-map)
  196.        (define-key compose-map [Dcedilla_accent]    compose-cedilla-map)
  197.        (define-key global-map  [Dcircumflex_accent]    compose-circumflex-map)
  198.        (define-key compose-map [Dcircumflex_accent]    compose-circumflex-map)
  199.        (define-key global-map  [Dtilde]            compose-tilde-map)
  200.        (define-key compose-map [Dtilde]            compose-tilde-map)
  201.        (define-key global-map  [Dring_accent]        compose-ring-map)
  202.        (define-key compose-map [Dring_accent]        compose-ring-map)
  203.        ))
  204.  
  205. ;; DEC according to OpenWindows 3:
  206. ;;
  207. (cond ((x-valid-keysym-name-p "DXK_acute_accent")
  208.        (define-key global-map  [DXK_acute_accent]    compose-acute-map)
  209.        (define-key compose-map [DXK_acute_accent]    compose-acute-map)
  210.        (define-key global-map  [DXK_grave_accent]    compose-grave-map)
  211.        (define-key compose-map [DXK_grave_accent]    compose-grave-map)
  212.        (define-key global-map  [DXK_cedilla_accent]    compose-cedilla-map)
  213.        (define-key compose-map [DXK_cedilla_accent]    compose-cedilla-map)
  214.        (define-key global-map  [DXK_circumflex_accent]    compose-circumflex-map)
  215.        (define-key compose-map [DXK_circumflex_accent]    compose-circumflex-map)
  216.        (define-key global-map  [DXK_tilde]        compose-tilde-map)
  217.        (define-key compose-map [DXK_tilde]        compose-tilde-map)
  218.        (define-key global-map  [DXK_ring_accent]    compose-ring-map)
  219.        (define-key compose-map [DXK_ring_accent]    compose-ring-map)
  220.        ))
  221.  
  222. ;; HP according to MIT:
  223. ;;
  224. (cond ((x-valid-keysym-name-p "hpmute_acute")
  225.        (define-key global-map  [hpmute_acute]        compose-acute-map)
  226.        (define-key compose-map [hpmute_acute]        compose-acute-map)
  227.        (define-key global-map  [hpmute_grave]        compose-grave-map)
  228.        (define-key compose-map [hpmute_grave]        compose-grave-map)
  229.        (define-key global-map  [hpmute_diaeresis]    compose-diaeresis-map)
  230.        (define-key compose-map [hpmute_diaeresis]    compose-diaeresis-map)
  231.        (define-key global-map  [hpmute_asciicircum]    compose-circumflex-map)
  232.        (define-key compose-map [hpmute_asciicircum]    compose-circumflex-map)
  233.        (define-key global-map  [hpmute_asciitilde]    compose-tilde-map)
  234.        (define-key compose-map [hpmute_asciitilde]    compose-tilde-map)
  235.        ))
  236.  
  237. ;; HP according to OpenWindows 3:
  238. ;;
  239. (cond ((x-valid-keysym-name-p "hpXK_mute_acute")
  240.        (define-key global-map  [hpXK_mute_acute]    compose-acute-map)
  241.        (define-key compose-map [hpXK_mute_acute]    compose-acute-map)
  242.        (define-key global-map  [hpXK_mute_grave]    compose-grave-map)
  243.        (define-key compose-map [hpXK_mute_grave]    compose-grave-map)
  244.        (define-key global-map  [hpXK_mute_diaeresis]    compose-diaeresis-map)
  245.        (define-key compose-map [hpXK_mute_diaeresis]    compose-diaeresis-map)
  246.        (define-key global-map  [hpXK_mute_asciicircum]    compose-circumflex-map)
  247.        (define-key compose-map [hpXK_mute_asciicircum]    compose-circumflex-map)
  248.        (define-key global-map  [hpXK_mute_asciitilde]    compose-tilde-map)
  249.        (define-key compose-map [hpXK_mute_asciitilde]    compose-tilde-map)
  250.        ))
  251.  
  252. ;; HP according to HP-UX 8.0:
  253. ;;
  254. (cond ((x-valid-keysym-name-p "XK_mute_acute")
  255.        (define-key global-map  [XK_mute_acute]        compose-acute-map)
  256.        (define-key compose-map [XK_mute_acute]        compose-acute-map)
  257.        (define-key global-map  [XK_mute_grave]        compose-grave-map)
  258.        (define-key compose-map [XK_mute_grave]        compose-grave-map)
  259.        (define-key global-map  [XK_mute_diaeresis]    compose-diaeresis-map)
  260.        (define-key compose-map [XK_mute_diaeresis]    compose-diaeresis-map)
  261.        (define-key global-map  [XK_mute_asciicircum]    compose-circumflex-map)
  262.        (define-key compose-map [XK_mute_asciicircum]    compose-circumflex-map)
  263.        (define-key global-map  [XK_mute_asciitilde]    compose-tilde-map)
  264.        (define-key compose-map [XK_mute_asciitilde]    compose-tilde-map)
  265.        ))
  266.  
  267. ;;; The contents of the "dead key" maps.  These are shared by the
  268. ;;; compose-map.
  269.  
  270. (set-keymap-name compose-acute-map 'compose-acute-map)
  271. (define-key compose-acute-map " "    "'")
  272. (define-key compose-acute-map "'"    [acute])
  273. (define-key compose-acute-map "A"    [Aacute])
  274. (define-key compose-acute-map "E"    [Eacute])
  275. (define-key compose-acute-map "I"    [Iacute])
  276. (define-key compose-acute-map "O"    [Oacute])
  277. (define-key compose-acute-map "U"    [Uacute])
  278. (define-key compose-acute-map "Y"    [Yacute])
  279. (define-key compose-acute-map "a"    [aacute])
  280. (define-key compose-acute-map "e"    [eacute])
  281. (define-key compose-acute-map "i"    [iacute])
  282. (define-key compose-acute-map "o"    [oacute])
  283. (define-key compose-acute-map "u"    [uacute])
  284. (define-key compose-acute-map "y"    [yacute])
  285.  
  286. (set-keymap-name compose-grave-map 'compose-grave-map)
  287. (define-key compose-grave-map " "    [grave])
  288. (define-key compose-grave-map "A"    [Agrave])
  289. (define-key compose-grave-map "E"    [Egrave])
  290. (define-key compose-grave-map "I"    [Igrave])
  291. (define-key compose-grave-map "O"    [Ograve])
  292. (define-key compose-grave-map "U"    [Ugrave])
  293. (define-key compose-grave-map "a"    [agrave])
  294. (define-key compose-grave-map "e"    [egrave])
  295. (define-key compose-grave-map "i"    [igrave])
  296. (define-key compose-grave-map "o"    [ograve])
  297. (define-key compose-grave-map "u"    [ugrave])
  298.  
  299. (set-keymap-name compose-cedilla-map 'compose-cedilla-map)
  300. (define-key compose-cedilla-map ","    [cedilla])
  301. (define-key compose-cedilla-map "C"    [Ccedilla])
  302. (define-key compose-cedilla-map "c"    [ccedilla])
  303.  
  304. (set-keymap-name compose-diaeresis-map 'compose-diaeresis-map)
  305. (define-key compose-diaeresis-map " "    [diaeresis])
  306. (define-key compose-diaeresis-map "\""    [diaeresis])
  307. (define-key compose-diaeresis-map "A"    [Adiaeresis])
  308. (define-key compose-diaeresis-map "E"    [Ediaeresis])
  309. (define-key compose-diaeresis-map "I"    [Idiaeresis])
  310. (define-key compose-diaeresis-map "O"    [Odiaeresis])
  311. (define-key compose-diaeresis-map "U"    [Udiaeresis])
  312. (define-key compose-diaeresis-map "a"    [adiaeresis])
  313. (define-key compose-diaeresis-map "e"    [ediaeresis])
  314. (define-key compose-diaeresis-map "i"    [idiaeresis])
  315. (define-key compose-diaeresis-map "o"    [odiaeresis])
  316. (define-key compose-diaeresis-map "u"    [udiaeresis])
  317. (define-key compose-diaeresis-map "y"    [ydiaeresis])
  318.  
  319. (set-keymap-name compose-circumflex-map 'compose-circumflex-map)
  320. (define-key compose-circumflex-map " "    "^")
  321. (define-key compose-circumflex-map "/"    "|")
  322. (define-key compose-circumflex-map "!"    [brokenbar])
  323. (define-key compose-circumflex-map "-"    [macron])
  324. (define-key compose-circumflex-map "_"    [macron])
  325. (define-key compose-circumflex-map "0"    [degree])
  326. (define-key compose-circumflex-map "1"    [onesuperior])
  327. (define-key compose-circumflex-map "2"    [twosuperior])
  328. (define-key compose-circumflex-map "3"    [threesuperior])
  329. (define-key compose-circumflex-map "."    [periodcentered])
  330. (define-key compose-circumflex-map "A"    [Acircumflex])
  331. (define-key compose-circumflex-map "E"    [Ecircumflex])
  332. (define-key compose-circumflex-map "I"    [Icircumflex])
  333. (define-key compose-circumflex-map "O"    [Ocircumflex])
  334. (define-key compose-circumflex-map "U"    [Ucircumflex])
  335. (define-key compose-circumflex-map "a"    [acircumflex])
  336. (define-key compose-circumflex-map "e"    [ecircumflex])
  337. (define-key compose-circumflex-map "i"    [icircumflex])
  338. (define-key compose-circumflex-map "o"    [ocircumflex])
  339. (define-key compose-circumflex-map "u"    [ucircumflex])
  340.  
  341. (set-keymap-name compose-tilde-map 'compose-tilde-map)
  342. (define-key compose-tilde-map " "    "~")
  343. (define-key compose-tilde-map "A"    [Atilde])
  344. (define-key compose-tilde-map "N"    [Ntilde])
  345. (define-key compose-tilde-map "O"    [Otilde])
  346. (define-key compose-tilde-map "a"    [atilde])
  347. (define-key compose-tilde-map "n"    [ntilde])
  348. (define-key compose-tilde-map "o"    [otilde])
  349.  
  350. (set-keymap-name compose-ring-map 'compose-ring-map)
  351. (define-key compose-ring-map " "    [degree])
  352. (define-key compose-ring-map "A"    [Aring])
  353. (define-key compose-ring-map "a"    [aring])
  354.  
  355.  
  356. ;;; The rest of the compose-map.  These are the composed characters
  357. ;;; that are not accessible via "dead" keys.
  358.  
  359. (set-keymap-name compose-map 'compose-map)
  360. (define-key compose-map " '"    "'")
  361. (define-key compose-map " ^"    "^")
  362. (define-key compose-map " `"    "`")
  363. (define-key compose-map " ~"    "~")
  364. (define-key compose-map "  "    [nobreakspace])
  365. (define-key compose-map " \""    [diaeresis])
  366. (define-key compose-map " *"    [degree])
  367.  
  368. (define-key compose-map "!!"    [exclamdown])
  369. (define-key compose-map "!^"    [brokenbar])
  370. (define-key compose-map "!S"    [section])
  371. (define-key compose-map "!s"    [section])
  372. (define-key compose-map "!P"    [paragraph])
  373. (define-key compose-map "!p"    [paragraph])
  374.  
  375. (define-key compose-map "(("    "[")
  376. (define-key compose-map "(-"    "{")
  377.  
  378. (define-key compose-map "))"    "]")
  379. (define-key compose-map ")-"    "}")
  380.  
  381. (define-key compose-map "++"    "#")
  382. (define-key compose-map "+-"    [plusminus])
  383.  
  384. (define-key compose-map "-("    "{")
  385. (define-key compose-map "-)"    "}")
  386. (define-key compose-map "--"    "-")
  387. (define-key compose-map "-L"    [sterling])
  388. (define-key compose-map "-l"    [sterling])
  389. (define-key compose-map "-Y"    [yen])
  390. (define-key compose-map "-y"    [yen])
  391. (define-key compose-map "-,"    [notsign])
  392. (define-key compose-map "-|"    [notsign])
  393. (define-key compose-map "-^"    [macron])
  394. (define-key compose-map "-+"    [plusminus])
  395. (define-key compose-map "-:"    [division])
  396. (define-key compose-map "-D"    [ETH])
  397. (define-key compose-map "-d"    [eth])
  398. (define-key compose-map "-a"    [ordfeminine])
  399.  
  400. (define-key compose-map ".^"    [periodcentered])
  401.  
  402. (define-key compose-map "//"    "\\")
  403. (define-key compose-map "/<"    "\\")
  404. (define-key compose-map "/^"    "|")
  405. (define-key compose-map "/C"    [cent])
  406. (define-key compose-map "/c"    [cent])
  407. (define-key compose-map "/U"    [mu])
  408. (define-key compose-map "/u"    [mu])
  409. (define-key compose-map "/O"    [Ooblique])
  410. (define-key compose-map "/o"    [oslash])
  411.  
  412. (define-key compose-map "0X"    [currency])
  413. (define-key compose-map "0x"    [currency])
  414. (define-key compose-map "0S"    [section])
  415. (define-key compose-map "0s"    [section])
  416. (define-key compose-map "0C"    [copyright])
  417. (define-key compose-map "0c"    [copyright])
  418. (define-key compose-map "0R"    [registered])
  419. (define-key compose-map "0r"    [registered])
  420. (define-key compose-map "0^"    [degree])
  421.  
  422. (define-key compose-map "1^"    [onesuperior])
  423. (define-key compose-map "14"    [onequarter])
  424. (define-key compose-map "12"    [onehalf])
  425.  
  426. (define-key compose-map "2^"    [twosuperior])
  427.  
  428. (define-key compose-map "3^"    [threesuperior])
  429. (define-key compose-map "34"    [threequarters])
  430.  
  431. (define-key compose-map ":-"    [division])
  432.  
  433. (define-key compose-map "</"    "\\")
  434. (define-key compose-map "<<"    [guillemotleft])
  435.  
  436. (define-key compose-map "=L"    [sterling])
  437. (define-key compose-map "=l"    [sterling])
  438. (define-key compose-map "=Y"    [yen])
  439. (define-key compose-map "=y"    [yen])
  440.  
  441. (define-key compose-map ">>"    [guillemotright])
  442.  
  443. (define-key compose-map "??"    [questiondown])
  444.  
  445. (define-key compose-map "AA"    "@")
  446. (define-key compose-map "Aa"    "@")
  447. (define-key compose-map "A_"    [ordfeminine])
  448. (define-key compose-map "A`"    [Agrave])
  449. (define-key compose-map "A'"    [Aacute])
  450. (define-key compose-map "A^"    [Acircumflex])
  451. (define-key compose-map "A~"    [Atilde])
  452. (define-key compose-map "A\""    [Adiaeresis])
  453. (define-key compose-map "A*"    [Aring])
  454. (define-key compose-map "AE"    [AE])
  455.  
  456. (define-key compose-map "C/"    [cent])
  457. (define-key compose-map "C|"    [cent])
  458. (define-key compose-map "C0"    [copyright])
  459. (define-key compose-map "CO"    [copyright])
  460. (define-key compose-map "Co"    [copyright])
  461. (define-key compose-map "C,"    [Ccedilla])
  462.  
  463. (define-key compose-map "D-"    [ETH])
  464.  
  465. (define-key compose-map "E`"    [Egrave])
  466. (define-key compose-map "E'"    [Eacute])
  467. (define-key compose-map "E^"    [Ecircumflex])
  468. (define-key compose-map "E\""    [Ediaeresis])
  469.  
  470. (define-key compose-map "I`"    [Igrave])
  471. (define-key compose-map "I'"    [Iacute])
  472. (define-key compose-map "I^"    [Icircumflex])
  473. (define-key compose-map "I\""    [Idiaeresis])
  474.  
  475. (define-key compose-map "L-"    [sterling])
  476. (define-key compose-map "L="    [sterling])
  477.  
  478. (define-key compose-map "N~"    [Ntilde])
  479.  
  480. (define-key compose-map "OX"    [currency])
  481. (define-key compose-map "Ox"    [currency])
  482. (define-key compose-map "OS"    [section])
  483. (define-key compose-map "Os"    [section])
  484. (define-key compose-map "OC"    [copyright])
  485. (define-key compose-map "Oc"    [copyright])
  486. (define-key compose-map "OR"    [registered])
  487. (define-key compose-map "Or"    [registered])
  488. (define-key compose-map "O_"    [masculine])
  489. (define-key compose-map "O`"    [Ograve])
  490. (define-key compose-map "O'"    [Oacute])
  491. (define-key compose-map "O^"    [Ocircumflex])
  492. (define-key compose-map "O~"    [Otilde])
  493. (define-key compose-map "O\""    [Odiaeresis])
  494. (define-key compose-map "O/"    [Ooblique])
  495.  
  496. (define-key compose-map "P!"    [paragraph])
  497.  
  498. (define-key compose-map "R0"    [registered])
  499. (define-key compose-map "RO"    [registered])
  500. (define-key compose-map "Ro"    [registered])
  501.  
  502. (define-key compose-map "S!"    [section])
  503. (define-key compose-map "S0"    [section])
  504. (define-key compose-map "SO"    [section])
  505. (define-key compose-map "So"    [section])
  506. (define-key compose-map "SS"    [ssharp])
  507.  
  508. (define-key compose-map "TH"    [THORN])
  509.  
  510. (define-key compose-map "U`"    [Ugrave])
  511. (define-key compose-map "U'"    [Uacute])
  512. (define-key compose-map "U^"    [Ucircumflex])
  513. (define-key compose-map "U\""    [Udiaeresis])
  514.  
  515. (define-key compose-map "X0"    [currency])
  516. (define-key compose-map "XO"    [currency])
  517. (define-key compose-map "Xo"    [currency])
  518.  
  519. (define-key compose-map "Y-"    [yen])
  520. (define-key compose-map "Y="    [yen])
  521. (define-key compose-map "Y'"    [Yacute])
  522.  
  523. (define-key compose-map "_A"    [ordfeminine])
  524. (define-key compose-map "_a"    [ordfeminine])
  525. (define-key compose-map "_^"    [macron])
  526. (define-key compose-map "_O"    [masculine])
  527. (define-key compose-map "_o"    [masculine])
  528.  
  529. (define-key compose-map "aA"    "@")
  530. (define-key compose-map "aa"    "@")
  531. (define-key compose-map "a_"    [ordfeminine])
  532. (define-key compose-map "a-"    [ordfeminine])
  533. (define-key compose-map "a`"    [agrave])
  534. (define-key compose-map "a'"    [aacute])
  535. (define-key compose-map "a^"    [acircumflex])
  536. (define-key compose-map "a~"    [atilde])
  537. (define-key compose-map "a\""    [adiaeresis])
  538. (define-key compose-map "a*"    [aring])
  539. (define-key compose-map "ae"    [ae])
  540.  
  541. (define-key compose-map "c/"    [cent])
  542. (define-key compose-map "c|"    [cent])
  543. (define-key compose-map "c0"    [copyright])
  544. (define-key compose-map "cO"    [copyright])
  545. (define-key compose-map "co"    [copyright])
  546. (define-key compose-map "c,"    [ccedilla])
  547.  
  548. (define-key compose-map "d-"    [eth])
  549.  
  550. (define-key compose-map "e`"    [egrave])
  551. (define-key compose-map "e'"    [eacute])
  552. (define-key compose-map "e^"    [ecircumflex])
  553. (define-key compose-map "e\""    [ediaeresis])
  554.  
  555. (define-key compose-map "i`"    [igrave])
  556. (define-key compose-map "i'"    [iacute])
  557. (define-key compose-map "i^"    [icircumflex])
  558. (define-key compose-map "i\""    [idiaeresis])
  559.  
  560. (define-key compose-map "l-"    [sterling])
  561. (define-key compose-map "l="    [sterling])
  562.  
  563. (define-key compose-map "n~"    [ntilde])
  564.  
  565. (define-key compose-map "oX"    [currency])
  566. (define-key compose-map "ox"    [currency])
  567. (define-key compose-map "oC"    [copyright])
  568. (define-key compose-map "oc"    [copyright])
  569. (define-key compose-map "oR"    [registered])
  570. (define-key compose-map "or"    [registered])
  571. (define-key compose-map "oS"    [section])
  572. (define-key compose-map "os"    [section])
  573. (define-key compose-map "o_"    [masculine])
  574. (define-key compose-map "o`"    [ograve])
  575. (define-key compose-map "o'"    [oacute])
  576. (define-key compose-map "o^"    [ocircumflex])
  577. (define-key compose-map "o~"    [otilde])
  578. (define-key compose-map "o\""    [odiaeresis])
  579. (define-key compose-map "o/"    [oslash])
  580.  
  581. (define-key compose-map "p!"    [paragraph])
  582.  
  583. (define-key compose-map "r0"    [registered])
  584. (define-key compose-map "rO"    [registered])
  585. (define-key compose-map "ro"    [registered])
  586.  
  587. (define-key compose-map "s!"    [section])
  588. (define-key compose-map "s0"    [section])
  589. (define-key compose-map "sO"    [section])
  590. (define-key compose-map "so"    [section])
  591. (define-key compose-map "ss"    [ssharp])
  592.  
  593. (define-key compose-map "th"    [thorn])
  594.  
  595. (define-key compose-map "u`"    [ugrave])
  596. (define-key compose-map "u'"    [uacute])
  597. (define-key compose-map "u^"    [ucircumflex])
  598. (define-key compose-map "u\""    [udiaeresis])
  599. (define-key compose-map "u/"    [mu])
  600.  
  601. (define-key compose-map "x0"    [currency])
  602. (define-key compose-map "xO"    [currency])
  603. (define-key compose-map "xo"    [currency])
  604. (define-key compose-map "xx"    [multiply])
  605.  
  606. (define-key compose-map "y-"    [yen])
  607. (define-key compose-map "y="    [yen])
  608. (define-key compose-map "y'"    [yacute])
  609. (define-key compose-map "y\""    [ydiaeresis])
  610.  
  611. (define-key compose-map "|C"    [cent])
  612. (define-key compose-map "|c"    [cent])
  613. (define-key compose-map "||"    [brokenbar])
  614.  
  615.  
  616. ;;; Electric dead keys: making a' mean a-acute.
  617.  
  618. (defun electric-diacritic (&optional count)
  619.   "Modify the previous character with an accent.
  620. For example, if `:' is bound to this command, then typing `a:' 
  621. will first insert `a' and then turn it into `\344' (adiaeresis).
  622. The keys to which this command may be bound (and the accents 
  623. which it understands) are:
  624.  
  625.    '  (acute)       \301\311\315\323\332\335 \341\351\355\363\372\375
  626.    `  (grave)       \300\310\314\322\331 \340\350\354\362\371
  627.    :  (diaeresis)   \304\313\317\326\334 \344\353\357\366\374\377
  628.    ^  (circumflex)  \302\312\316\324\333 \342\352\356\364\373
  629.    ,  (cedilla)     \307\347
  630.    .  (ring)        \305\345"
  631.   (interactive "p")
  632.   (or count (setq count 1))
  633.   
  634.   (if (not (eq last-command 'self-insert-command))
  635.       ;; Only do the magic if the two chars were typed in succession.
  636.       (self-insert-command count)
  637.  
  638.     ;; This is so that ``a : C-x u'' will transform `adiaeresis' back into `a:'
  639.     (self-insert-command count)
  640.     (undo-boundary)
  641.     (delete-char (- count))
  642.  
  643.     (let* ((c last-command-char)
  644.        (map (cond ((eq c ?') compose-acute-map)
  645.               ((eq c ?`) compose-grave-map)
  646.               ((eq c ?,) compose-cedilla-map)
  647.               ((eq c ?:) compose-diaeresis-map)
  648.               ((eq c ?^) compose-circumflex-map)
  649.               ((eq c ?~) compose-tilde-map)
  650.               ((eq c ?.) compose-ring-map)
  651.               (t (error "unknown diacritic: %s (%c)" c c))))
  652.        (base-char (preceding-char))
  653.        (mod-char (and (>= (downcase base-char) ?a) ; only do alphabetics?
  654.               (<= (downcase base-char) ?z)
  655.               (lookup-key map (make-string 1 base-char)))))
  656.       (if (and (vectorp mod-char) (= (length mod-char) 1))
  657.       (setq mod-char (aref mod-char 0)))
  658.       (if (and mod-char (symbolp mod-char))
  659.       (setq mod-char (or (get mod-char character-set-property) mod-char)))
  660.       (if (and mod-char (> count 0))
  661.       (delete-char -1)
  662.     (setq mod-char c))
  663.       (while (> count 0)
  664.     (insert mod-char)
  665.     (setq count (1- count))))))
  666.  
  667. ;; should "::" mean "¿" and ": " mean ":"?
  668. ;; should we also do 
  669. ;;    (?~
  670. ;;     (?A "\303")
  671. ;;     (?C "\307")
  672. ;;     (?D "\320")
  673. ;;     (?N "\321")
  674. ;;     (?O "\325")
  675. ;;     (?a "\343")
  676. ;;     (?c "\347")
  677. ;;     (?d "\360")
  678. ;;     (?n "\361")
  679. ;;     (?o "\365")
  680. ;;     (?> "\273")
  681. ;;     (?< "\253")
  682. ;;     (?  "~")) ; no special code
  683. ;;    (?\/
  684. ;;     (?A "\305") ;; A-with-ring (Norwegian and Danish)
  685. ;;     (?E "\306") ;; AE-ligature (Norwegian and Danish)
  686. ;;     (?O "\330")
  687. ;;     (?a "\345") ;; a-with-ring (Norwegian and Danish)
  688. ;;     (?e "\346") ;; ae-ligature (Norwegian and Danish)
  689. ;;     (?o "\370")
  690. ;;     (?  "/")) ; no special code
  691.  
  692.  
  693. ;;; Providing help in the middle of a compose sequence.  (Way cool.)
  694.  
  695. (defun compose-help ()
  696.   (interactive)
  697.   (let* ((keys (apply 'vector
  698.               (nreverse
  699.                (cdr (nreverse (append (this-command-keys) nil))))))
  700.      (map (or (key-binding keys)
  701.           (error (format "can't find map?  %s" (this-command-keys))))))
  702.     (with-output-to-temp-buffer "*Help*"
  703.       (set-buffer "*Help*")
  704.       (erase-buffer)
  705.       (message "Working...")
  706.       (setq ctl-arrow 'compose) ; non-t-non-nil
  707.       (insert "You are typing a compose sequence.  So far you have typed: ")
  708.       (insert (key-description keys))
  709.       (insert "\nCompletions from here are:\n\n")
  710.       (map-keymap 'compose-help-mapper map t)
  711.       (message "? "))
  712.     (let (event)
  713.       (while (progn
  714.            (setq event (next-command-event))
  715.            (setq map (lookup-key map (vector event)))
  716.            (keymapp map))
  717.         )
  718.       (if map
  719.       (command-execute map)
  720.         (setq unread-command-event event)))))
  721.  
  722. (put 'compose-help 'isearch-command t)    ; so that it doesn't terminate isearch
  723.  
  724. (defun compose-help-mapper (key binding)
  725.   (if (and (symbolp key)
  726.        (get key character-set-property))
  727.       (setq key (get key character-set-property)))
  728.   (if (eq binding 'compose-help) ; suppress that...
  729.       nil
  730.     (if (keymapp binding)
  731.     (let ((p (point)))
  732.       (map-keymap 'compose-help-mapper binding t)
  733.       (goto-char p)
  734.       (while (not (eobp))
  735.         (if (numberp key)
  736.         (insert (make-string 1 key))
  737.           (insert (single-key-description key)))
  738.         (insert " ")
  739.         (forward-line 1)))
  740.       (if (numberp key)
  741.       (insert (make-string 1 key))
  742.     (insert (single-key-description key)))
  743.       (indent-to 16)
  744.       (let ((code (and (vectorp binding)
  745.                (= 1 (length binding))
  746.                (get (aref binding 0) character-set-property))))
  747.     (if code
  748.         (insert (make-string 1 code))
  749.       (if (stringp binding)
  750.           (insert binding)
  751.         (insert (prin1-to-string binding)))))
  752.       (if (and (vectorp binding) (= 1 (length binding)))
  753.       (progn
  754.         (indent-to 32)
  755.         (insert (symbol-name (aref binding 0))))))
  756.     (insert "\n")))
  757.  
  758. ;; define it at top-level in the compose map...
  759. (define-key compose-map '(control h) 'compose-help)
  760. (define-key compose-map 'help 'compose-help)
  761. ;; and then define it in each sub-map of the compose map.
  762. (map-keymap
  763.  (function (lambda (key binding)
  764.          (if (keymapp binding)
  765.          (progn
  766.            (define-key binding '(control h) 'compose-help)
  767.            (define-key binding 'help 'compose-help)))))
  768.  compose-map nil)
  769.  
  770. ;; Make display display the accented letters
  771. (if (memq (default-value 'ctl-arrow) '(t nil))
  772.     (setq-default ctl-arrow 'iso-8859/1))
  773.  
  774.  
  775. (provide 'x-compose)
  776.