entered into RCS

1 files changed, 57 insertions, 14 deletions

diff --git a/lisp/subr.el b/lisp/subr.el
index 459674a9802..b866c920e2d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -134,22 +134,65 @@ but optional second arg NODIGITS non-nil treats them like other chars."
 ;      (copy-sequence keymap)
 ;      (copy-alist keymap)))
 
-(defun substitute-key-definition (olddef newdef keymap)
+(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
   "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
-Prefix keymaps reached from KEYMAP are not checked recursively;
-perhaps they ought to be."
-  (if (arrayp keymap)
-      (let ((len (length keymap))
-	    (i 0))
-	(while (< i len)
-	  (if (eq (aref keymap i) olddef)
-	      (aset keymap i newdef))
-	  (setq i (1+ i))))
-    (while keymap
-      (if (eq (cdr-safe (car-safe keymap)) olddef)
-	  (setcdr (car keymap) newdef))
-      (setq keymap (cdr keymap)))))
+If optional fourth argument OLDMAP is specified, we redefine
+in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
+  (or prefix (setq prefix ""))
+  (let* ((scan (or oldmap keymap))
+	 (vec1 (vector nil))
+	 (prefix1 (vconcat prefix vec1)))
+    ;; Scan OLDMAP, finding each char or event-symbol that
+    ;; has any definition, and act on it with hack-key.
+    (while (consp scan)
+      (if (consp (car scan))
+	  (let ((char (car (car scan)))
+		(defn (cdr (car scan))))
+	    ;; The inside of this let duplicates exactly
+	    ;; the inside of the following let that handles array elements.
+	    (aset vec1 0 char)
+	    (aset prefix1 (length prefix) char)
+	    (let (inner-def)
+	      ;; Skip past menu-prompt.
+	      (while (stringp (car-safe defn))
+		(setq defn (cdr defn)))
+	      (setq inner-def defn)
+	      (while (and (symbolp inner-def)
+			  (fboundp inner-def))
+		(setq inner-def (symbol-function inner-def)))
+	      (if (eq defn olddef)
+		  (define-key keymap prefix1 newdef)
+		(if (keymapp defn)
+		    (substitute-key-definition olddef newdef keymap
+					       inner-def
+					       prefix1)))))
+	(if (arrayp (car scan))
+	    (let* ((array (car scan))
+		   (len (length array))
+		   (i 0))
+	      (while (< i len)
+		(let ((char i) (defn (aref array i)))
+		  ;; The inside of this let duplicates exactly
+		  ;; the inside of the previous let.
+		  (aset vec1 0 char)
+		  (aset prefix1 (length prefix) char)
+		  (let (inner-def)
+		    ;; Skip past menu-prompt.
+		    (while (stringp (car-safe defn))
+		      (setq defn (cdr defn)))
+		    (setq inner-def defn)
+		    (while (and (symbolp inner-def)
+				(fboundp inner-def))
+		      (setq inner-def (symbol-function inner-def)))
+		    (if (eq defn olddef)
+			(define-key keymap prefix1 newdef)
+		      (if (keymapp defn)
+			  (substitute-key-definition olddef newdef keymap
+						     inner-def
+						     prefix1)))))
+		(setq i (1+ i))))))
+      (setq scan (cdr scan)))))
 
 (defmacro save-match-data (&rest body)
   "Execute the BODY forms, restoring the global value of the match data."