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