Mercurial > hg > xemacs-beta

comparison lisp/iso/iso-acc.el @ 20:859a2309aef8 r19-15b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 0293115a14e9
children 131b0175ea99
comparison
equal deleted inserted replaced
19:ac1f612d5250 20:859a2309aef8
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 ;; Version: 1.8 6 ;; Maintainer: Alexandre Oliva <oliva@dcc.unicamp.br>
7 ;; Maintainer: FSF
8 ;; Keywords: i18n 7 ;; Keywords: i18n
9 ;; Adapted to XEmacs 19.14 by Alexandre Oliva <oliva@dcc.unicamp.br> 8 ;; Adapted to XEmacs 19.14 by Alexandre Oliva <oliva@dcc.unicamp.br>
10 ;; Last update: Jan 25, 1997 9 ;; $Revision: 1.3 $
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 ;; , (cedilla) -> cedilla under the character (except on default mode). 45 ;; . (dot) -> dot over the character
46 ;; Also: /A is A-with-ring and /E is AE ligature. 46 ;; , (cedilla) -> cedilla under the character (except on default mode)
47 ;; Also: /A is A-with-ring and /E is AE ligature.
47 ;; 48 ;;
48 ;; The action taken depends on the key that follows the pseudo accent. 49 ;; The action taken depends on the key that follows the pseudo accent.
49 ;; In general: 50 ;; In general:
50 ;; 51 ;;
51 ;; pseudo-accent + appropriate letter -> accented letter 52 ;; pseudo-accent + appropriate letter -> accented letter
52 ;; pseudo-accent + space -> pseudo-accent (except for comma) 53 ;; pseudo-accent + space -> pseudo-accent (except comma)
53 ;; pseudo-accent + pseudo-accent -> accent (if available) 54 ;; pseudo-accent + pseudo-accent -> accent (if available)
54 ;; pseudo-accent + other -> pseudo-accent + other 55 ;; pseudo-accent + other -> pseudo-accent + other
55 ;; 56 ;;
56 ;; If the pseudo-accent is followed by anything else than a 57 ;; If the pseudo-accent is followed by anything else than a
57 ;; self-insert-command, the dead-key code is terminated, the 58 ;; self-insert-command, the dead-key code is terminated, the
70 71
71 ;; needed for compatibility with XEmacs 19.14 72 ;; needed for compatibility with XEmacs 19.14
72 (if (fboundp 'read-event) () 73 (if (fboundp 'read-event) ()
73 (defun read-event () (event-key (next-command-event)))) 74 (defun read-event () (event-key (next-command-event))))
74 75
75 ;; needed to work on GNU Emacs (had to use this function on XEmacs) 76 (if (fboundp 'character-to-event)
76 (if (fboundp 'character-to-event) () 77 (defun iso-char-to-event (ch)
77 (defun character-to-event (ch &optional event console meta) 78 "returns an event containing the given character"
78 (if (listp ch) (car ch) ch))) 79 (character-to-event (list ch)))
80 (defun iso-char-to-event (ch)
81 "returns the character itself"
82 ch))
79 83
80 ;; needed for compatibility with XEmacs 19.14 and GNU Emacs 19.30 84 ;; needed for compatibility with XEmacs 19.14 and GNU Emacs 19.30
81 (if (fboundp 'this-single-command-keys) () 85 (if (fboundp 'this-single-command-keys) ()
82 (if (string-match "Lucid" (version)) 86 (if (string-match "Lucid" (version))
83 (defun this-single-command-keys () 87 (defun this-single-command-keys ()
84 (setq this-command (not (this-command-keys))) 88 (setq this-command (not (this-command-keys)))
85 (this-command-keys)) 89 (this-command-keys))
86 (defun this-single-command-keys () (this-command-keys)))) 90 (defun this-single-command-keys () (this-command-keys))))
91
92 ;; end of compatibility modules
87 93
88 (defvar iso-languages 94 (defvar iso-languages
89 '(("portuguese" 95 '(("portuguese"
90 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) 96 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
91 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) 97 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
92 (?u . ?\372) (?c . ?\347) (?\ . ?') (space . ?')) 98 (?u . ?\372) (?c . ?\347) (?\ . ?') (space . ?'))
93 (?` (?A . ?\300) (?a . ?\340) (?\ . ?`) (space . ?`)) 99 (?` (?A . ?\300) (?a . ?\340) (?\ . ?`) (space . ?`))
94 (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) (?a . ?\342) (?e . ?\352) 100 (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) (?a . ?\342) (?e . ?\352)
95 (?o . ?\364) (?\ . ?^) (space . ?^)) 101 (?o . ?\364) (?\ . ?^) (space . ?^))
96 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\")) 102 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\"))
97 (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~) (space . ?\~)) 103 (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~)
104 (space . ?\~))
98 (?, (?c . ?\347) (?C . ?\307))) 105 (?, (?c . ?\347) (?C . ?\307)))
99 106
100 ("irish" 107 ("irish"
101 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) 108 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
102 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) 109 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
103 (?\ . ?') (space . ?'))) 110 (?\ . ?') (space . ?')))
104 111
105 ("french" 112 ("french"
106 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) 113 (?' (?E . ?\311) (?C . ?\307) (?e . ?\351) (?c . ?\347) (?\ . ?')
107 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) 114 (space . ?'))
108 (?u . ?\372) (?c . ?\347) (?\ . ?') (space . ?')) 115 (?` (?A . ?\300) (?E . ?\310) (?a . ?\340) (?e . ?\350) (?\ . ?`)
109 (?` (?A . ?\300) (?E . ?\310) (?a . ?\340) (?e . ?\350) (?\ . ?`) (space . ?`)) 116 (space . ?`))
110 (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333) 117 (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
111 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373) 118 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
112 (?\ . ?^) (space . ?^)) 119 (?\ . ?^) (space . ?^))
113 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\")) 120 (?\" (?E . ?\313) (?I . ?\317)
114 (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~) (space . ?\~)) 121 (?e . ?\353) (?i . ?\357) (?\ . ?\") (space . ?\"))
122 (?\~ (?< . ?\253) (?> . ?\273) (?C . ?\307) (?c . ?\347) (?\ . ?\~)
123 (space . ?\~))
115 (?, (?c . ?\347) (?C . ?\307))) 124 (?, (?c . ?\347) (?C . ?\307)))
116 125
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
117 ("latin-2" 151 ("latin-2"
118 (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315) 152 (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315)
119 (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246) 153 (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246)
120 (?U . ?\332) (?Y . ?\335) (?Z . ?\254) (?a . ?\341) (?c . ?\346) 154 (?U . ?\332) (?Y . ?\335) (?Z . ?\254) (?a . ?\341) (?c . ?\346)
121 (?d . ?\360) (?e . ?\351) (?i . ?\355) (?l . ?\345) (?n . ?\361) 155 (?d . ?\360) (?e . ?\351) (?i . ?\355) (?l . ?\345) (?n . ?\361)
188 "*Non-nil enables ISO Accents mode. 222 "*Non-nil enables ISO Accents mode.
189 Setting this variable makes it local to the current buffer. 223 Setting this variable makes it local to the current buffer.
190 See the function `iso-accents-mode'.") 224 See the function `iso-accents-mode'.")
191 (make-variable-buffer-local 'iso-accents-mode) 225 (make-variable-buffer-local 'iso-accents-mode)
192 226
193 (defvar iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/ ?,) 227 (defvar iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/ ?, ?.)
194 "*List of accent keys that become prefixes in ISO Accents mode. 228 "*List of accent keys that become prefixes in ISO Accents mode.
195 The default is (?' ?` ?^ ?\" ?~ ?/ ?,), which contains all the supported 229 The default is (?' ?` ?^ ?\" ?~ ?/ ?, ?.), which contains all the supported
196 accent keys. If you set this variable to a list in which some of those 230 accent keys. If you set this variable to a list in which some of those
197 characters are missing, the missing ones do not act as accents. 231 characters are missing, the missing ones do not act as accents.
198 232
199 Note that if you specify a language with `iso-accents-customize', 233 Note that if you specify a language with `iso-accents-customize',
200 that can also turn off certain prefixes (whichever ones are not needed in 234 that can also turn off certain prefixes (whichever ones are not needed in
227 (insert first-char) 261 (insert first-char)
228 (prog1 (read-event) 262 (prog1 (read-event)
229 (delete-region (1- (point)) (point))))) 263 (delete-region (1- (point)) (point)))))
230 (entry (cdr (assq second-char list)))) 264 (entry (cdr (assq second-char list))))
231 (if entry 265 (if entry
232 ;; Found it: insert the accented character and 266 ;; Found it: return the mapped char
233 ;; return a do-nothing key 267 (vector (iso-char-to-event entry))
234 (vector (character-to-event (list entry)))
235 ;; Otherwise, advance and schedule the second key for execution. 268 ;; Otherwise, advance and schedule the second key for execution.
236 (setq unread-command-events (append 269 (setq unread-command-events (cons (iso-char-to-event second-char)
237 (list 270 unread-command-events))
238 (character-to-event (list second-char))) 271 (vector (iso-char-to-event first-char)))))
239 unread-command-events))
240 (vector (character-to-event (list first-char))))))
241 272
242 ;; It is a matter of taste if you want the minor mode indicated 273 ;; It is a matter of taste if you want the minor mode indicated
243 ;; in the mode line... 274 ;; in the mode line...
244 ;; If so, uncomment the next four lines. 275 ;; If so, uncomment the next four lines.
245 ;; (or (assq 'iso-accents-mode minor-mode-alist) 276 ;; (or (assq 'iso-accents-mode minor-mode-alist)
281 (setq iso-accents-mode nil) 312 (setq iso-accents-mode nil)
282 313
283 ;; Enable electric accents. 314 ;; Enable electric accents.
284 (setq iso-accents-mode t))) 315 (setq iso-accents-mode t)))
285 316
286 (defvar iso-accents-mode-map nil)
287
288 (defun iso-accents-customize (language) 317 (defun iso-accents-customize (language)
289 "Customize the ISO accents machinery for a particular language. 318 "Customize the ISO accents machinery for a particular language.
290 It selects the customization based on the specifications in the 319 It selects the customization based on the specifications in the
291 `iso-languages' variable." 320 `iso-languages' variable."
292 (interactive (list (completing-read "Language: " iso-languages nil t))) 321 (interactive (list (completing-read "Language: " iso-languages nil t)))
293 (let ((table (assoc language iso-languages)) tail acc) 322 (let ((table (assoc language iso-languages))
323 tail)
294 (if (not table) 324 (if (not table)
295 (error "Unknown language '%s'" language) 325 (error "Unknown language '%s'" language)
296 (setq iso-language language 326 (setq iso-language language
297 iso-accents-list (cdr table)) 327 iso-accents-list (cdr table))
298 (if key-translation-map 328 (if key-translation-map
299 (substitute-key-definition 329 (substitute-key-definition
300 'iso-accents-accent-key nil key-translation-map) 330 'iso-accents-accent-key nil key-translation-map)
301 (setq key-translation-map (make-sparse-keymap))) 331 (setq key-translation-map (make-sparse-keymap)))
302 (setq iso-accents-mode-map (make-sparse-keymap))
303 (let ((pair (assoc 'iso-accents-mode minor-mode-map-alist)))
304 (if pair
305 (setcdr pair iso-accents-mode-map)
306 (let ((l minor-mode-map-alist))
307 (while (cdr l)
308 (setq l (cdr l)))
309 (setcdr l (list (cons 'iso-accents-mode iso-accents-mode-map))))))
310 ;; Set up translations for all the characters that are used as 332 ;; Set up translations for all the characters that are used as
311 ;; accent prefixes in this language. 333 ;; accent prefixes in this language.
312 (setq tail iso-accents-list) 334 (setq tail iso-accents-list)
313 (while tail 335 (while tail
314 (define-key key-translation-map 336 (define-key key-translation-map (vector (iso-char-to-event
315 (vector (character-to-event (list (car (car tail))))) 337 (car (car tail))))
316 'iso-accents-accent-key) 338 'iso-accents-accent-key)
317 (setq acc (cdr (car tail)))
318 (while acc
319 (define-key iso-accents-mode-map
320 (vector (character-to-event (list (cdr (car acc)))))
321 'iso-accents-self-insert-unless-redefined)
322 (setq acc (cdr acc)))
323 (setq tail (cdr tail)))))) 339 (setq tail (cdr tail))))))
324
325 (defun iso-accents-self-insert-unless-redefined (prompt)
326 "Temporarily disables iso-accents-mode, and checks for additional bindings of the keys that produced its invocation. If no such binding is found, 'self-insert-command is returned"
327 (interactive "p")
328 (let* ((iso-accents-mode nil)
329 (bind (key-binding (this-command-keys)))
330 (repeat t) result)
331 (while repeat
332 (setq result
333 (cond ((or (null bind)
334 (eq bind 'self-insert-command))
335 (setq repeat nil)
336 (self-insert-command prompt))
337 ((commandp bind)
338 (setq repeat nil)
339 (call-interactively bind))
340 ((or (stringp bind)
341 (keymapp bind))
342 (setq repeat nil)
343 bind)
344 ((and (consp bind)
345 (stringp (car bind)))
346 (setq bind (cdr bind)))
347 ((and (consp bind)
348 (keymapp (car bind)))
349 (setq bind (lookup-key (car bind) (cdr bind))))
350 (t (error "Invalid key binding")))))
351 result))
352 340
353 (defun iso-accentuate (start end) 341 (defun iso-accentuate (start end)
354 "Convert two-character sequences in region into accented characters. 342 "Convert two-character sequences in region into accented characters.
355 Noninteractively, this operates on text from START to END. 343 Noninteractively, this operates on text from START to END.
356 This uses the same conversion that ISO Accents mode uses for type-in." 344 This uses the same conversion that ISO Accents mode uses for type-in."