diff options
| author | Richard M. Stallman | 1998-08-08 23:07:06 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1998-08-08 23:07:06 +0000 |
| commit | 8a288450ca441821a47d2b0e8ca29a3b84130d64 (patch) | |
| tree | 00b761b0d2337ed12819521109ffbd4d216904ff | |
| parent | fdbd749a3fc1663bc0db36f63be5430de08bae39 (diff) | |
| download | emacs-8a288450ca441821a47d2b0e8ca29a3b84130d64.tar.gz emacs-8a288450ca441821a47d2b0e8ca29a3b84130d64.zip | |
(assoc-default): Rewrite not to use dolist.
| -rw-r--r-- | lisp/subr.el | 26 |
1 files changed, 16 insertions, 10 deletions
diff --git a/lisp/subr.el b/lisp/subr.el index b80df9423f1..3181b5f29a1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -94,17 +94,23 @@ If N is bigger than the length of X, return X." | |||
| 94 | (setq x (cdr x))) | 94 | (setq x (cdr x))) |
| 95 | x)) | 95 | x)) |
| 96 | 96 | ||
| 97 | (defun assoc-default (el alist test default) | 97 | (defun assoc-default (key alist &optional test default) |
| 98 | "Find object EL in a pseudo-alist ALIST. | 98 | "Find object KEY in a pseudo-alist ALIST. |
| 99 | ALIST is a list of conses or objects. Each element (or the element's | 99 | ALIST is a list of conses or objects. Each element (or the element's car, |
| 100 | car, if it. is a cons) is compared with EL by calling TEST. | 100 | if it is a cons) is compared with KEY by evaluating (TEST (car elt) KEY). |
| 101 | If TEST returns non-nil, the element matches; | 101 | If that is non-nil, the element matches; |
| 102 | then `assoc-default' returns the cdr of the element (if it is a cons), | 102 | then `assoc-default' returns the element's cdr, if it is a cons, |
| 103 | or DEFAULT if the element is not a cons. | 103 | or DEFAULT if the element is not a cons. |
| 104 | If no element matches, the value is nil." | 104 | |
| 105 | (dolist (rr alist) | 105 | If no element matches, the value is nil. |
| 106 | (when (funcall test el (if (consp rr) (car rr) rr)) | 106 | If TEST is omitted or nil, `equal' is used." |
| 107 | (return (if (consp rr) (cdr rr) default))))) | 107 | (let (found (tail alist) value) |
| 108 | (while (and tail (not found)) | ||
| 109 | (let ((elt (car tail))) | ||
| 110 | (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key) | ||
| 111 | (setq found t value (if (consp elt) (cdr elt) default)))) | ||
| 112 | (setq tail (cdr tail))) | ||
| 113 | value)) | ||
| 108 | 114 | ||
| 109 | ;;;; Keymap support. | 115 | ;;;; Keymap support. |
| 110 | 116 | ||