Mercurial > hg > xemacs-beta

comparison lisp/iso/iso-acc.el @ 169:15872534500d r20-3b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b11
author cvs
date Mon, 13 Aug 2007 09:46:53 +0200
parents 25f70ba0133c
children
comparison
equal deleted inserted replaced
168:9851d5c6556e 169:15872534500d
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 5 ;; Author: Johan Vromans
6 ;; Maintainer: Alexandre Oliva <oliva@dcc.unicamp.br> 6 ;; Maintainer: Alexandre Oliva <oliva@dcc.unicamp.br>
7 ;; Keywords: i18n 7 ;; Keywords: i18n
8 ;; $Revision: 1.5 $ 8 ;; $Revision: 1.6 $
9 ;; $Date: 1997/05/29 23:49:45 $ 9 ;; $Date: 1997/07/07 00:52:57 $
10 10
11 ;; This file is part of GNU Emacs. 11 ;; This file is part of GNU Emacs.
12 12
13 ;; GNU Emacs is free software; you can redistribute it and/or modify 13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by 14 ;; it under the terms of the GNU General Public License as published by
69 (provide 'iso-acc) 69 (provide 'iso-acc)
70 70
71 ;; multiple Emacs versions compatibility section 71 ;; multiple Emacs versions compatibility section
72 72
73 (if (fboundp 'make-char) 73 (if (fboundp 'make-char)
74 (defalias 'iso-make-char 'make-char) 74 (defun iso-make-char (charset char)
75 (defun iso-make-char (charset) 128)) 75 (cond
76 ((integerp char) (make-char charset char))
77 ((and (char-or-string-p char) (not (stringp char))) char)
78 (t (error "invalid character"))))
79 (defun iso-make-char (charset char) "Returns its second argument" char))
76 80
77 (if (fboundp 'read-event) 81 (if (fboundp 'read-event)
78 (defalias 'iso-read-event 'read-event) 82 (defalias 'iso-read-event 'read-event)
79 (defun iso-read-event () 83 (defun iso-read-event ()
80 (event-key (next-command-event)))) 84 (event-key (next-command-event))))
94 (if (string-match "Lucid" (version)) 98 (if (string-match "Lucid" (version))
95 (defun this-single-command-keys () 99 (defun this-single-command-keys ()
96 (setq this-command (not (this-command-keys))) 100 (setq this-command (not (this-command-keys)))
97 (this-command-keys)) 101 (this-command-keys))
98 (defun this-single-command-keys () (this-command-keys)))) 102 (defun this-single-command-keys () (this-command-keys))))
99
100 (defvar iso-accents-insert-offset
101 (if (boundp 'nonascii-insert-offset)
102 nonascii-insert-offset
103 0)
104 "*Offset added by ISO Accents mode to character codes 0200 and above.")
105 103
106 ;; end of compatibility section 104 ;; end of compatibility section
107 105
108 (defvar iso-languages 106 (defvar iso-languages
109 '(("catalan" 107 '(("catalan"
282 Change it with the `iso-accents-customize' function.") 280 Change it with the `iso-accents-customize' function.")
283 281
284 (defvar iso-accents-list nil 282 (defvar iso-accents-list nil
285 "Association list for ISO accent combinations, for the chosen language.") 283 "Association list for ISO accent combinations, for the chosen language.")
286 284
285 (defvar iso-accents-charset 'latin-iso8859-1
286 "Charset that will be used for generated characters.")
287
287 (defvar iso-accents-mode nil 288 (defvar iso-accents-mode nil
288 "*Non-nil enables ISO Accents mode. 289 "*Non-nil enables ISO Accents mode.
289 Setting this variable makes it local to the current buffer. 290 Setting this variable makes it local to the current buffer.
290 See the function `iso-accents-mode'.") 291 See the function `iso-accents-mode'.")
291 (make-variable-buffer-local 'iso-accents-mode) 292 (make-variable-buffer-local 'iso-accents-mode)
309 (char-to-string last-input-char))) 310 (char-to-string last-input-char)))
310 311
311 (defun iso-accents-compose (prompt) 312 (defun iso-accents-compose (prompt)
312 (let* ((first-char last-input-char) 313 (let* ((first-char last-input-char)
313 (list (assq first-char iso-accents-list)) 314 (list (assq first-char iso-accents-list))
315 (charset iso-accents-charset)
314 ;; Wait for the second key and look up the combination. 316 ;; Wait for the second key and look up the combination.
315 (second-char (if (or prompt 317 (second-char (if (or prompt
316 (not (eq (key-binding "a") 318 (not (eq (key-binding "a")
317 'self-insert-command)) 319 'self-insert-command))
318 ;; Not at start of a key sequence. 320 ;; Not at start of a key sequence.
327 (insert first-char) 329 (insert first-char)
328 (prog1 (iso-read-event) 330 (prog1 (iso-read-event)
329 (delete-region (1- (point)) (point))))) 331 (delete-region (1- (point)) (point)))))
330 (entry (cdr (assq second-char list)))) 332 (entry (cdr (assq second-char list))))
331 (if entry 333 (if entry
334 (progn
335 (if (and (consp entry) (symbolp (car entry)))
336 (setq charset (car entry)
337 entry (cdr entry)))
332 ;; Found it: return the mapped char 338 ;; Found it: return the mapped char
333 (vector 339 (vector
334 (iso-char-to-event 340 (iso-char-to-event (iso-make-char charset entry))))
335 (if (and (boundp 'enable-multibyte-characters)
336 enable-multibyte-characters
337 (>= entry ?\200))
338 (+ iso-accents-insert-offset entry)
339 entry)))
340 ;; Otherwise, advance and schedule the second key for execution. 341 ;; Otherwise, advance and schedule the second key for execution.
341 (setq unread-command-events (cons (iso-char-list-to-event 342 (setq unread-command-events (cons (iso-char-list-to-event
342 (list second-char)) 343 (list second-char))
343 unread-command-events)) 344 unread-command-events))
344 (vector (iso-char-to-event first-char))))) 345 (vector (iso-char-to-event first-char)))))
394 (interactive (list (completing-read "Language: " iso-languages nil t))) 395 (interactive (list (completing-read "Language: " iso-languages nil t)))
395 (let ((table (cdr (assoc language iso-languages))) 396 (let ((table (cdr (assoc language iso-languages)))
396 tail) 397 tail)
397 (if (not table) 398 (if (not table)
398 (error "Unknown language `%s'" language) 399 (error "Unknown language `%s'" language)
399 (setq iso-accents-insert-offset (- (iso-make-char 400 (setq iso-accents-charset (if (symbolp (car table))
400 (if (symbolp (car table)) 401 (car table)
401 (car table) 402 'latin-iso8859-1))
402 'latin-iso8859-1))
403 128))
404 (if (symbolp (car table)) 403 (if (symbolp (car table))
405 (setq table (cdr table))) 404 (setq table (cdr table)))
406 (setq iso-language language 405 (setq iso-language language
407 iso-accents-list table) 406 iso-accents-list table)
408 (if key-translation-map 407 (if key-translation-map