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.