comparison lisp/subr.el @ 1176:60e0dc538df3

entered into RCS
author Richard M. Stallman <rms@gnu.org>
date Sun, 20 Sep 1992 02:22:09 +0000
parents 45fbb83b8160
children acdf9d64d086
comparison
equal deleted inserted replaced
1175:c4535b4417d2 1176:60e0dc538df3
132 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap)))) 132 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
133 ; (if (vectorp keymap) 133 ; (if (vectorp keymap)
134 ; (copy-sequence keymap) 134 ; (copy-sequence keymap)
135 ; (copy-alist keymap))) 135 ; (copy-alist keymap)))
136 136
137 (defun substitute-key-definition (olddef newdef keymap) 137 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
138 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. 138 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
139 In other words, OLDDEF is replaced with NEWDEF where ever it appears. 139 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
140 Prefix keymaps reached from KEYMAP are not checked recursively; 140 If optional fourth argument OLDMAP is specified, we redefine
141 perhaps they ought to be." 141 in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
142 (if (arrayp keymap) 142 (or prefix (setq prefix ""))
143 (let ((len (length keymap)) 143 (let* ((scan (or oldmap keymap))
144 (i 0)) 144 (vec1 (vector nil))
145 (while (< i len) 145 (prefix1 (vconcat prefix vec1)))
146 (if (eq (aref keymap i) olddef) 146 ;; Scan OLDMAP, finding each char or event-symbol that
147 (aset keymap i newdef)) 147 ;; has any definition, and act on it with hack-key.
148 (setq i (1+ i)))) 148 (while (consp scan)
149 (while keymap 149 (if (consp (car scan))
150 (if (eq (cdr-safe (car-safe keymap)) olddef) 150 (let ((char (car (car scan)))
151 (setcdr (car keymap) newdef)) 151 (defn (cdr (car scan))))
152 (setq keymap (cdr keymap))))) 152 ;; The inside of this let duplicates exactly
153 ;; the inside of the following let that handles array elements.
154 (aset vec1 0 char)
155 (aset prefix1 (length prefix) char)
156 (let (inner-def)
157 ;; Skip past menu-prompt.
158 (while (stringp (car-safe defn))
159 (setq defn (cdr defn)))
160 (setq inner-def defn)
161 (while (and (symbolp inner-def)
162 (fboundp inner-def))
163 (setq inner-def (symbol-function inner-def)))
164 (if (eq defn olddef)
165 (define-key keymap prefix1 newdef)
166 (if (keymapp defn)
167 (substitute-key-definition olddef newdef keymap
168 inner-def
169 prefix1)))))
170 (if (arrayp (car scan))
171 (let* ((array (car scan))
172 (len (length array))
173 (i 0))
174 (while (< i len)
175 (let ((char i) (defn (aref array i)))
176 ;; The inside of this let duplicates exactly
177 ;; the inside of the previous let.
178 (aset vec1 0 char)
179 (aset prefix1 (length prefix) char)
180 (let (inner-def)
181 ;; Skip past menu-prompt.
182 (while (stringp (car-safe defn))
183 (setq defn (cdr defn)))
184 (setq inner-def defn)
185 (while (and (symbolp inner-def)
186 (fboundp inner-def))
187 (setq inner-def (symbol-function inner-def)))
188 (if (eq defn olddef)
189 (define-key keymap prefix1 newdef)
190 (if (keymapp defn)
191 (substitute-key-definition olddef newdef keymap
192 inner-def
193 prefix1)))))
194 (setq i (1+ i))))))
195 (setq scan (cdr scan)))))
153 196
154 (defmacro save-match-data (&rest body) 197 (defmacro save-match-data (&rest body)
155 "Execute the BODY forms, restoring the global value of the match data." 198 "Execute the BODY forms, restoring the global value of the match data."
156 (let ((original (make-symbol "match-data"))) 199 (let ((original (make-symbol "match-data")))
157 (list 200 (list