diff lisp/iso/iso-acc.el @ 16:0293115a14e9 r19-15b91

Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents b82b59fe008d
children 859a2309aef8
line wrap: on
line diff
--- a/lisp/iso/iso-acc.el	Mon Aug 13 08:48:43 2007 +0200
+++ b/lisp/iso/iso-acc.el	Mon Aug 13 08:49:20 2007 +0200
@@ -3,11 +3,11 @@
 ;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
 
 ;; Author: Johan Vromans <jv@mh.nl>
-;; Version: 1.7 (modified)
+;; Version: 1.8
 ;; Maintainer: FSF
 ;; Keywords: i18n
-;; Adapted for XEmacs 19.14 by Alexandre Oliva <oliva@dcc.unicamp.br>
-;; Last update: Oct 10, 1996
+;; Adapted to XEmacs 19.14 by Alexandre Oliva <oliva@dcc.unicamp.br>
+;; Last update: Jan 25, 1997
 
 ;; This file is part of GNU Emacs.
 
@@ -74,7 +74,8 @@
 
 ;; needed to work on GNU Emacs (had to use this function on XEmacs)
 (if (fboundp 'character-to-event) ()
-  (defun character-to-event (ch &optional event console meta) ch))
+  (defun character-to-event (ch &optional event console meta)
+    (if (listp ch) (car ch) ch)))
 
 ;; needed for compatibility with XEmacs 19.14 and GNU Emacs 19.30
 (if (fboundp 'this-single-command-keys) ()
@@ -84,26 +85,6 @@
 	(this-command-keys))
     (defun this-single-command-keys () (this-command-keys))))
 
-(if (string-match "Lucid" (version))
-    (progn
-      (global-set-key [quoted-insert-for-iso-acc] 'quoted-insert)
-      (defun iso-generate-char (char)
-	"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."
-	(setq unread-command-events
-	      (append
-	       (mapcar 'character-to-event (list
-					    (+ 48 (/ char 64))
-					    (+ 48 (% (/ char 8) 8))
-					    (+ 48 (% char 8))))
-	       unread-command-events))
-	[quoted-insert-for-iso-acc])
-      )
-  (defun iso-generate-char (char)
-    "Just returns a vector with the given character.\n\nNot necessary in the GNU Emacs implementation"
-    (vector char))
-  )
-
-
 (defvar iso-languages
   '(("portuguese"
      (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
@@ -248,11 +229,15 @@
 			  (delete-region (1- (point)) (point)))))
 	 (entry (cdr (assq second-char list))))
     (if entry
-	;; Found it: return the mapped char
-	(iso-generate-char entry)
+	;; Found it: insert the accented character and
+	;; return a do-nothing key
+        (vector (character-to-event (list entry)))
       ;; Otherwise, advance and schedule the second key for execution.
-      (setq unread-command-events (list (character-to-event second-char)))
-      (vector first-char))))
+      (setq unread-command-events (append
+				   (list
+				    (character-to-event (list second-char)))
+				   unread-command-events))
+      (vector (character-to-event (list first-char))))))
 
 ;; It is a matter of taste if you want the minor mode indicated
 ;; in the mode line...
@@ -298,12 +283,14 @@
     ;; Enable electric accents.
     (setq iso-accents-mode t)))
 
+(defvar iso-accents-mode-map nil)
+
 (defun iso-accents-customize (language)
   "Customize the ISO accents machinery for a particular language.
 It selects the customization based on the specifications in the
 `iso-languages' variable."
   (interactive (list (completing-read "Language: " iso-languages nil t)))
-  (let ((table (assoc language iso-languages)) tail)
+  (let ((table (assoc language iso-languages)) tail acc)
     (if (not table)
 	(error "Unknown language '%s'" language)
       (setq iso-language language
@@ -312,14 +299,57 @@
 	  (substitute-key-definition
 	   'iso-accents-accent-key nil key-translation-map)
 	(setq key-translation-map (make-sparse-keymap)))
+      (setq iso-accents-mode-map (make-sparse-keymap))
+      (let ((pair (assoc 'iso-accents-mode minor-mode-map-alist)))
+	(if pair
+	    (setcdr pair iso-accents-mode-map)
+	  (let ((l minor-mode-map-alist))
+	    (while (cdr l)
+	      (setq l (cdr l)))
+	    (setcdr l (list (cons 'iso-accents-mode iso-accents-mode-map))))))
       ;; Set up translations for all the characters that are used as
       ;; accent prefixes in this language.
       (setq tail iso-accents-list)
       (while tail
-	(define-key key-translation-map (vector (car (car tail)))
+	(define-key key-translation-map
+	  (vector (character-to-event (list (car (car tail)))))
 	  'iso-accents-accent-key)
+	(setq acc (cdr (car tail)))
+	(while acc
+	  (define-key iso-accents-mode-map
+	    (vector (character-to-event (list (cdr (car acc)))))
+	    'iso-accents-self-insert-unless-redefined)
+	  (setq acc (cdr acc)))
 	(setq tail (cdr tail))))))
 
+(defun iso-accents-self-insert-unless-redefined (prompt)
+  "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"
+  (interactive "p")
+  (let* ((iso-accents-mode nil)
+	 (bind (key-binding (this-command-keys)))
+	 (repeat t) result)
+    (while repeat
+      (setq result
+	    (cond ((or (null bind)
+		       (eq bind 'self-insert-command))
+		   (setq repeat nil)
+		   (self-insert-command prompt))
+		  ((commandp bind)
+		   (setq repeat nil)
+		   (call-interactively bind))
+		  ((or (stringp bind)
+		       (keymapp bind))
+		   (setq repeat nil)
+		   bind)
+		  ((and (consp bind)
+			(stringp (car bind)))
+		   (setq bind (cdr bind)))
+		  ((and (consp bind)
+			(keymapp (car bind)))
+		   (setq bind (lookup-key (car bind) (cdr bind))))
+		  (t (error "Invalid key binding")))))
+    result))
+
 (defun iso-accentuate (start end)
   "Convert two-character sequences in region into accented characters.
 Noninteractively, this operates on text from START to END.