1 ;;; iso-acc.el --- minor mode providing electric accent keys
3 ;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
5 ;; Author: Johan Vromans
7 ;; Adapted-By: Alexandre Oliva <oliva@dcc.unicamp.br>
10 ;; $Date: 1998-03-22 17:25:31 $
12 ;; This file is part of GNU Emacs.
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
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
31 ;; Function `iso-accents-mode' activates a minor mode in which
32 ;; typewriter "dead keys" are emulated. The purpose of this emulation
33 ;; is to provide a simple means for inserting accented characters
34 ;; according to the ISO-8859-1 and other character sets.
36 ;; In `iso-accents-mode', pseudo accent characters are used to
37 ;; introduce accented keys. The pseudo-accent characters are:
39 ;; ' (minute) -> grave accent
40 ;; ` (backtick) -> acute accent
41 ;; " (second) -> diaeresis
42 ;; ^ (caret) -> circumflex
43 ;; ~ (tilde) -> tilde over the character
44 ;; / (slash) -> slash through the character
45 ;; Also: /A is A-with-ring and /E is AE ligature.
46 ;; . (dot) -> dot over the character
47 ;; , (cedilla) -> cedilla under the character (some languages only)
49 ;; The action taken depends on the key that follows the pseudo accent.
52 ;; pseudo-accent + appropriate letter -> accented letter
53 ;; pseudo-accent + space -> pseudo-accent (except comma)
54 ;; pseudo-accent + pseudo-accent -> accent (if available)
55 ;; pseudo-accent + other -> pseudo-accent + other
57 ;; If the pseudo-accent is followed by anything else than a
58 ;; self-insert-command, the dead-key code is terminated, the
59 ;; pseudo-accent inserted 'as is' and the bell is rung to signal this.
61 ;; Function `iso-accents-mode' can be used to enable the iso accents
62 ;; minor mode, or disable it.
64 ;; If you want only some of these characters to serve as accents,
65 ;; add a language to `iso-languages' which specifies the accent characters
66 ;; that you want, then select the language with `iso-accents-customize'.
72 ;; multiple Emacs versions compatibility section
74 (if (fboundp 'make-char)
75 (defun iso-make-char (charset char)
77 ((integerp char) (make-char charset char))
78 ((and (char-or-string-p char) (not (stringp char))) char)
79 (t (error "invalid character"))))
80 (defun iso-make-char (charset char) "Returns its second argument" char))
82 (if (fboundp 'read-event)
83 (defalias 'iso-read-event 'read-event)
84 (defun iso-read-event ()
85 (event-key (next-command-event))))
87 (if (fboundp 'character-to-event)
89 (defun iso-char-list-to-event (l)
90 "returns an event containing the given list of characters"
91 (character-to-event l))
92 (defun iso-char-to-event (ch)
93 "returns an event containing the given character"
94 (iso-char-list-to-event (list ch))))
95 (defalias 'iso-char-to-event 'identity)
96 (defalias 'iso-char-list-to-event 'identity))
98 (if (fboundp 'this-single-command-keys) ()
99 (if (string-match "Lucid" (version))
100 (defun this-single-command-keys ()
101 (setq this-command (not (this-command-keys)))
103 (defun this-single-command-keys () (this-command-keys))))
105 ;; end of compatibility section
107 (defvar iso-languages
109 ;; Note this includes some extra characters used in Spanish,
110 ;; on the idea that someone who uses Catalan is likely to use Spanish
112 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
113 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
115 (?` (?A . ?\300) (?E . ?\310) (?O . ?\322)
116 (?a . ?\340) (?e . ?\350) (?o . ?\362) (?\ . ?`))
117 (?\" (?I . ?\317) (?U . ?\334) (?i . ?\357) (?u . ?\374) (?\ . ?\"))
118 (?~ (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361)
119 (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277)
123 (?^ (?H . ?\246) (?J . ?\254) (?h . ?\266) (?j . ?\274) (?C . ?\306)
124 (?G . ?\330) (?S . ?\336) (?c . ?\346) (?g . ?\370) (?s . ?\376)
126 (?~ (?U . ?\335) (?u . ?\375) (?\ . ?~)))
129 (?' (?E . ?\311) (?C . ?\307)
130 (?e . ?\351) (?c . ?\347)
131 (?\ . ?') (space . ?'))
132 (?` (?A . ?\300) (?E . ?\310) (?U . ?\331)
133 (?a . ?\340) (?e . ?\350) (?u . ?\371)
134 (?\ . ?`) (space . ?`))
135 (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
136 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
137 (?\ . ?^) (space . ?^))
138 (?\" (?E . ?\313) (?I . ?\317)
139 (?e . ?\353) (?i . ?\357)
140 (?\ . ?\") (space . ?\"))
141 (?~ (?< . ?\253) (?> . ?\273)
142 (?C . ?\307) (?c . ?\347)
143 (?\ . ?~) (space . ?~))
144 (?, (?c . ?\347) (?C . ?\307) (?, . ?,)))
147 (?\" (?A . ?\304) (?O . ?\326) (?U . ?\334)
148 (?a . ?\344) (?o . ?\366) (?u . ?\374) (?s . ?\337) (?\ . ?\")))
151 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
152 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
153 (?\ . ?') (space . ?')))
156 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
157 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
158 (?u . ?\372) (?c . ?\347) (?\ . ?') (space . ?'))
159 (?` (?A . ?\300) (?a . ?\340) (?\ . ?`) (space . ?`))
160 (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) (?a . ?\342) (?e . ?\352)
161 (?o . ?\364) (?\ . ?^) (space . ?^))
162 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\"))
163 (?~ (?A . ?\303) (?O . ?\325)
164 (?a . ?\343) (?o . ?\365)
165 (?\ . ?~) (space . ?~))
166 (?, (?c . ?\347) (?C . ?\307) (?, . ?,)))
169 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
170 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
172 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\"))
173 (?~ (?N . ?\321) (?n . ?\361) (?> . ?\273) (?< . ?\253) (?! . ?\241)
174 (?? . ?\277) (?\ . ?~)))
177 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
178 (?Y . ?\335) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
179 (?u . ?\372) (?y . ?\375) (?' . ?\264) (?\ . ?') (space . ?'))
180 (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
181 (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
182 (?` . ?`) (?\ . ?`) (space . ?`))
183 (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
184 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
185 (?^ . ?^) (?\ . ?^) (space . ?^))
186 (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
187 (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?s . ?\337)
188 (?u . ?\374) (?y . ?\377) (?\" . ?\250) (?\ . ?\") (space . ?\"))
189 (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325)
190 (?T . ?\336) (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361)
191 (?o . ?\365) (?t . ?\376) (?> . ?\273) (?< . ?\253) (?~ . ?\270)
192 (?! . ?\241) (?? . ?\277)
193 (?\ . ?~) (space . ?~))
194 (?/ (?A . ?\305) (?E . ?\306) (?O . ?\330) (?a . ?\345) (?e . ?\346)
195 (?o . ?\370) (?/ . ?\260) (?\ . ?/) (space . ?/)))
197 ("latin-2" latin-iso8859-2
198 (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315)
199 (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246)
200 (?U . ?\332) (?Y . ?\335) (?Z . ?\254)
201 (?a . ?\341) (?c . ?\346) (?d . ?\360) (?e . ?\351) (?i . ?\355)
202 (?l . ?\345) (?n . ?\361) (?o . ?\363) (?r . ?\340) (?s . ?\266)
203 (?u . ?\372) (?y . ?\375) (?z . ?\274)
204 (?' . ?\264) (?\ . ?') (space . ?'))
205 (?` (?A . ?\241) (?C . ?\307) (?E . ?\312) (?L . ?\243) (?S . ?\252)
206 (?T . ?\336) (?Z . ?\257)
207 (?a . ?\261) (?l . ?\263) (?c . ?\347) (?e . ?\352) (?s . ?\272)
208 (?t . ?\376) (?z . ?\277)
210 (?. . ?\377) (?\ . ?`) (space . ?`))
211 (?^ (?A . ?\302) (?I . ?\316) (?O . ?\324)
212 (?a . ?\342) (?i . ?\356) (?o . ?\364)
213 (?^ . ?^) ; no special code?
214 (?\ . ?^) (space . ?^))
215 (?\" (?A . ?\304) (?E . ?\313) (?O . ?\326) (?U . ?\334)
216 (?a . ?\344) (?e . ?\353) (?o . ?\366) (?s . ?\337) (?u . ?\374)
218 (?\ . ?\") (space . ?\"))
219 (?~ (?A . ?\303) (?C . ?\310) (?D . ?\317) (?L . ?\245) (?N . ?\322)
220 (?O . ?\325) (?R . ?\330) (?S . ?\251) (?T . ?\253) (?U . ?\333)
222 (?a . ?\343) (?c . ?\350) (?d . ?\357) (?l . ?\265) (?n . ?\362)
223 (?o . ?\365) (?r . ?\370) (?s . ?\271) (?t . ?\273) (?u . ?\373)
225 (?v . ?\242) ; v accent
226 (?~ . ?\242) ; v accent
227 (?. . ?\270) ; cedilla accent
228 (?\ . ?~) (space . ?~)))
230 ("latin-3" latin-iso8859-3
231 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
232 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
233 (?' . ?\264) (?\ . ?') (space . ?'))
234 (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
235 (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
236 (?` . ?`) (?\ . ?`) (space . ?`))
237 (?^ (?A . ?\302) (?C . ?\306) (?E . ?\312) (?G . ?\330)
238 (?H . ?\246) (?I . ?\316) (?J . ?\254) (?O . ?\324)
239 (?S . ?\336) (?U . ?\333)
240 (?a . ?\342) (?c . ?\346) (?e . ?\352) (?g . ?\370) (?h . ?\266)
241 (?i . ?\356) (?j . ?\274) (?o . ?\364) (?s . ?\376) (?u . ?\373)
242 (?^ . ?^) (?\ . ?^) (space . \^))
243 (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
244 (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?u . ?\374)
246 (?\" . ?\250) (?\ . ?\") (space . ?\"))
247 (?. (?C . ?\305) (?G . ?\325) (?I . ?\251) (?Z . ?\257)
248 (?c . ?\345) (?g . ?\365) (?z . ?\277))
249 (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?G . ?\253) (?N . ?\321)
250 (?O . ?\325) (?S . ?\252) (?U . ?\335)
251 (?a . ?\343) (?c . ?\347) (?d . ?\360) (?g . ?\273) (?n . ?\361)
252 (?o . ?\365) (?s . ?\252) (?u . ?\375)
253 (?h . ?\261) (?$ . ?\245) (?` . ?\242)
254 (?~ . ?\270) (?\ . ?~) (space . ?~))
255 (?/ (?C . ?\305) (?G . ?\325) (?H . ?\241) (?I . ?\251) (?Z . ?\257)
256 (?c . ?\345) (?g . ?\365) (?h . ?\261) (?i . ?\271) (?z . ?\277)
257 (?r . ?\256) (?. . ?\377) (?# . ?\243) (?$ . ?\244)
258 (?/ . ?\260) (?\ . ?/) (space . ?/)))
260 "List of language-specific customizations for the ISO Accents mode.
262 Each element of the list is of the form
265 (PSEUDO-ACCENT MAPPINGS)
266 (PSEUDO-ACCENT MAPPINGS)
269 LANGUAGE is a string naming the language.
270 CHARSET (which may be omitted) is the symbol name
271 of the character set used in this language.
272 If CHARSET is omitted, latin-iso8859-1 is the default.
273 PSEUDO-ACCENT is a char specifying an accent key.
274 MAPPINGS are cons cells of the form (CHAR . ISO-CHAR).
276 The net effect is that the key sequence PSEUDO-ACCENT CHAR is mapped
277 to ISO-CHAR on input.")
279 (defvar iso-language nil
280 "Language for which ISO Accents mode is currently customized.
281 Change it with the `iso-accents-customize' function.")
283 (defvar iso-accents-list nil
284 "Association list for ISO accent combinations, for the chosen language.")
286 (defvar iso-accents-charset 'latin-iso8859-1
287 "Charset that will be used for generated characters.")
289 (defvar iso-accents-mode nil
290 "*Non-nil enables ISO Accents mode.
291 Setting this variable makes it local to the current buffer.
292 See the function `iso-accents-mode'.")
293 (make-variable-buffer-local 'iso-accents-mode)
295 (defvar iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/ ?, ?.)
296 "*List of accent keys that become prefixes in ISO Accents mode.
297 The default is (?' ?` ?^ ?\" ?~ ?/ ?, ?.), which contains all the supported
298 accent keys. If you set this variable to a list in which some of those
299 characters are missing, the missing ones do not act as accents.
301 Note that if you specify a language with `iso-accents-customize',
302 that can also turn off certain prefixes (whichever ones are not needed in
303 the language you choose).")
305 (defun iso-accents-accent-key (prompt)
306 "Modify the following character by adding an accent to it."
307 ;; Pick up the accent character.
308 (if (and iso-accents-mode
309 (memq last-input-char iso-accents-enable))
310 (iso-accents-compose prompt)
311 (char-to-string last-input-char)))
313 (defun iso-accents-compose (prompt)
314 (let* ((first-char last-input-char)
315 (list (assq first-char iso-accents-list))
316 (charset iso-accents-charset)
317 ;; Wait for the second key and look up the combination.
318 (second-char (if (or prompt
319 (not (eq (key-binding "a")
320 'self-insert-command))
321 ;; Not at start of a key sequence.
322 (> (length (this-single-command-keys)) 1)
323 ;; Called from anything but the command loop.
327 (or prompt "Compose with ")
331 (prog1 (iso-read-event)
332 (delete-region (1- (point)) (point)))))
333 (entry (cdr (assq second-char list))))
336 (if (and (consp entry) (symbolp (car entry)))
337 (setq charset (car entry)
339 ;; Found it: return the mapped char
341 (iso-char-to-event (iso-make-char charset entry))))
342 ;; Otherwise, advance and schedule the second key for execution.
343 (setq unread-command-events (cons (iso-char-list-to-event
345 unread-command-events))
346 (vector (iso-char-to-event first-char)))))
348 ;; It is a matter of taste if you want the minor mode indicated
349 ;; in the mode line...
350 ;; If so, uncomment the next four lines.
351 ;; (or (assq 'iso-accents-mode minor-mode-alist)
352 ;; (setq minor-mode-alist
353 ;; (append minor-mode-alist
354 ;; '((iso-accents-mode " ISO-Acc")))))
357 (defun iso-accents-mode (&optional arg)
358 "Toggle ISO Accents mode, in which accents modify the following letter.
359 This permits easy insertion of accented characters according to ISO-8859-1.
360 When Iso-accents mode is enabled, accent character keys
361 \(`, ', \", ^, / and ~) do not self-insert; instead, they modify the following
362 letter key so that it inserts an ISO accented letter.
364 You can customize ISO Accents mode to a particular language
365 with the command `iso-accents-customize'.
367 Special combinations: ~c gives a c with cedilla,
368 ~d gives an Icelandic eth (d with dash).
369 ~t gives an Icelandic thorn.
370 \"s gives German sharp s.
371 /a gives a with ring.
372 /e gives an a-e ligature.
373 ~< and ~> give guillemots.
374 ~! gives an inverted exclamation mark.
375 ~? gives an inverted question mark.
377 With an argument, a positive argument enables ISO Accents mode,
378 and a negative argument disables it."
383 ;; Negative arg means switch it off.
384 (<= (prefix-numeric-value arg) 0)
385 ;; No arg means toggle.
387 (setq iso-accents-mode nil)
389 ;; Enable electric accents.
390 (setq iso-accents-mode t)))
392 (defun iso-accents-customize (language)
393 "Customize the ISO accents machinery for a particular language.
394 It selects the customization based on the specifications in the
395 `iso-languages' variable."
396 (interactive (list (completing-read "Language: " iso-languages nil t)))
397 (let ((table (cdr (assoc language iso-languages)))
400 (error "Unknown language `%s'" language)
401 (setq iso-accents-charset (if (symbolp (car table))
404 (if (symbolp (car table))
405 (setq table (cdr table)))
406 (setq iso-language language
407 iso-accents-list table)
408 (if key-translation-map
409 (substitute-key-definition
410 'iso-accents-accent-key nil key-translation-map)
411 (setq key-translation-map (make-sparse-keymap)))
412 ;; Set up translations for all the characters that are used as
413 ;; accent prefixes in this language.
414 (setq tail iso-accents-list)
416 (define-key key-translation-map (vector (iso-char-to-event
418 'iso-accents-accent-key)
419 (setq tail (cdr tail))))))
421 (defun iso-accentuate (start end)
422 "Convert two-character sequences in region into accented characters.
423 Noninteractively, this operates on text from START to END.
424 This uses the same conversion that ISO Accents mode uses for type-in."
428 (narrow-to-region start end)
432 (while (< (point) end)
433 (if (and (memq (preceding-char) iso-accents-enable)
434 (setq entry (cdr (assq (following-char) (assq (preceding-char) iso-accents-list)))))
440 (forward-char 1)))))))
442 (defun iso-accent-rassoc-unit (value alist)
444 (while (and alist (not elt))
445 (setq acc (car (car alist))
446 elt (car (rassq value (cdr (car alist))))
451 (defun iso-unaccentuate (start end)
452 "Convert accented characters in the region into two-character sequences.
453 Noninteractively, this operates on text from START to END.
454 This uses the opposite of the conversion done by ISO Accents mode for type-in."
458 (narrow-to-region start end)
461 (while (< (point) end)
462 (if (and (> (following-char) 127)
463 (setq entry (iso-accent-rassoc-unit (following-char)
467 (insert (car entry) (cdr entry))
469 (forward-char 1)))))))
471 (defun iso-deaccentuate (start end)
472 "Convert accented characters in the region into unaccented characters.
473 Noninteractively, this operates on text from START to END."
477 (narrow-to-region start end)
480 (while (< (point) end)
481 (if (and (> (following-char) 127)
482 (setq entry (iso-accent-rassoc-unit (following-char)
486 (insert (cdr entry)))
487 (forward-char 1)))))))
489 ;; Set up the default settings.
490 (iso-accents-customize "latin-1")
492 ;; Use Iso-Accents mode in the minibuffer
493 ;; if it was in use in the previous buffer.
494 (defun iso-acc-minibuf-setup ()
495 (setq iso-accents-mode
497 (set-buffer (window-buffer minibuffer-scroll-window))
500 (if (boundp 'minibuffer-setup-hook)
501 (add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup)
502 (add-hook 'minibuf-setup-hook 'iso-acc-minibuf-setup))
504 ;;; iso-acc.el ends here