Mercurial > emacs
comparison lisp/emacs-lisp/assoc.el @ 106963:a1f2277cc409
* emacs-lisp/assoc.el (aput, adelete, amake): Use lexical-let (Bug#5450).
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 23 Jan 2010 17:44:03 -0500 |
parents | 1d1d5d9bd884 |
children | 6c7e1a272e9e |
comparison
equal
deleted
inserted
replaced
106962:d189e0755f30 | 106963:a1f2277cc409 |
---|---|
25 | 25 |
26 ;; Association list utilities providing insertion, deletion, sorting | 26 ;; Association list utilities providing insertion, deletion, sorting |
27 ;; fetching off key-value pairs in association lists. | 27 ;; fetching off key-value pairs in association lists. |
28 | 28 |
29 ;;; Code: | 29 ;;; Code: |
30 (eval-when-compile (require 'cl)) | |
30 | 31 |
31 (defun asort (alist-symbol key) | 32 (defun asort (alist-symbol key) |
32 "Move a specified key-value pair to the head of an alist. | 33 "Move a specified key-value pair to the head of an alist. |
33 The alist is referenced by ALIST-SYMBOL. Key-value pair to move to | 34 The alist is referenced by ALIST-SYMBOL. Key-value pair to move to |
34 head is one matching KEY. Returns the sorted list and doesn't affect | 35 head is one matching KEY. Returns the sorted list and doesn't affect |
69 VALUE is supplied non-nil, then the value of KEY will be set to VALUE. | 70 VALUE is supplied non-nil, then the value of KEY will be set to VALUE. |
70 If VALUE is not supplied, or is nil, the key-value pair will not be | 71 If VALUE is not supplied, or is nil, the key-value pair will not be |
71 modified, but will be moved to the head of the alist. If the key-value | 72 modified, but will be moved to the head of the alist. If the key-value |
72 pair cannot be found in the alist, it will be inserted into the head | 73 pair cannot be found in the alist, it will be inserted into the head |
73 of the alist (with value nil if VALUE is nil or not supplied)." | 74 of the alist (with value nil if VALUE is nil or not supplied)." |
74 (let ((elem (aelement key value)) | 75 (lexical-let ((elem (aelement key value)) |
75 alist) | 76 alist) |
76 (asort alist-symbol key) | 77 (asort alist-symbol key) |
77 (setq alist (eval alist-symbol)) | 78 (setq alist (eval alist-symbol)) |
78 (cond ((null alist) (set alist-symbol elem)) | 79 (cond ((null alist) (set alist-symbol elem)) |
79 ((anot-head-p alist key) (set alist-symbol (nconc elem alist))) | 80 ((anot-head-p alist key) (set alist-symbol (nconc elem alist))) |
80 (value (setcar alist (car elem))) | 81 (value (setcar alist (car elem))) |
84 (defun adelete (alist-symbol key) | 85 (defun adelete (alist-symbol key) |
85 "Delete a key-value pair from the alist. | 86 "Delete a key-value pair from the alist. |
86 Alist is referenced by ALIST-SYMBOL and the key-value pair to remove | 87 Alist is referenced by ALIST-SYMBOL and the key-value pair to remove |
87 is pair matching KEY. Returns the altered alist." | 88 is pair matching KEY. Returns the altered alist." |
88 (asort alist-symbol key) | 89 (asort alist-symbol key) |
89 (let ((alist (eval alist-symbol))) | 90 (lexical-let ((alist (eval alist-symbol))) |
90 (cond ((null alist) nil) | 91 (cond ((null alist) nil) |
91 ((anot-head-p alist key) alist) | 92 ((anot-head-p alist key) alist) |
92 (t (set alist-symbol (cdr alist)))))) | 93 (t (set alist-symbol (cdr alist)))))) |
93 | 94 |
94 | 95 |
121 | 122 |
122 KEYLIST and VALUELIST should have the same number of elements, but | 123 KEYLIST and VALUELIST should have the same number of elements, but |
123 this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining | 124 this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining |
124 keys are associated with nil. If VALUELIST is larger than KEYLIST, | 125 keys are associated with nil. If VALUELIST is larger than KEYLIST, |
125 extra values are ignored. Returns the created alist." | 126 extra values are ignored. Returns the created alist." |
126 (let ((keycar (car keylist)) | 127 (lexical-let ((keycar (car keylist)) |
127 (keycdr (cdr keylist)) | 128 (keycdr (cdr keylist)) |
128 (valcar (car valuelist)) | 129 (valcar (car valuelist)) |
129 (valcdr (cdr valuelist))) | 130 (valcdr (cdr valuelist))) |
130 (cond ((null keycdr) | 131 (cond ((null keycdr) |
131 (aput alist-symbol keycar valcar)) | 132 (aput alist-symbol keycar valcar)) |
132 (t | 133 (t |
133 (amake alist-symbol keycdr valcdr) | 134 (amake alist-symbol keycdr valcdr) |
134 (aput alist-symbol keycar valcar)))) | 135 (aput alist-symbol keycar valcar)))) |