Mercurial > hg > xemacs-beta

comparison lisp/iso/iso-acc.el @ 88:821dec489c24 r20-0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0
author cvs
date Mon, 13 Aug 2007 09:09:59 +0200
parents 131b0175ea99
children 1040fe1366ac
comparison
equal deleted inserted replaced
87:7df2982f5c17 88:821dec489c24
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.7 (modified) 6 ;; Version: 1.8
7 ;; Maintainer: FSF 7 ;; Maintainer: FSF
8 ;; Keywords: i18n 8 ;; Keywords: i18n
9 ;; Adapted for XEmacs 19.14 by Alexandre Oliva <oliva@dcc.unicamp.br> 9 ;; Adapted to XEmacs 19.14 by Alexandre Oliva <oliva@dcc.unicamp.br>
10 ;; Last update: Oct 10, 1996 10 ;; Last update: Jan 25, 1997
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
72 (if (fboundp 'read-event) () 72 (if (fboundp 'read-event) ()
73 (defun read-event () (event-key (next-command-event)))) 73 (defun read-event () (event-key (next-command-event))))
74 74
75 ;; needed to work on GNU Emacs (had to use this function on XEmacs) 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 character-to-event (ch &optional event console meta) ch)) 77 (defun character-to-event (ch &optional event console meta)
78 (if (listp ch) (car ch) ch)))
78 79
79 ;; needed for compatibility with XEmacs 19.14 and GNU Emacs 19.30 80 ;; needed for compatibility with XEmacs 19.14 and GNU Emacs 19.30
80 (if (fboundp 'this-single-command-keys) () 81 (if (fboundp 'this-single-command-keys) ()
81 (if (string-match "Lucid" (version)) 82 (if (string-match "Lucid" (version))
82 (defun this-single-command-keys () 83 (defun this-single-command-keys ()
83 (setq this-command (not (this-command-keys))) 84 (setq this-command (not (this-command-keys)))
84 (this-command-keys)) 85 (this-command-keys))
85 (defun this-single-command-keys () (this-command-keys)))) 86 (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 87
107 (defvar iso-languages 88 (defvar iso-languages
108 '(("portuguese" 89 '(("portuguese"
109 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) 90 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
110 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) 91 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
246 (insert first-char) 227 (insert first-char)
247 (prog1 (read-event) 228 (prog1 (read-event)
248 (delete-region (1- (point)) (point))))) 229 (delete-region (1- (point)) (point)))))
249 (entry (cdr (assq second-char list)))) 230 (entry (cdr (assq second-char list))))
250 (if entry 231 (if entry
251 ;; Found it: return the mapped char 232 ;; Found it: insert the accented character and
252 (iso-generate-char entry) 233 ;; return a do-nothing key
234 (vector (character-to-event (list entry)))
253 ;; Otherwise, advance and schedule the second key for execution. 235 ;; Otherwise, advance and schedule the second key for execution.
254 (setq unread-command-events (list (character-to-event second-char))) 236 (setq unread-command-events (append
255 (vector first-char)))) 237 (list
238 (character-to-event (list second-char)))
239 unread-command-events))
240 (vector (character-to-event (list first-char))))))
256 241
257 ;; It is a matter of taste if you want the minor mode indicated 242 ;; It is a matter of taste if you want the minor mode indicated
258 ;; in the mode line... 243 ;; in the mode line...
259 ;; If so, uncomment the next four lines. 244 ;; If so, uncomment the next four lines.
260 ;; (or (assq 'iso-accents-mode minor-mode-alist) 245 ;; (or (assq 'iso-accents-mode minor-mode-alist)
296 (setq iso-accents-mode nil) 281 (setq iso-accents-mode nil)
297 282
298 ;; Enable electric accents. 283 ;; Enable electric accents.
299 (setq iso-accents-mode t))) 284 (setq iso-accents-mode t)))
300 285
286 (defvar iso-accents-mode-map nil)
287
301 (defun iso-accents-customize (language) 288 (defun iso-accents-customize (language)
302 "Customize the ISO accents machinery for a particular language. 289 "Customize the ISO accents machinery for a particular language.
303 It selects the customization based on the specifications in the 290 It selects the customization based on the specifications in the
304 `iso-languages' variable." 291 `iso-languages' variable."
305 (interactive (list (completing-read "Language: " iso-languages nil t))) 292 (interactive (list (completing-read "Language: " iso-languages nil t)))
306 (let ((table (assoc language iso-languages)) tail) 293 (let ((table (assoc language iso-languages)) tail acc)
307 (if (not table) 294 (if (not table)
308 (error "Unknown language '%s'" language) 295 (error "Unknown language '%s'" language)
309 (setq iso-language language 296 (setq iso-language language
310 iso-accents-list (cdr table)) 297 iso-accents-list (cdr table))
311 (if key-translation-map 298 (if key-translation-map
312 (substitute-key-definition 299 (substitute-key-definition
313 'iso-accents-accent-key nil key-translation-map) 300 'iso-accents-accent-key nil key-translation-map)
314 (setq key-translation-map (make-sparse-keymap))) 301 (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))))))
315 ;; Set up translations for all the characters that are used as 310 ;; Set up translations for all the characters that are used as
316 ;; accent prefixes in this language. 311 ;; accent prefixes in this language.
317 (setq tail iso-accents-list) 312 (setq tail iso-accents-list)
318 (while tail 313 (while tail
319 (define-key key-translation-map (vector (car (car tail))) 314 (define-key key-translation-map
315 (vector (character-to-event (list (car (car tail)))))
320 'iso-accents-accent-key) 316 '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)))
321 (setq tail (cdr tail)))))) 323 (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))
322 352
323 (defun iso-accentuate (start end) 353 (defun iso-accentuate (start end)
324 "Convert two-character sequences in region into accented characters. 354 "Convert two-character sequences in region into accented characters.
325 Noninteractively, this operates on text from START to END. 355 Noninteractively, this operates on text from START to END.
326 This uses the same conversion that ISO Accents mode uses for type-in." 356 This uses the same conversion that ISO Accents mode uses for type-in."