Mercurial > hg > xemacs-beta
annotate lisp/x-compose.el @ 4570:e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
tests/ChangeLog addition:
2008-12-28 Aidan Kehoe <kehoea@parhasard.net>
* automated/query-coding-tests.el:
Add tests for #'unencodable-char-position,
#'check-coding-systems-region, #'encode-coding-char. Remove some
debugging statements.
lisp/ChangeLog addition:
2008-12-28 Aidan Kehoe <kehoea@parhasard.net>
* coding.el (query-coding-region):
(query-coding-string):
Make these defsubsts, they're short enough and they're called
explicitly rarely enough that it make some sense. The alternative
would be compiler macros that avoid the binding of the arguments.
(unencodable-char-position):
Document where the docstring and API are from.
Correct a special case for zero--check-argument-type returns nil
when it succeeds, we can't usefully chain its result in an and
here.
(check-coding-systems-region): New. API taken from GNU; docstring
and implementation are independent.
(encode-coding-char):
Add an optional third argument, as used by recent GNU. Document
the origen of the docstring.
(default-query-coding-region): Add a short docstring to the
non-Mule implementation of this function.
* unicode.el:
Don't set the query-coding-function property for unicode coding
systems if we're on non-mule. Unintern
unicode-query-coding-region, unicode-query-coding-skip-chars-arg
in the same context.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 28 Dec 2008 22:51:14 +0000 |
| parents | e34711681f30 |
| children | fdc76fec36d3 |
| rev | line source |
|---|---|
| 428 | 1 ;;; x-compose.el --- Compose-key processing in XEmacs |
| 2 | |
| 2828 | 3 ;; Copyright (C) 1992, 1993, 1997, 2005 Free Software Foundation, Inc. |
| 428 | 4 |
| 5 ;; Author: Jamie Zawinski <jwz@jwz.org> | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Rewritten by Martin Buchholz far too many times. | |
| 8 ;; | |
| 9 ;; Changed: 11 Jun 1997 by Heiko Muenkel <muenkel@tnt.uni-hannover.de> | |
| 10 ;; The degree sign couldn't be inserted with the old version. | |
| 11 ;; Keywords: i18n | |
| 12 | |
| 13 ;; This file is part of XEmacs. | |
| 14 | |
| 15 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 16 ;; under the terms of the GNU General Public License as published by | |
| 17 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 18 ;; any later version. | |
| 19 | |
| 20 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 23 ;; General Public License for more details. | |
| 24 | |
| 25 ;; You should have received a copy of the GNU General Public License | |
| 26 ;; along with XEmacs; see the file COPYING. If not, write to the | |
| 27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 28 ;; Boston, MA 02111-1307, USA. | |
| 29 | |
| 30 ;;; Synched up with: Not in FSF. | |
| 31 | |
| 32 ;;; Commentary: | |
| 33 | |
| 34 ;; created by jwz, 14-jun-92. | |
| 35 ;;; changed by Jan Vroonhof, July 1997: Use function-key-map instead | |
| 36 ;;; of global map. | |
| 37 ;;; Preliminary support for | |
| 38 ;;; XFree86 deadkeys | |
| 39 | |
| 40 ;; This file implements DEC-, OpenWindows-, and HP-compatible "Compose" | |
| 41 ;; processing for XEmacs. | |
| 42 | |
| 43 ;; If you are running a version of X which already does compose processing, | |
| 44 ;; then you don't need this file. But the MIT R4 and R5 distributions don't | |
| 45 ;; do compose processing, so you may want to fake it by using this code. | |
| 46 | |
| 47 ;; The basic idea is that there are several ways to generate keysyms which | |
| 48 ;; do not have keys devoted to them on your keyboard. | |
| 49 | |
| 50 ;; The first method is by using "dead" keys. A dead key is a key which, | |
| 51 ;; when typed, does not insert a character. Instead it modifies the | |
| 52 ;; following character typed. So if you typed "dead-tilde" followed by "A", | |
| 53 ;; then "A-tilde" would be inserted. Of course, this requires you to modify | |
| 54 ;; your keyboard to include a "dead-tilde" key on it somewhere. | |
| 55 | |
| 56 ;; The second method is by using a "Compose" key. With a Compose key, you | |
| 57 ;; would type "Compose" then "tilde" then "A" to insert "A-tilde". | |
| 58 | |
| 59 ;; There are a small number of dead keys: acute, grave, cedilla, diaeresis, | |
| 60 ;; circumflex, tilde, and ring. There are a larger number of accented and | |
| 61 ;; other characters accessible via the Compose key, so both are useful. | |
| 62 | |
| 63 ;; To use this code, you will need to have a Compose key on your keyboard. | |
| 64 ;; The default configuration of most X keyboards doesn't contain one. You | |
| 65 ;; can, for example, turn the right "Meta" key into a "Compose" key with | |
| 66 ;; this command: | |
| 67 | |
| 68 ;; xmodmap -e "remove mod1 = Meta_R" -e "keysym Meta_R = Multi_key" | |
| 69 | |
| 70 ;; Multi-key is the name that X (and emacs) know the "Compose" key by. | |
| 71 ;; The "remove..." command is necessary because the "Compose" key must not | |
| 72 ;; have any modifier bits associated with it. This exact command may not | |
| 73 ;; work, depending on what system and keyboard you are using. If it | |
| 74 ;; doesn't, you'll have to read the man page for xmodmap. You might want | |
| 75 ;; to get the "xkeycaps" program from | |
| 76 ;; <URL:http://www.jwz.org/xkeycaps/>, | |
| 77 ;; which is a graphical front end to xmodmap | |
| 78 ;; that hides xmodmap's arcane syntax from you. | |
| 79 | |
| 80 ;; If for some reason you don't want to have a dedicated compose key on your | |
| 81 ;; keyboard, you can use some other key as the prefix. For example, to make | |
| 82 ;; "Meta-Shift-C" act as a compose key (so that "M-C , c" would insert the | |
| 83 ;; character "ccedilla") you could do | |
| 84 | |
| 85 ;; (global-set-key "\M-C" compose-map) | |
| 86 | |
| 87 ;; I believe the bindings encoded in this file are the same as those used | |
| 88 ;; by OpenWindows versions 2 and 3, and DEC VT320 terminals. Please let me | |
| 89 ;; know if you think otherwise. | |
| 90 | |
| 91 ;; Much thanks to Justin Bur <justin@crim.ca> for helping me understand how | |
| 92 ;; this stuff is supposed to work. | |
| 93 | |
| 94 ;; You also might want to consider getting Justin's patch for the MIT Xlib | |
| 95 ;; that implements compose processing in the library. This will enable | |
| 96 ;; compose processing in applications other than emacs as well. You can | |
| 97 ;; get it from export.lcs.mit.edu in contrib/compose.tar.Z. | |
| 98 | |
| 99 ;; This code has one feature that a more "builtin" Compose mechanism could | |
| 100 ;; not have: at any point you can type C-h to get a list of the possible | |
| 101 ;; completions of what you have typed so far. | |
| 102 | |
| 2828 | 103 ;; Giacomo Boffi's problem of |
| 104 ;; 20050324103919.8D22E4901@boffi95.stru.polimi.it is caused by Xlib doing | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3459
diff
changeset
|
105 ;; the compose processing. To turn that off, I'm not certain what's |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3459
diff
changeset
|
106 ;; possible, beyond making C the current locale. |
| 428 | 107 |
| 2828 | 108 ;;; Code: |
| 428 | 109 |
| 110 (macrolet | |
| 111 ((define-compose-map (keymap-symbol) | |
| 112 `(progn | |
| 113 (defconst ,keymap-symbol (make-sparse-keymap ',keymap-symbol)) | |
| 114 ;; Required to tell XEmacs the keymaps were actually autoloaded. | |
| 115 ;; #### Make this unnecessary! | |
| 116 (fset ',keymap-symbol ,keymap-symbol)))) | |
| 117 | |
| 118 (define-compose-map compose-map) | |
| 119 (define-compose-map compose-acute-map) | |
| 120 (define-compose-map compose-grave-map) | |
| 121 (define-compose-map compose-cedilla-map) | |
| 122 (define-compose-map compose-diaeresis-map) | |
| 123 (define-compose-map compose-circumflex-map) | |
| 124 (define-compose-map compose-tilde-map) | |
| 125 (define-compose-map compose-ring-map)) | |
| 126 | |
| 127 (define-key compose-map 'acute compose-acute-map) | |
| 128 (define-key compose-map 'grave compose-grave-map) | |
| 129 (define-key compose-map 'cedilla compose-cedilla-map) | |
| 130 (define-key compose-map 'diaeresis compose-diaeresis-map) | |
| 131 (define-key compose-map 'circumflex compose-circumflex-map) | |
| 132 (define-key compose-map 'tilde compose-tilde-map) | |
| 133 (define-key compose-map 'degree compose-ring-map) | |
| 134 | |
| 135 ;;(define-key function-key-map [multi-key] compose-map) | |
| 136 | |
| 137 ;; The following is necessary, because one can't rebind [degree] | |
| 138 ;; and use it to insert the degree sign! | |
| 139 ;;(defun compose-insert-degree () | |
| 140 ;; "Inserts a degree sign." | |
| 141 ;; (interactive) | |
| 142 ;; (insert ?\260)) | |
| 143 | |
| 144 (define-key compose-map [acute] compose-acute-map) | |
| 145 (define-key compose-map [?'] compose-acute-map) | |
| 146 (define-key compose-map [grave] compose-grave-map) | |
| 147 (define-key compose-map [?`] compose-grave-map) | |
| 148 (define-key compose-map [cedilla] compose-cedilla-map) | |
| 149 (define-key compose-map [?,] compose-cedilla-map) | |
| 150 (define-key compose-map [diaeresis] compose-diaeresis-map) | |
| 151 (define-key compose-map [?\"] compose-diaeresis-map) | |
| 152 (define-key compose-map [circumflex] compose-circumflex-map) | |
| 153 (define-key compose-map [?^] compose-circumflex-map) | |
| 154 (define-key compose-map [tilde] compose-tilde-map) | |
| 155 (define-key compose-map [~] compose-tilde-map) | |
| 156 (define-key compose-map [degree] compose-ring-map) | |
| 157 (define-key compose-map [?*] compose-ring-map) | |
| 158 | |
| 159 | |
| 160 ;;; The contents of the "dead key" maps. These are shared by the | |
| 161 ;;; compose-map. | |
| 162 | |
| 2828 | 163 ;;; These used to all have nice readable X11-oriented keysym names as the |
| 164 ;;; macro definition in the third argument, but I moved the interpretation | |
| 165 ;;; of those mappings (that is, Aacute to \301, &c.) to runtime in the X11 | |
| 166 ;;; code on first sight of the symbols--which is the more general solution, | |
| 167 ;;; what with Unicode keysyms, publishing, technical and so on, there's no | |
| 168 ;;; need to have them hanging around as symbols all the time--so they're no | |
| 169 ;;; longer available to Lisp before X11 sees them, something this relied on. | |
| 170 | |
| 171 ;;; The transformation was done like so; | |
| 172 | |
| 173 ;;; (while (re-search-forward "\\[\\([a-zA-Z]+\\)\\])$" nil t) | |
| 174 ;;; (replace-match (format "(?\\%o)" | |
| 175 ;;; (get (intern (match-string 1)) 'character-of-keysym)) | |
| 176 ;;; t t nil 1)) | |
| 177 | |
| 178 ;;; with a lot of repeated calling of setxkbmap to esoteric keymaps--so | |
| 179 ;;; x_reset_key_mapping gets called for all the keys on the keyboard--yacute | |
| 180 ;;; getting picked up from the Czech keymap, idiaeresis from the Dutch one, | |
| 181 ;;; and many more (al, ca, cz, de, dvorak, ee, es, fi, fr, hu, | |
| 182 ;;; ie(UnicodeExpert), it, nl, pt, ro, tr, us, vn, if it interests you.) | |
| 183 | |
| 184 ;;; The parentheses inside the vector are because otherwise the macro gets | |
| 185 ;;; interpreted as a meta character, the Latin-1 codes being in exactly that | |
| 186 ;;; range. Perhaps that bears documenting somewhere. Also, why is help | |
| 187 ;;; turned off for these (x-compose) sequences by default? | |
| 188 | |
| 189 ;;; (Aidan Kehoe, 2005-05-18) | |
| 190 | |
| 428 | 191 (define-key compose-acute-map [space] "'") |
| 2828 | 192 (define-key compose-acute-map [?'] [(?\264)]) |
| 193 (define-key compose-acute-map [?A] [(?\301)]) | |
| 194 (define-key compose-acute-map [E] [(?\311)]) | |
| 195 (define-key compose-acute-map [I] [(?\315)]) | |
| 196 (define-key compose-acute-map [O] [(?\323)]) | |
| 197 (define-key compose-acute-map [U] [(?\332)]) | |
| 198 (define-key compose-acute-map [Y] [(?\335)]) | |
| 199 (define-key compose-acute-map [a] [(?\341)]) | |
| 200 (define-key compose-acute-map [e] [(?\351)]) | |
| 201 (define-key compose-acute-map [i] [(?\355)]) | |
| 202 (define-key compose-acute-map [o] [(?\363)]) | |
| 203 (define-key compose-acute-map [u] [(?\372)]) | |
| 204 (define-key compose-acute-map [y] [(?\375)]) | |
| 428 | 205 |
| 206 (define-key compose-grave-map [space] "`") | |
| 2828 | 207 (define-key compose-grave-map [?`] [(?\140)]) |
| 208 (define-key compose-grave-map [A] [(?\300)]) | |
| 209 (define-key compose-grave-map [E] [(?\310)]) | |
| 210 (define-key compose-grave-map [I] [(?\314)]) | |
| 211 (define-key compose-grave-map [O] [(?\322)]) | |
| 212 (define-key compose-grave-map [U] [(?\331)]) | |
| 213 (define-key compose-grave-map [a] [(?\340)]) | |
| 214 (define-key compose-grave-map [e] [(?\350)]) | |
| 215 (define-key compose-grave-map [i] [(?\354)]) | |
| 216 (define-key compose-grave-map [o] [(?\362)]) | |
| 217 (define-key compose-grave-map [u] [(?\371)]) | |
| 428 | 218 |
| 219 (define-key compose-cedilla-map [space] ",") | |
| 2828 | 220 (define-key compose-cedilla-map [?,] [(?\270)]) |
| 221 (define-key compose-cedilla-map [C] [(?\307)]) | |
| 222 (define-key compose-cedilla-map [c] [(?\347)]) | |
| 428 | 223 |
| 2828 | 224 (define-key compose-diaeresis-map [space] [(?\250)]) |
| 225 (define-key compose-diaeresis-map [?\"] [(?\250)]) | |
| 226 (define-key compose-diaeresis-map [A] [(?\304)]) | |
| 227 (define-key compose-diaeresis-map [E] [(?\313)]) | |
| 228 (define-key compose-diaeresis-map [I] [(?\317)]) | |
| 229 (define-key compose-diaeresis-map [O] [(?\326)]) | |
| 230 (define-key compose-diaeresis-map [U] [(?\334)]) | |
| 231 (define-key compose-diaeresis-map [a] [(?\344)]) | |
| 232 (define-key compose-diaeresis-map [e] [(?\353)]) | |
| 233 (define-key compose-diaeresis-map [i] [(?\357)]) | |
| 234 (define-key compose-diaeresis-map [o] [(?\366)]) | |
| 3459 | 235 ;; Not strictly a diaeresis, but close enough for government work. |
| 236 (define-key compose-diaeresis-map [s] [(?\337)]) | |
| 2828 | 237 (define-key compose-diaeresis-map [u] [(?\374)]) |
| 238 (define-key compose-diaeresis-map [y] [(?\377)]) | |
| 428 | 239 |
| 240 (define-key compose-circumflex-map [space] "^") | |
| 241 (define-key compose-circumflex-map [?/] "|") | |
| 2828 | 242 (define-key compose-circumflex-map [?!] [(?\246)]) |
| 243 (define-key compose-circumflex-map [?-] [(?\257)]) | |
| 244 (define-key compose-circumflex-map [?_] [(?\257)]) | |
| 245 (define-key compose-circumflex-map [?0] [(?\260)]) | |
| 246 (define-key compose-circumflex-map [?1] [(?\271)]) | |
| 247 (define-key compose-circumflex-map [?2] [(?\262)]) | |
| 248 (define-key compose-circumflex-map [?3] [(?\263)]) | |
| 249 (define-key compose-circumflex-map [?.] [(?\267)]) | |
| 250 (define-key compose-circumflex-map [A] [(?\302)]) | |
| 251 (define-key compose-circumflex-map [E] [(?\312)]) | |
| 252 (define-key compose-circumflex-map [I] [(?\316)]) | |
| 253 (define-key compose-circumflex-map [O] [(?\324)]) | |
| 254 (define-key compose-circumflex-map [U] [(?\333)]) | |
| 255 (define-key compose-circumflex-map [a] [(?\342)]) | |
| 256 (define-key compose-circumflex-map [e] [(?\352)]) | |
| 257 (define-key compose-circumflex-map [i] [(?\356)]) | |
| 258 (define-key compose-circumflex-map [o] [(?\364)]) | |
| 259 (define-key compose-circumflex-map [u] [(?\373)]) | |
| 428 | 260 |
| 261 (define-key compose-tilde-map [space] "~") | |
| 2828 | 262 (define-key compose-tilde-map [A] [(?\303)]) |
| 263 (define-key compose-tilde-map [N] [(?\321)]) | |
| 264 (define-key compose-tilde-map [O] [(?\325)]) | |
| 265 (define-key compose-tilde-map [a] [(?\343)]) | |
| 266 (define-key compose-tilde-map [n] [(?\361)]) | |
| 267 (define-key compose-tilde-map [o] [(?\365)]) | |
| 428 | 268 |
| 2828 | 269 (define-key compose-ring-map [space] [(?\260)]) |
| 270 (define-key compose-ring-map [A] [(?\305)]) | |
| 271 (define-key compose-ring-map [a] [(?\345)]) | |
| 428 | 272 |
| 273 | |
| 274 ;;; The rest of the compose-map. These are the composed characters | |
| 275 ;;; that are not accessible via "dead" keys. | |
| 276 | |
| 277 (define-key compose-map " '" "'") | |
| 278 (define-key compose-map " ^" "^") | |
| 279 (define-key compose-map " `" "`") | |
| 280 (define-key compose-map " ~" "~") | |
| 2828 | 281 (define-key compose-map " " [(?\240)]) |
| 282 (define-key compose-map " \"" [(?\250)]) | |
| 283 (define-key compose-map " :" [(?\250)]) | |
| 284 (define-key compose-map " *" [(?\260)]) | |
| 428 | 285 |
| 2828 | 286 (define-key compose-map "!!" [(?\241)]) |
| 287 (define-key compose-map "!^" [(?\246)]) | |
| 288 (define-key compose-map "!S" [(?\247)]) | |
| 289 (define-key compose-map "!s" [(?\247)]) | |
| 290 (define-key compose-map "!P" [(?\266)]) | |
| 291 (define-key compose-map "!p" [(?\266)]) | |
| 428 | 292 |
| 293 (define-key compose-map "((" "[") | |
| 294 (define-key compose-map "(-" "{") | |
| 295 | |
| 296 (define-key compose-map "))" "]") | |
| 297 (define-key compose-map ")-" "}") | |
| 298 | |
| 299 (define-key compose-map "++" "#") | |
| 2828 | 300 (define-key compose-map "+-" [(?\261)]) |
| 428 | 301 |
| 302 (define-key compose-map "-(" "{") | |
| 303 (define-key compose-map "-)" "}") | |
| 304 (define-key compose-map "--" "-") | |
| 2828 | 305 (define-key compose-map "-L" [(?\243)]) |
| 306 (define-key compose-map "-l" [(?\243)]) | |
| 307 (define-key compose-map "-Y" [(?\245)]) | |
| 308 (define-key compose-map "-y" [(?\245)]) | |
| 309 (define-key compose-map "-," [(?\254)]) | |
| 310 (define-key compose-map "-|" [(?\254)]) | |
| 311 (define-key compose-map "-^" [(?\257)]) | |
| 312 (define-key compose-map "-+" [(?\261)]) | |
| 313 (define-key compose-map "-:" [(?\367)]) | |
| 314 (define-key compose-map "-D" [(?\320)]) | |
| 315 (define-key compose-map "-d" [(?\360)]) | |
| 316 (define-key compose-map "-a" [(?\252)]) | |
| 428 | 317 |
| 2828 | 318 (define-key compose-map ".^" [(?\267)]) |
| 428 | 319 |
| 320 (define-key compose-map "//" "\\") | |
| 321 (define-key compose-map "/<" "\\") | |
| 322 (define-key compose-map "/^" "|") | |
| 2828 | 323 (define-key compose-map "/C" [(?\242)]) |
| 324 (define-key compose-map "/c" [(?\242)]) | |
| 325 (define-key compose-map "/U" [(?\265)]) | |
| 326 (define-key compose-map "/u" [(?\265)]) | |
| 327 (define-key compose-map "/O" [(?\330)]) | |
| 328 (define-key compose-map "/o" [(?\370)]) | |
| 428 | 329 |
| 2828 | 330 (define-key compose-map "0X" [(?\244)]) |
| 331 (define-key compose-map "0x" [(?\244)]) | |
| 332 (define-key compose-map "0S" [(?\247)]) | |
| 333 (define-key compose-map "0s" [(?\247)]) | |
| 334 (define-key compose-map "0C" [(?\251)]) | |
| 335 (define-key compose-map "0c" [(?\251)]) | |
| 336 (define-key compose-map "0R" [(?\256)]) | |
| 337 (define-key compose-map "0r" [(?\256)]) | |
| 338 (define-key compose-map "0^" [(?\260)]) | |
| 428 | 339 |
| 2828 | 340 (define-key compose-map "1^" [(?\271)]) |
| 341 (define-key compose-map "14" [(?\274)]) | |
| 342 (define-key compose-map "12" [(?\275)]) | |
| 428 | 343 |
| 2828 | 344 (define-key compose-map "2^" [(?\262)]) |
| 428 | 345 |
| 2828 | 346 (define-key compose-map "3^" [(?\263)]) |
| 347 (define-key compose-map "34" [(?\276)]) | |
| 428 | 348 |
| 2828 | 349 (define-key compose-map ":-" [(?\367)]) |
| 428 | 350 |
| 351 (define-key compose-map "</" "\\") | |
| 2828 | 352 (define-key compose-map "<<" [(?\253)]) |
| 428 | 353 |
| 2828 | 354 (define-key compose-map "=L" [(?\243)]) |
| 355 (define-key compose-map "=l" [(?\243)]) | |
| 356 (define-key compose-map "=Y" [(?\245)]) | |
| 357 (define-key compose-map "=y" [(?\245)]) | |
| 428 | 358 |
| 2828 | 359 (define-key compose-map ">>" [(?\273)]) |
| 428 | 360 |
| 2828 | 361 (define-key compose-map "??" [(?\277)]) |
| 428 | 362 |
| 363 (define-key compose-map "AA" "@") | |
| 364 (define-key compose-map "Aa" "@") | |
| 2828 | 365 (define-key compose-map "A_" [(?\252)]) |
| 366 (define-key compose-map "A`" [(?\300)]) | |
| 367 (define-key compose-map "A'" [(?\301)]) | |
| 368 (define-key compose-map "A^" [(?\302)]) | |
| 369 (define-key compose-map "A~" [(?\303)]) | |
| 370 (define-key compose-map "A\"" [(?\304)]) | |
| 371 (define-key compose-map "A*" [(?\305)]) | |
| 372 (define-key compose-map "AE" [(?\306)]) | |
| 428 | 373 |
| 2828 | 374 (define-key compose-map "C/" [(?\242)]) |
| 375 (define-key compose-map "C|" [(?\242)]) | |
| 376 (define-key compose-map "C0" [(?\251)]) | |
| 377 (define-key compose-map "CO" [(?\251)]) | |
| 378 (define-key compose-map "Co" [(?\251)]) | |
| 379 (define-key compose-map "C," [(?\307)]) | |
| 428 | 380 |
| 2828 | 381 (define-key compose-map "D-" [(?\320)]) |
| 428 | 382 |
| 2828 | 383 (define-key compose-map "E`" [(?\310)]) |
| 384 (define-key compose-map "E'" [(?\311)]) | |
| 385 (define-key compose-map "E^" [(?\312)]) | |
| 386 (define-key compose-map "E\"" [(?\313)]) | |
| 428 | 387 |
| 2828 | 388 (define-key compose-map "I`" [(?\314)]) |
| 389 (define-key compose-map "I'" [(?\315)]) | |
| 390 (define-key compose-map "I^" [(?\316)]) | |
| 391 (define-key compose-map "I\"" [(?\317)]) | |
| 428 | 392 |
| 2828 | 393 (define-key compose-map "L-" [(?\243)]) |
| 394 (define-key compose-map "L=" [(?\243)]) | |
| 428 | 395 |
| 2828 | 396 (define-key compose-map "N~" [(?\321)]) |
| 428 | 397 |
| 2828 | 398 (define-key compose-map "OX" [(?\244)]) |
| 399 (define-key compose-map "Ox" [(?\244)]) | |
| 400 (define-key compose-map "OS" [(?\247)]) | |
| 401 (define-key compose-map "Os" [(?\247)]) | |
| 402 (define-key compose-map "OC" [(?\251)]) | |
| 403 (define-key compose-map "Oc" [(?\251)]) | |
| 404 (define-key compose-map "OR" [(?\256)]) | |
| 405 (define-key compose-map "Or" [(?\256)]) | |
| 406 (define-key compose-map "O_" [(?\272)]) | |
| 407 (define-key compose-map "O`" [(?\322)]) | |
| 408 (define-key compose-map "O'" [(?\323)]) | |
| 409 (define-key compose-map "O^" [(?\324)]) | |
| 410 (define-key compose-map "O~" [(?\325)]) | |
| 411 (define-key compose-map "O\"" [(?\326)]) | |
| 412 (define-key compose-map "O/" [(?\330)]) | |
| 428 | 413 |
| 2828 | 414 (define-key compose-map "P!" [(?\266)]) |
| 428 | 415 |
| 2828 | 416 (define-key compose-map "R0" [(?\256)]) |
| 417 (define-key compose-map "RO" [(?\256)]) | |
| 418 (define-key compose-map "Ro" [(?\256)]) | |
| 428 | 419 |
| 2828 | 420 (define-key compose-map "S!" [(?\247)]) |
| 421 (define-key compose-map "S0" [(?\247)]) | |
| 422 (define-key compose-map "SO" [(?\247)]) | |
| 423 (define-key compose-map "So" [(?\247)]) | |
| 424 (define-key compose-map "SS" [(?\337)]) | |
| 428 | 425 |
| 2828 | 426 (define-key compose-map "TH" [(?\336)]) |
| 428 | 427 |
| 2828 | 428 (define-key compose-map "U`" [(?\331)]) |
| 429 (define-key compose-map "U'" [(?\332)]) | |
| 430 (define-key compose-map "U^" [(?\333)]) | |
| 431 (define-key compose-map "U\"" [(?\334)]) | |
| 428 | 432 |
| 2828 | 433 (define-key compose-map "X0" [(?\244)]) |
| 434 (define-key compose-map "XO" [(?\244)]) | |
| 435 (define-key compose-map "Xo" [(?\244)]) | |
| 428 | 436 |
| 2828 | 437 (define-key compose-map "Y-" [(?\245)]) |
| 438 (define-key compose-map "Y=" [(?\245)]) | |
| 439 (define-key compose-map "Y'" [(?\335)]) | |
| 428 | 440 |
| 2828 | 441 (define-key compose-map "_A" [(?\252)]) |
| 442 (define-key compose-map "_a" [(?\252)]) | |
| 443 (define-key compose-map "_^" [(?\257)]) | |
| 444 (define-key compose-map "_O" [(?\272)]) | |
| 445 (define-key compose-map "_o" [(?\272)]) | |
| 428 | 446 |
| 447 (define-key compose-map "aA" "@") | |
| 448 (define-key compose-map "aa" "@") | |
| 2828 | 449 (define-key compose-map "a_" [(?\252)]) |
| 450 (define-key compose-map "a-" [(?\252)]) | |
| 451 (define-key compose-map "a`" [(?\340)]) | |
| 452 (define-key compose-map "a'" [(?\341)]) | |
| 453 (define-key compose-map "a^" [(?\342)]) | |
| 454 (define-key compose-map "a~" [(?\343)]) | |
| 455 (define-key compose-map "a\"" [(?\344)]) | |
| 456 (define-key compose-map "a*" [(?\345)]) | |
| 457 (define-key compose-map "ae" [(?\346)]) | |
| 428 | 458 |
| 2828 | 459 (define-key compose-map "c/" [(?\242)]) |
| 460 (define-key compose-map "c|" [(?\242)]) | |
| 461 (define-key compose-map "c0" [(?\251)]) | |
| 462 (define-key compose-map "cO" [(?\251)]) | |
| 463 (define-key compose-map "co" [(?\251)]) | |
| 464 (define-key compose-map "c," [(?\347)]) | |
| 428 | 465 |
| 2828 | 466 (define-key compose-map "d-" [(?\360)]) |
| 428 | 467 |
| 2828 | 468 (define-key compose-map "e`" [(?\350)]) |
| 469 (define-key compose-map "e'" [(?\351)]) | |
| 470 (define-key compose-map "e^" [(?\352)]) | |
| 471 (define-key compose-map "e\"" [(?\353)]) | |
| 428 | 472 |
| 2828 | 473 (define-key compose-map "i`" [(?\354)]) |
| 474 (define-key compose-map "i'" [(?\355)]) | |
| 475 (define-key compose-map "i^" [(?\356)]) | |
| 476 (define-key compose-map "i\"" [(?\357)]) | |
| 477 (define-key compose-map "i:" [(?\357)]) | |
| 428 | 478 |
| 2828 | 479 (define-key compose-map "l-" [(?\243)]) |
| 480 (define-key compose-map "l=" [(?\243)]) | |
| 428 | 481 |
| 2828 | 482 (define-key compose-map "n~" [(?\361)]) |
| 428 | 483 |
| 2828 | 484 (define-key compose-map "oX" [(?\244)]) |
| 485 (define-key compose-map "ox" [(?\244)]) | |
| 486 (define-key compose-map "oC" [(?\251)]) | |
| 487 (define-key compose-map "oc" [(?\251)]) | |
| 488 (define-key compose-map "oR" [(?\256)]) | |
| 489 (define-key compose-map "or" [(?\256)]) | |
| 490 (define-key compose-map "oS" [(?\247)]) | |
| 491 (define-key compose-map "os" [(?\247)]) | |
| 492 (define-key compose-map "o_" [(?\272)]) | |
| 493 (define-key compose-map "o`" [(?\362)]) | |
| 494 (define-key compose-map "o'" [(?\363)]) | |
| 495 (define-key compose-map "o^" [(?\364)]) | |
| 496 (define-key compose-map "o~" [(?\365)]) | |
| 497 (define-key compose-map "o\"" [(?\366)]) | |
| 498 (define-key compose-map "o/" [(?\370)]) | |
| 428 | 499 |
| 2828 | 500 (define-key compose-map "p!" [(?\266)]) |
| 428 | 501 |
| 2828 | 502 (define-key compose-map "r0" [(?\256)]) |
| 503 (define-key compose-map "rO" [(?\256)]) | |
| 504 (define-key compose-map "ro" [(?\256)]) | |
| 428 | 505 |
| 2828 | 506 (define-key compose-map "s!" [(?\247)]) |
| 507 (define-key compose-map "s0" [(?\247)]) | |
| 508 (define-key compose-map "sO" [(?\247)]) | |
| 509 (define-key compose-map "so" [(?\247)]) | |
| 510 (define-key compose-map "ss" [(?\337)]) | |
| 428 | 511 |
| 2828 | 512 (define-key compose-map "th" [(?\376)]) |
| 428 | 513 |
| 2828 | 514 (define-key compose-map "u`" [(?\371)]) |
| 515 (define-key compose-map "u'" [(?\372)]) | |
| 516 (define-key compose-map "u^" [(?\373)]) | |
| 517 (define-key compose-map "u\"" [(?\374)]) | |
| 518 (define-key compose-map "u/" [(?\265)]) | |
| 428 | 519 |
| 2828 | 520 (define-key compose-map "x0" [(?\244)]) |
| 521 (define-key compose-map "xO" [(?\244)]) | |
| 522 (define-key compose-map "xo" [(?\244)]) | |
| 523 (define-key compose-map "xx" [(?\327)]) | |
| 428 | 524 |
| 2828 | 525 (define-key compose-map "y-" [(?\245)]) |
| 526 (define-key compose-map "y=" [(?\245)]) | |
| 527 (define-key compose-map "y'" [(?\375)]) | |
| 528 (define-key compose-map "y\"" [(?\377)]) | |
| 428 | 529 |
| 2828 | 530 (define-key compose-map "|C" [(?\242)]) |
| 531 (define-key compose-map "|c" [(?\242)]) | |
| 532 (define-key compose-map "||" [(?\246)]) | |
| 428 | 533 |
| 534 | |
| 2828 | 535 ;; [[ Suppose we type these three physical keys: [Multi_key " a] |
| 428 | 536 ;; Xlib can deliver these keys as the following sequences of keysyms: |
| 537 ;; | |
| 538 ;; - [Multi_key " a] (no surprise here) | |
| 539 ;; - [adiaeresis] (OK, Xlib is doing compose processing for us) | |
| 540 ;; - [Multi_key " adiaeresis] (Huh?) | |
| 541 ;; | |
| 542 ;; It is the last possibility that is arguably a bug. Xlib can't | |
| 543 ;; decide whether it's really doing compose processing or not (or | |
| 544 ;; actually, different parts of Xlib disagree). | |
| 545 ;; | |
| 2828 | 546 ;; So we'll just convert [Multi_key " adiaeresis] to [adiaeresis] ]] |
| 547 | |
| 548 (eval-when-compile | |
| 549 (when nil ;; Commenting out. | |
| 550 | |
| 551 ;; This _used_ to work with our X11-oriented keysyms above. With them | |
| 552 ;; gone, it won't. The X11 bug it works around should be long dead. (Ha! | |
| 553 ;; Wasn't it cockroaches that would have ruled the planet after World | |
| 554 ;; War III?) | |
| 555 | |
| 556 (defun xlib-input-method-bug-workaround (keymap) | |
| 557 (map-keymap | |
| 558 (lambda (key value) | |
| 559 (cond | |
| 560 ((keymapp value) | |
| 561 (xlib-input-method-bug-workaround value)) | |
| 562 ((and (sequencep value) | |
| 563 (eq 1 (length value)) | |
| 564 (null (lookup-key keymap value))) | |
| 565 (define-key keymap value value)))) | |
| 566 keymap)) | |
| 567 (xlib-input-method-bug-workaround compose-map) | |
| 568 (unintern 'xlib-input-method-bug-workaround))) | |
| 428 | 569 |
| 570 ;; While we're at it, a similar mechanism will make colon equivalent | |
| 571 ;; to doublequote for diaeresis processing. Some Xlibs do this. | |
| 572 (defun alias-colon-to-doublequote (keymap) | |
| 573 (map-keymap | |
| 574 (lambda (key value) | |
| 575 (when (keymapp value) | |
| 576 (alias-colon-to-doublequote value)) | |
| 577 (when (eq key '\") | |
| 578 (define-key keymap ":" value))) | |
| 579 keymap)) | |
| 580 (alias-colon-to-doublequote compose-map) | |
| 581 (unintern 'alias-colon-to-doublequote) | |
| 582 | |
| 583 ;;; Electric dead keys: making a' mean a-acute. | |
| 584 | |
| 585 | |
| 586 (defun electric-diacritic (&optional count) | |
| 587 "Modify the previous character with an accent. | |
| 588 For example, if `:' is bound to this command, then typing `a:' | |
| 589 will first insert `a' and then turn it into `\344' (adiaeresis). | |
| 590 The keys to which this command may be bound (and the accents | |
| 591 which it understands) are: | |
| 592 | |
| 593 ' (acute) \301\311\315\323\332\335 \341\351\355\363\372\375 | |
| 594 ` (grave) \300\310\314\322\331 \340\350\354\362\371 | |
| 595 : (diaeresis) \304\313\317\326\334 \344\353\357\366\374\377 | |
| 596 ^ (circumflex) \302\312\316\324\333 \342\352\356\364\373 | |
| 597 , (cedilla) \307\347 | |
| 598 . (ring) \305\345" | |
| 599 (interactive "p") | |
| 600 (or count (setq count 1)) | |
| 601 | |
| 602 (if (not (eq last-command 'self-insert-command)) | |
| 603 ;; Only do the magic if the two chars were typed in succession. | |
| 604 (self-insert-command count) | |
| 605 | |
| 606 ;; This is so that ``a : C-x u'' will transform `adiaeresis' back into `a:' | |
| 607 (self-insert-command count) | |
| 608 (undo-boundary) | |
| 609 (delete-char (- count)) | |
| 610 | |
| 611 (let* ((c last-command-char) | |
| 612 (map (cond ((eq c ?') compose-acute-map) | |
| 613 ((eq c ?`) compose-grave-map) | |
| 614 ((eq c ?,) compose-cedilla-map) | |
| 615 ((eq c ?:) compose-diaeresis-map) | |
| 616 ((eq c ?^) compose-circumflex-map) | |
| 617 ((eq c ?~) compose-tilde-map) | |
| 618 ((eq c ?.) compose-ring-map) | |
| 619 (t (error "unknown diacritic: %s (%c)" c c)))) | |
| 620 (base-char (preceding-char)) | |
| 621 (mod-char (and (>= (downcase base-char) ?a) ; only do alphabetics? | |
| 622 (<= (downcase base-char) ?z) | |
| 623 (lookup-key map (make-string 1 base-char))))) | |
| 624 (if (and (vectorp mod-char) (= (length mod-char) 1)) | |
| 625 (setq mod-char (aref mod-char 0))) | |
| 626 (if (and mod-char (symbolp mod-char)) | |
| 2828 | 627 (setq mod-char (or (get mod-char 'character-of-keysym) mod-char))) |
| 428 | 628 (if (and mod-char (> count 0)) |
| 629 (delete-char -1) | |
| 630 (setq mod-char c)) | |
| 631 (while (> count 0) | |
| 632 (insert mod-char) | |
| 633 (setq count (1- count)))))) | |
| 634 | |
| 635 ;; should "::" mean "¨" and ": " mean ":"? | |
| 636 ;; should we also do | |
| 637 ;; (?~ | |
| 638 ;; (?A "\303") | |
| 639 ;; (?C "\307") | |
| 640 ;; (?D "\320") | |
| 641 ;; (?N "\321") | |
| 642 ;; (?O "\325") | |
| 643 ;; (?a "\343") | |
| 644 ;; (?c "\347") | |
| 645 ;; (?d "\360") | |
| 646 ;; (?n "\361") | |
| 647 ;; (?o "\365") | |
| 648 ;; (?> "\273") | |
| 649 ;; (?< "\253") | |
| 650 ;; (? "~")) ; no special code | |
| 651 ;; (?\/ | |
| 652 ;; (?A "\305") ;; A-with-ring (Norwegian and Danish) | |
| 653 ;; (?E "\306") ;; AE-ligature (Norwegian and Danish) | |
| 654 ;; (?O "\330") | |
| 655 ;; (?a "\345") ;; a-with-ring (Norwegian and Danish) | |
| 656 ;; (?e "\346") ;; ae-ligature (Norwegian and Danish) | |
| 657 ;; (?o "\370") | |
| 658 ;; (? "/")) ; no special code | |
| 659 | |
| 660 | |
| 661 ;;; Providing help in the middle of a compose sequence. (Way cool.) | |
| 662 | |
| 663 (eval-when-compile | |
| 664 (defsubst next-composable-event () | |
| 665 (let (event) | |
| 666 (while (progn | |
| 667 (setq event (next-command-event)) | |
| 668 (not (or (key-press-event-p event) | |
| 669 (button-press-event-p event)))) | |
| 670 (dispatch-event event)) | |
| 671 event))) | |
| 672 | |
| 673 (defun compose-help (ignore-prompt) | |
| 674 (let* ((keys (apply 'vector (nbutlast (append (this-command-keys) nil)))) | |
| 675 (map (or (lookup-key function-key-map keys) | |
| 676 (error "can't find map? %s %s" keys (this-command-keys)))) | |
| 677 binding) | |
| 678 (save-excursion | |
| 679 (with-output-to-temp-buffer "*Help*" | |
| 680 (set-buffer "*Help*") | |
| 681 (erase-buffer) | |
| 682 (message "Working...") | |
| 683 (setq ctl-arrow 'compose) ; non-t-non-nil | |
| 684 (insert "You are typing a compose sequence. So far you have typed: ") | |
| 685 (insert (key-description keys)) | |
| 686 (insert "\nCompletions from here are:\n\n") | |
| 687 (map-keymap 'compose-help-mapper map t) | |
| 688 (message "? "))) | |
| 689 (while (keymapp map) | |
| 690 (setq binding (lookup-key map (vector (next-composable-event)))) | |
| 691 (if (null binding) | |
| 692 (message "No such key in keymap. Try again.") | |
| 693 (setq map binding))) | |
| 694 binding)) | |
| 695 | |
| 696 (put 'compose-help 'isearch-command t) ; so that it doesn't terminate isearch | |
| 697 | |
| 698 (defun compose-help-mapper (key binding) | |
| 699 (if (and (symbolp key) | |
| 2828 | 700 (get key 'character-of-keysym)) |
| 701 (setq key (get key 'character-of-keysym))) | |
| 428 | 702 (if (eq binding 'compose-help) ; suppress that... |
| 703 nil | |
| 704 (if (keymapp binding) | |
| 705 (let ((p (point))) | |
| 706 (map-keymap 'compose-help-mapper binding t) | |
| 707 (goto-char p) | |
| 708 (while (not (eobp)) | |
| 709 (if (characterp key) | |
| 710 (insert (make-string 1 key)) | |
| 711 (insert (single-key-description key))) | |
| 712 (insert " ") | |
| 713 (forward-line 1))) | |
| 714 (if (characterp key) | |
| 715 (insert (make-string 1 key)) | |
| 716 (insert (single-key-description key))) | |
| 717 (indent-to 16) | |
| 718 (let ((code (and (vectorp binding) | |
| 719 (= 1 (length binding)) | |
| 2828 | 720 (get (aref binding 0) 'character-of-keysym)))) |
| 428 | 721 (if code |
| 722 (insert (make-string 1 code)) | |
| 723 (if (stringp binding) | |
| 724 (insert binding) | |
| 725 (insert (prin1-to-string binding))))) | |
| 726 (when (and (vectorp binding) (= 1 (length binding))) | |
| 727 (indent-to 32) | |
| 728 (insert (symbol-name (aref binding 0))))) | |
| 729 (insert "\n"))) | |
| 730 | |
| 731 ;; define it at top-level in the compose map... | |
| 732 ;;(define-key compose-map [(control h)] 'compose-help) | |
| 733 ;;(define-key compose-map [help] 'compose-help) | |
| 734 ;; and then define it in each sub-map of the compose map. | |
| 735 (map-keymap | |
| 736 (lambda (key binding) | |
| 737 (when (keymapp binding) | |
| 738 ;; (define-key binding [(control h)] 'compose-help) | |
| 739 ;; (define-key binding [help] 'compose-help) | |
| 740 )) | |
| 741 compose-map nil) | |
| 742 | |
| 743 ;; Make redisplay display the accented letters | |
| 744 (if (memq (default-value 'ctl-arrow) '(t nil)) | |
| 745 (setq-default ctl-arrow 'iso-8859/1)) | |
| 746 | |
| 747 | |
| 748 (provide 'x-compose) | |
| 749 | |
| 750 ;;; x-compose.el ends here |