Mercurial > hg > xemacs-beta
comparison lisp/iso/iso-acc.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | 859a2309aef8 |
children | 821dec489c24 |
comparison
equal
deleted
inserted
replaced
69:804d1389bcd6 | 70:131b0175ea99 |
---|---|
1 ;;; iso-acc.el --- minor mode providing electric accent keys | 1 ;;; iso-acc.el --- minor mode providing electric accent keys |
2 | 2 |
3 ;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Johan Vromans <jv@mh.nl> | 5 ;; Author: Johan Vromans <jv@mh.nl> |
6 ;; Maintainer: Alexandre Oliva <oliva@dcc.unicamp.br> | 6 ;; Version: 1.7 (modified) |
7 ;; Maintainer: FSF | |
7 ;; Keywords: i18n | 8 ;; Keywords: i18n |
8 ;; Adapted to XEmacs 19.14 by Alexandre Oliva <oliva@dcc.unicamp.br> | 9 ;; Adapted for XEmacs 19.14 by Alexandre Oliva <oliva@dcc.unicamp.br> |
9 ;; $Revision: 1.3 $ | 10 ;; Last update: Oct 10, 1996 |
10 ;; $Date: 1997/02/09 23:51:31 $ | |
11 | 11 |
12 ;; This file is part of GNU Emacs. | 12 ;; This file is part of GNU Emacs. |
13 | 13 |
14 ;; GNU Emacs is free software; you can redistribute it and/or modify | 14 ;; GNU Emacs is free software; you can redistribute it and/or modify |
15 ;; it under the terms of the GNU General Public License as published by | 15 ;; it under the terms of the GNU General Public License as published by |
39 ;; ' (minute) -> grave accent | 39 ;; ' (minute) -> grave accent |
40 ;; ` (backtick) -> acute accent | 40 ;; ` (backtick) -> acute accent |
41 ;; " (second) -> diaeresis | 41 ;; " (second) -> diaeresis |
42 ;; ^ (caret) -> circumflex | 42 ;; ^ (caret) -> circumflex |
43 ;; ~ (tilde) -> tilde over the character | 43 ;; ~ (tilde) -> tilde over the character |
44 ;; / (slash) -> slash through the character | 44 ;; / (slash) -> slash through the character. |
45 ;; . (dot) -> dot over the character | 45 ;; , (cedilla) -> cedilla under the character (except on default mode). |
46 ;; , (cedilla) -> cedilla under the character (except on default mode) | 46 ;; Also: /A is A-with-ring and /E is AE ligature. |
47 ;; Also: /A is A-with-ring and /E is AE ligature. | |
48 ;; | 47 ;; |
49 ;; The action taken depends on the key that follows the pseudo accent. | 48 ;; The action taken depends on the key that follows the pseudo accent. |
50 ;; In general: | 49 ;; In general: |
51 ;; | 50 ;; |
52 ;; pseudo-accent + appropriate letter -> accented letter | 51 ;; pseudo-accent + appropriate letter -> accented letter |
53 ;; pseudo-accent + space -> pseudo-accent (except comma) | 52 ;; pseudo-accent + space -> pseudo-accent (except for comma) |
54 ;; pseudo-accent + pseudo-accent -> accent (if available) | 53 ;; pseudo-accent + pseudo-accent -> accent (if available) |
55 ;; pseudo-accent + other -> pseudo-accent + other | 54 ;; pseudo-accent + other -> pseudo-accent + other |
56 ;; | 55 ;; |
57 ;; If the pseudo-accent is followed by anything else than a | 56 ;; If the pseudo-accent is followed by anything else than a |
58 ;; self-insert-command, the dead-key code is terminated, the | 57 ;; self-insert-command, the dead-key code is terminated, the |
71 | 70 |
72 ;; needed for compatibility with XEmacs 19.14 | 71 ;; needed for compatibility with XEmacs 19.14 |
73 (if (fboundp 'read-event) () | 72 (if (fboundp 'read-event) () |
74 (defun read-event () (event-key (next-command-event)))) | 73 (defun read-event () (event-key (next-command-event)))) |
75 | 74 |
76 (if (fboundp 'character-to-event) | 75 ;; needed to work on GNU Emacs (had to use this function on XEmacs) |
77 (defun iso-char-to-event (ch) | 76 (if (fboundp 'character-to-event) () |
78 "returns an event containing the given character" | 77 (defun character-to-event (ch &optional event console meta) ch)) |
79 (character-to-event (list ch))) | |
80 (defun iso-char-to-event (ch) | |
81 "returns the character itself" | |
82 ch)) | |
83 | 78 |
84 ;; needed for compatibility with XEmacs 19.14 and GNU Emacs 19.30 | 79 ;; needed for compatibility with XEmacs 19.14 and GNU Emacs 19.30 |
85 (if (fboundp 'this-single-command-keys) () | 80 (if (fboundp 'this-single-command-keys) () |
86 (if (string-match "Lucid" (version)) | 81 (if (string-match "Lucid" (version)) |
87 (defun this-single-command-keys () | 82 (defun this-single-command-keys () |
88 (setq this-command (not (this-command-keys))) | 83 (setq this-command (not (this-command-keys))) |
89 (this-command-keys)) | 84 (this-command-keys)) |
90 (defun this-single-command-keys () (this-command-keys)))) | 85 (defun this-single-command-keys () (this-command-keys)))) |
91 | 86 |
92 ;; end of compatibility modules | 87 (if (string-match "Lucid" (version)) |
88 (progn | |
89 (global-set-key [quoted-insert-for-iso-acc] 'quoted-insert) | |
90 (defun iso-generate-char (char) | |
91 "inserts the octal representation of char into unread-command-events,\nand then returns the pseudo-key quoted-insert-for-iso-acc (which should be mapped to quoted-insert).\n\nCan be used in keymaps to generate characters from 128 to 255." | |
92 (setq unread-command-events | |
93 (append | |
94 (mapcar 'character-to-event (list | |
95 (+ 48 (/ char 64)) | |
96 (+ 48 (% (/ char 8) 8)) | |
97 (+ 48 (% char 8)))) | |
98 unread-command-events)) | |
99 [quoted-insert-for-iso-acc]) | |
100 ) | |
101 (defun iso-generate-char (char) | |
102 "Just returns a vector with the given character.\n\nNot necessary in the GNU Emacs implementation" | |
103 (vector char)) | |
104 ) | |
105 | |
93 | 106 |
94 (defvar iso-languages | 107 (defvar iso-languages |
95 '(("portuguese" | 108 '(("portuguese" |
96 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) | 109 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) |
97 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) | 110 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) |
98 (?u . ?\372) (?c . ?\347) (?\ . ?') (space . ?')) | 111 (?u . ?\372) (?c . ?\347) (?\ . ?') (space . ?')) |
99 (?` (?A . ?\300) (?a . ?\340) (?\ . ?`) (space . ?`)) | 112 (?` (?A . ?\300) (?a . ?\340) (?\ . ?`) (space . ?`)) |
100 (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) (?a . ?\342) (?e . ?\352) | 113 (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) (?a . ?\342) (?e . ?\352) |
101 (?o . ?\364) (?\ . ?^) (space . ?^)) | 114 (?o . ?\364) (?\ . ?^) (space . ?^)) |
102 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\")) | 115 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\")) |
103 (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~) | 116 (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~) (space . ?\~)) |
104 (space . ?\~)) | |
105 (?, (?c . ?\347) (?C . ?\307))) | 117 (?, (?c . ?\347) (?C . ?\307))) |
106 | 118 |
107 ("irish" | 119 ("irish" |
108 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) | 120 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) |
109 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) | 121 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) |
110 (?\ . ?') (space . ?'))) | 122 (?\ . ?') (space . ?'))) |
111 | 123 |
112 ("french" | 124 ("french" |
113 (?' (?E . ?\311) (?C . ?\307) (?e . ?\351) (?c . ?\347) (?\ . ?') | 125 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) |
114 (space . ?')) | 126 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) |
115 (?` (?A . ?\300) (?E . ?\310) (?a . ?\340) (?e . ?\350) (?\ . ?`) | 127 (?u . ?\372) (?c . ?\347) (?\ . ?') (space . ?')) |
116 (space . ?`)) | 128 (?` (?A . ?\300) (?E . ?\310) (?a . ?\340) (?e . ?\350) (?\ . ?`) (space . ?`)) |
117 (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333) | 129 (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333) |
118 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373) | 130 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373) |
119 (?\ . ?^) (space . ?^)) | 131 (?\ . ?^) (space . ?^)) |
120 (?\" (?E . ?\313) (?I . ?\317) | 132 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\")) |
121 (?e . ?\353) (?i . ?\357) (?\ . ?\") (space . ?\")) | 133 (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~) (space . ?\~)) |
122 (?\~ (?< . ?\253) (?> . ?\273) (?C . ?\307) (?c . ?\347) (?\ . ?\~) | |
123 (space . ?\~)) | |
124 (?, (?c . ?\347) (?C . ?\307))) | 134 (?, (?c . ?\347) (?C . ?\307))) |
125 | 135 |
126 ;;; ISO-8859-3, developed by D. Dale Gulledge <ddg@cci.com> | |
127 ("latin-3" | |
128 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) | |
129 (?U . ?\332) (?a . ?\341) (?e . ?\351) (?i . ?\355) | |
130 (?o . ?\363) (?u . ?\372) (?\ . ?') (space . ?')) | |
131 (?. (?C . ?\305) (?G . ?\325) (?I . ?\251) (?Z . ?\257) | |
132 (?c . ?\345) (?g . ?\365) (?z . ?\277)) | |
133 (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) | |
134 (?U . ?\334) (?a . ?\344) (?e . ?\353) (?i . ?\357) | |
135 (?o ?\366) (?u ?\374) (?\ . ?\") (space . ?\")) | |
136 (?\/ (?\/ . ?\260) (?\ . ?/) (space . ?/)) | |
137 (?\~ (?C . ?\307) (?G . ?\253) (?N . ?\321) (?S . ?\252) | |
138 (?U . ?\335) (?\~ . ?\270) (?c . ?\347) (?g . ?\273) | |
139 (?h . ?\261) (?n . ?\361) (?u . ?\375) | |
140 (?\ . ?~) (space . ?~)) | |
141 (?^ (?A . ?\302) (?C . ?\306) (?E . ?\312) (?G . ?\330) | |
142 (?H . ?\246) (?I . ?\316) (?J . ?\254) (?O . ?\324) | |
143 (?S . ?\336) (?U . ?\333) (?a . ?\342) (?c . ?\346) | |
144 (?e . ?\352) (?g . ?\370) (?h . ?\266) (?i . ?\356) | |
145 (?j . ?\274) (?o . ?\364) (?s . ?\376) (?u . ?\373) | |
146 (?\ . ?^) (space . \^)) | |
147 (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) | |
148 (?U . ?\331) (?a . ?\340) (?e . ?\350) (?i . ?\354) | |
149 (?o . ?\362) (?u . ?\371) (?\ . ?`) (space . ?`))) | |
150 | |
151 ("latin-2" | 136 ("latin-2" |
152 (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315) | 137 (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315) |
153 (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246) | 138 (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246) |
154 (?U . ?\332) (?Y . ?\335) (?Z . ?\254) (?a . ?\341) (?c . ?\346) | 139 (?U . ?\332) (?Y . ?\335) (?Z . ?\254) (?a . ?\341) (?c . ?\346) |
155 (?d . ?\360) (?e . ?\351) (?i . ?\355) (?l . ?\345) (?n . ?\361) | 140 (?d . ?\360) (?e . ?\351) (?i . ?\355) (?l . ?\345) (?n . ?\361) |
222 "*Non-nil enables ISO Accents mode. | 207 "*Non-nil enables ISO Accents mode. |
223 Setting this variable makes it local to the current buffer. | 208 Setting this variable makes it local to the current buffer. |
224 See the function `iso-accents-mode'.") | 209 See the function `iso-accents-mode'.") |
225 (make-variable-buffer-local 'iso-accents-mode) | 210 (make-variable-buffer-local 'iso-accents-mode) |
226 | 211 |
227 (defvar iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/ ?, ?.) | 212 (defvar iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/ ?,) |
228 "*List of accent keys that become prefixes in ISO Accents mode. | 213 "*List of accent keys that become prefixes in ISO Accents mode. |
229 The default is (?' ?` ?^ ?\" ?~ ?/ ?, ?.), which contains all the supported | 214 The default is (?' ?` ?^ ?\" ?~ ?/ ?,), which contains all the supported |
230 accent keys. If you set this variable to a list in which some of those | 215 accent keys. If you set this variable to a list in which some of those |
231 characters are missing, the missing ones do not act as accents. | 216 characters are missing, the missing ones do not act as accents. |
232 | 217 |
233 Note that if you specify a language with `iso-accents-customize', | 218 Note that if you specify a language with `iso-accents-customize', |
234 that can also turn off certain prefixes (whichever ones are not needed in | 219 that can also turn off certain prefixes (whichever ones are not needed in |
262 (prog1 (read-event) | 247 (prog1 (read-event) |
263 (delete-region (1- (point)) (point))))) | 248 (delete-region (1- (point)) (point))))) |
264 (entry (cdr (assq second-char list)))) | 249 (entry (cdr (assq second-char list)))) |
265 (if entry | 250 (if entry |
266 ;; Found it: return the mapped char | 251 ;; Found it: return the mapped char |
267 (vector (iso-char-to-event entry)) | 252 (iso-generate-char entry) |
268 ;; Otherwise, advance and schedule the second key for execution. | 253 ;; Otherwise, advance and schedule the second key for execution. |
269 (setq unread-command-events (cons (iso-char-to-event second-char) | 254 (setq unread-command-events (list (character-to-event second-char))) |
270 unread-command-events)) | 255 (vector first-char)))) |
271 (vector (iso-char-to-event first-char))))) | |
272 | 256 |
273 ;; It is a matter of taste if you want the minor mode indicated | 257 ;; It is a matter of taste if you want the minor mode indicated |
274 ;; in the mode line... | 258 ;; in the mode line... |
275 ;; If so, uncomment the next four lines. | 259 ;; If so, uncomment the next four lines. |
276 ;; (or (assq 'iso-accents-mode minor-mode-alist) | 260 ;; (or (assq 'iso-accents-mode minor-mode-alist) |
317 (defun iso-accents-customize (language) | 301 (defun iso-accents-customize (language) |
318 "Customize the ISO accents machinery for a particular language. | 302 "Customize the ISO accents machinery for a particular language. |
319 It selects the customization based on the specifications in the | 303 It selects the customization based on the specifications in the |
320 `iso-languages' variable." | 304 `iso-languages' variable." |
321 (interactive (list (completing-read "Language: " iso-languages nil t))) | 305 (interactive (list (completing-read "Language: " iso-languages nil t))) |
322 (let ((table (assoc language iso-languages)) | 306 (let ((table (assoc language iso-languages)) tail) |
323 tail) | |
324 (if (not table) | 307 (if (not table) |
325 (error "Unknown language '%s'" language) | 308 (error "Unknown language '%s'" language) |
326 (setq iso-language language | 309 (setq iso-language language |
327 iso-accents-list (cdr table)) | 310 iso-accents-list (cdr table)) |
328 (if key-translation-map | 311 (if key-translation-map |
331 (setq key-translation-map (make-sparse-keymap))) | 314 (setq key-translation-map (make-sparse-keymap))) |
332 ;; Set up translations for all the characters that are used as | 315 ;; Set up translations for all the characters that are used as |
333 ;; accent prefixes in this language. | 316 ;; accent prefixes in this language. |
334 (setq tail iso-accents-list) | 317 (setq tail iso-accents-list) |
335 (while tail | 318 (while tail |
336 (define-key key-translation-map (vector (iso-char-to-event | 319 (define-key key-translation-map (vector (car (car tail))) |
337 (car (car tail)))) | |
338 'iso-accents-accent-key) | 320 'iso-accents-accent-key) |
339 (setq tail (cdr tail)))))) | 321 (setq tail (cdr tail)))))) |
340 | 322 |
341 (defun iso-accentuate (start end) | 323 (defun iso-accentuate (start end) |
342 "Convert two-character sequences in region into accented characters. | 324 "Convert two-character sequences in region into accented characters. |