Mercurial > hg > xemacs-beta

comparison lisp/iso/iso-acc.el @ 4:b82b59fe008d r19-15b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
3:30df88044ec6 4:b82b59fe008d
1 ;;; iso-acc.el --- minor mode providing electric accent keys
2
3 ;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
4
5 ;; Author: Johan Vromans <jv@mh.nl>
6 ;; Version: 1.7 (modified)
7 ;; Maintainer: FSF
8 ;; Keywords: i18n
9 ;; Adapted for XEmacs 19.14 by Alexandre Oliva <oliva@dcc.unicamp.br>
10 ;; Last update: Oct 10, 1996
11
12 ;; This file is part of GNU Emacs.
13
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)
17 ;; any later version.
18
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.
23
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.
28
29 ;;; Commentary:
30
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 character set.
35 ;;
36 ;; In `iso-accents-mode', pseudo accent characters are used to
37 ;; introduce accented keys. The pseudo-accent characters are:
38 ;;
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 ;; , (cedilla) -> cedilla under the character (except on default mode).
46 ;; Also: /A is A-with-ring and /E is AE ligature.
47 ;;
48 ;; The action taken depends on the key that follows the pseudo accent.
49 ;; In general:
50 ;;
51 ;; pseudo-accent + appropriate letter -> accented letter
52 ;; pseudo-accent + space -> pseudo-accent (except for comma)
53 ;; pseudo-accent + pseudo-accent -> accent (if available)
54 ;; pseudo-accent + other -> pseudo-accent + other
55 ;;
56 ;; If the pseudo-accent is followed by anything else than a
57 ;; self-insert-command, the dead-key code is terminated, the
58 ;; pseudo-accent inserted 'as is' and the bell is rung to signal this.
59 ;;
60 ;; Function `iso-accents-mode' can be used to enable the iso accents
61 ;; minor mode, or disable it.
62
63 ;; If you want only some of these characters to serve as accents,
64 ;; add a language to `iso-languages' which specifies the accent characters
65 ;; that you want, then select the language with `iso-accents-customize'.
66
67 ;;; Code:
68
69 (provide 'iso-acc)
70
71 ;; needed for compatibility with XEmacs 19.14
72 (if (fboundp 'read-event) ()
73 (defun read-event () (event-key (next-command-event))))
74
75 ;; needed to work on GNU Emacs (had to use this function on XEmacs)
76 (if (fboundp 'character-to-event) ()
77 (defun character-to-event (ch &optional event console meta) ch))
78
79 ;; needed for compatibility with XEmacs 19.14 and GNU Emacs 19.30
80 (if (fboundp 'this-single-command-keys) ()
81 (if (string-match "Lucid" (version))
82 (defun this-single-command-keys ()
83 (setq this-command (not (this-command-keys)))
84 (this-command-keys))
85 (defun this-single-command-keys () (this-command-keys))))
86
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
106
107 (defvar iso-languages
108 '(("portuguese"
109 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
110 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
111 (?u . ?\372) (?c . ?\347) (?\ . ?') (space . ?'))
112 (?` (?A . ?\300) (?a . ?\340) (?\ . ?`) (space . ?`))
113 (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) (?a . ?\342) (?e . ?\352)
114 (?o . ?\364) (?\ . ?^) (space . ?^))
115 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\"))
116 (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~) (space . ?\~))
117 (?, (?c . ?\347) (?C . ?\307)))
118
119 ("irish"
120 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
121 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
122 (?\ . ?') (space . ?')))
123
124 ("french"
125 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
126 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
127 (?u . ?\372) (?c . ?\347) (?\ . ?') (space . ?'))
128 (?` (?A . ?\300) (?E . ?\310) (?a . ?\340) (?e . ?\350) (?\ . ?`) (space . ?`))
129 (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
130 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
131 (?\ . ?^) (space . ?^))
132 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\"))
133 (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~) (space . ?\~))
134 (?, (?c . ?\347) (?C . ?\307)))
135
136 ("latin-2"
137 (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315)
138 (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246)
139 (?U . ?\332) (?Y . ?\335) (?Z . ?\254) (?a . ?\341) (?c . ?\346)
140 (?d . ?\360) (?e . ?\351) (?i . ?\355) (?l . ?\345) (?n . ?\361)
141 (?o . ?\363) (?r . ?\340) (?s . ?\266) (?u . ?\372) (?y . ?\375)
142 (?z . ?\274) (?' . ?\264) (?\ . ?') (space . ?'))
143 (?` (?A . ?\241) (?C . ?\307) (?E . ?\312) (?L . ?\243) (?S . ?\252)
144 (?T . ?\336) (?Z . ?\257) (?a . ?\261) (?l . ?\263) (?c . ?\347)
145 (?e . ?\352) (?s . ?\272) (?t . ?\376) (?z . ?\277) (?` . ?\252)
146 (?. . ?\377) (?\ . ?`) (space . ?`))
147 (?^ (?A . ?\302) (?O . ?\324) (?a . ?\342) (?o . ?\364)
148 (?^ . ?^) ; no special code?
149 (?\ . ?^) (space . ?^))
150 (?\" (?A . ?\304) (?E . ?\313) (?O . ?\326) (?U . ?\334) (?a . ?\344)
151 (?e . ?\353) (?o . ?\366) (?s . ?\337) (?u . ?\374) (?\" . ?\250)
152 (?\ . ?\") (space . ?\"))
153 (?\~ (?A . ?\303) (?C . ?\310) (?D . ?\317) (?L . ?\245) (?N . ?\322)
154 (?O . ?\325) (?R . ?\330) (?S . ?\251) (?T . ?\253) (?U . ?\333)
155 (?Z . ?\256) (?a . ?\323) (?c . ?\350) (?d . ?\357) (?l . ?\265)
156 (?n . ?\362) (?o . ?\365) (?r . ?\370) (?s . ?\271) (?t . ?\273)
157 (?u . ?\373) (?z . ?\276)
158 (?v . ?\242) ; v accent
159 (?\~ . ?\242) ; v accent
160 (?\. . ?\270) ; cedilla accent
161 (?\ . ?\~) (space . ?\~)))
162
163 ("latin-1"
164 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
165 (?Y . ?\335) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
166 (?u . ?\372) (?y . ?\375) (?' . ?\264) (?\ . ?') (space . ?'))
167 (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
168 (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
169 (?` . ?`) (?\ . ?`) (space . ?`))
170 (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
171 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
172 (?^ . ?^) (?\ . ?^) (space . ?^))
173 (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
174 (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?s . ?\337)
175 (?u . ?\374) (?y . ?\377) (?\" . ?\250) (?\ . ?\") (space . ?\"))
176 (?\~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325)
177 (?T . ?\336) (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361)
178 (?o . ?\365) (?t . ?\376) (?> . ?\273) (?< . ?\253) (?\~ . ?\270)
179 (?! . ?\241) (?? . ?\277)
180 (?\ . ?\~) (space . ?\~))
181 (?\/ (?A . ?\305) (?E . ?\306) (?O . ?\330) (?a . ?\345) (?e . ?\346)
182 (?o . ?\370) (?\/ . ?\260) (?\ . ?\/) (space . ?\/))))
183 "List of language-specific customizations for the ISO Accents mode.
184
185 Each element of the list is of the form
186
187 (LANGUAGE
188 (PSEUDO-ACCENT MAPPINGS)
189 (PSEUDO-ACCENT MAPPINGS)
190 ...)
191
192 LANGUAGE is a string naming the language.
193 PSEUDO-ACCENT is a char specifying an accent key.
194 MAPPINGS are cons cells of the form (CHAR . ISO-CHAR).
195
196 The net effect is that the key sequence PSEUDO-ACCENT CHAR is mapped
197 to ISO-CHAR on input.")
198
199 (defvar iso-language nil
200 "Language for which ISO Accents mode is currently customized.
201 Change it with the `iso-accents-customize' function.")
202
203 (defvar iso-accents-list nil
204 "Association list for ISO accent combinations, for the chosen language.")
205
206 (defvar iso-accents-mode nil
207 "*Non-nil enables ISO Accents mode.
208 Setting this variable makes it local to the current buffer.
209 See the function `iso-accents-mode'.")
210 (make-variable-buffer-local 'iso-accents-mode)
211
212 (defvar iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/ ?,)
213 "*List of accent keys that become prefixes in ISO Accents mode.
214 The default is (?' ?` ?^ ?\" ?~ ?/ ?,), which contains all the supported
215 accent keys. If you set this variable to a list in which some of those
216 characters are missing, the missing ones do not act as accents.
217
218 Note that if you specify a language with `iso-accents-customize',
219 that can also turn off certain prefixes (whichever ones are not needed in
220 the language you choose).")
221
222 (defun iso-accents-accent-key (prompt)
223 "Modify the following character by adding an accent to it."
224 ;; Pick up the accent character.
225 (if (and iso-accents-mode
226 (memq last-input-char iso-accents-enable))
227 (iso-accents-compose prompt)
228 (char-to-string last-input-char)))
229
230 (defun iso-accents-compose (prompt)
231 (let* ((first-char last-input-char)
232 (list (assq first-char iso-accents-list))
233 ;; Wait for the second key and look up the combination.
234 (second-char (if (or prompt
235 (not (eq (key-binding "a")
236 'self-insert-command))
237 ;; Not at start of a key sequence.
238 (> (length (this-single-command-keys)) 1)
239 ;; Called from anything but the command loop.
240 this-command)
241 (progn
242 (message "%s%c"
243 (or prompt "Compose with ")
244 first-char)
245 (read-event))
246 (insert first-char)
247 (prog1 (read-event)
248 (delete-region (1- (point)) (point)))))
249 (entry (cdr (assq second-char list))))
250 (if entry
251 ;; Found it: return the mapped char
252 (iso-generate-char entry)
253 ;; Otherwise, advance and schedule the second key for execution.
254 (setq unread-command-events (list (character-to-event second-char)))
255 (vector first-char))))
256
257 ;; It is a matter of taste if you want the minor mode indicated
258 ;; in the mode line...
259 ;; If so, uncomment the next four lines.
260 ;; (or (assq 'iso-accents-mode minor-mode-alist)
261 ;; (setq minor-mode-alist
262 ;; (append minor-mode-alist
263 ;; '((iso-accents-mode " ISO-Acc")))))
264
265 ;;;###autoload
266 (defun iso-accents-mode (&optional arg)
267 "Toggle ISO Accents mode, in which accents modify the following letter.
268 This permits easy insertion of accented characters according to ISO-8859-1.
269 When Iso-accents mode is enabled, accent character keys
270 \(`, ', \", ^, / and ~) do not self-insert; instead, they modify the following
271 letter key so that it inserts an ISO accented letter.
272
273 You can customize ISO Accents mode to a particular language
274 with the command `iso-accents-customize'.
275
276 Special combinations: ~c gives a c with cedilla,
277 ~d gives an Icelandic eth (d with dash).
278 ~t gives an Icelandic thorn.
279 \"s gives German sharp s.
280 /a gives a with ring.
281 /e gives an a-e ligature.
282 ~< and ~> give guillemots.
283 ~! gives an inverted exclamation mark.
284 ~? gives an inverted question mark.
285
286 With an argument, a positive argument enables ISO Accents mode,
287 and a negative argument disables it."
288
289 (interactive "P")
290
291 (if (if arg
292 ;; Negative arg means switch it off.
293 (<= (prefix-numeric-value arg) 0)
294 ;; No arg means toggle.
295 iso-accents-mode)
296 (setq iso-accents-mode nil)
297
298 ;; Enable electric accents.
299 (setq iso-accents-mode t)))
300
301 (defun iso-accents-customize (language)
302 "Customize the ISO accents machinery for a particular language.
303 It selects the customization based on the specifications in the
304 `iso-languages' variable."
305 (interactive (list (completing-read "Language: " iso-languages nil t)))
306 (let ((table (assoc language iso-languages)) tail)
307 (if (not table)
308 (error "Unknown language '%s'" language)
309 (setq iso-language language
310 iso-accents-list (cdr table))
311 (if key-translation-map
312 (substitute-key-definition
313 'iso-accents-accent-key nil key-translation-map)
314 (setq key-translation-map (make-sparse-keymap)))
315 ;; Set up translations for all the characters that are used as
316 ;; accent prefixes in this language.
317 (setq tail iso-accents-list)
318 (while tail
319 (define-key key-translation-map (vector (car (car tail)))
320 'iso-accents-accent-key)
321 (setq tail (cdr tail))))))
322
323 (defun iso-accentuate (start end)
324 "Convert two-character sequences in region into accented characters.
325 Noninteractively, this operates on text from START to END.
326 This uses the same conversion that ISO Accents mode uses for type-in."
327 (interactive "r")
328 (save-excursion
329 (save-restriction
330 (narrow-to-region start end)
331 (goto-char start)
332 (forward-char 1)
333 (let (entry)
334 (while (< (point) end)
335 (if (and (memq (preceding-char) iso-accents-enable)
336 (setq entry (cdr (assq (following-char) (assq (preceding-char) iso-accents-list)))))
337 (progn
338 (forward-char -1)
339 (delete-char 2)
340 (insert entry)
341 (setq end (1- end)))
342 (forward-char 1)))))))
343
344 (defun iso-accent-rassoc-unit (value alist)
345 (let (elt acc)
346 (while (and alist (not elt))
347 (setq acc (car (car alist))
348 elt (car (rassq value (cdr (car alist))))
349 alist (cdr alist)))
350 (if elt
351 (cons acc elt))))
352
353 (defun iso-unaccentuate (start end)
354 "Convert accented characters in the region into two-character sequences.
355 Noninteractively, this operates on text from START to END.
356 This uses the opposite of the conversion done by ISO Accents mode for type-in."
357 (interactive "r")
358 (save-excursion
359 (save-restriction
360 (narrow-to-region start end)
361 (goto-char start)
362 (let (entry)
363 (while (< (point) end)
364 (if (and (> (following-char) 127)
365 (setq entry (iso-accent-rassoc-unit (following-char)
366 iso-accents-list)))
367 (progn
368 (delete-char 1)
369 (insert (car entry) (cdr entry))
370 (setq end (1+ end)))
371 (forward-char 1)))))))
372
373 (defun iso-deaccentuate (start end)
374 "Convert accented characters in the region into unaccented characters.
375 Noninteractively, this operates on text from START to END."
376 (interactive "r")
377 (save-excursion
378 (save-restriction
379 (narrow-to-region start end)
380 (goto-char start)
381 (let (entry)
382 (while (< (point) end)
383 (if (and (> (following-char) 127)
384 (setq entry (iso-accent-rassoc-unit (following-char)
385 iso-accents-list)))
386 (progn
387 (delete-char 1)
388 (insert (cdr entry)))
389 (forward-char 1)))))))
390
391 ;; Set up the default settings.
392 (iso-accents-customize "latin-1")
393
394 ;; Use Iso-Accents mode in the minibuffer
395 ;; if it was in use in the previous buffer.
396 (defun iso-acc-minibuf-setup ()
397 (setq iso-accents-mode
398 (save-excursion
399 (set-buffer (window-buffer minibuffer-scroll-window))
400 iso-accents-mode)))
401
402 (add-hook 'minibuf-setup-hook 'iso-acc-minibuf-setup)
403
404 ;;; iso-acc.el ends here