procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/cl-macs.el (cl-expr-contains): Handle cons cells

Browse source 
whose cdr is not a cons cell correctly.

Fixes: debbugs:11038
This commit is contained in:
Christopher Schmidt 2012-05-06 11:38:30 -04:00 • committed by Stefan Monnier
parent 491503ddd2
commit e129292c44
2 changed files with 17 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
lisp/ChangeLog
View file

@ -1,18 +1,23 @@
2012-05-06 Christopher Schmidt <christopher@ch.ristopher.com>
* emacs-lisp/cl-macs.el (cl-expr-contains): Handle cons cells
whose cdr is not a cons cell correctly (bug#11038).
2012-05-06 Chong Yidong <cyd@gnu.org>
* emacs-lisp/tabulated-list.el (tabulated-list-format): Accept
additional plist in column descriptors.
* emacs-lisp/tabulated-list.el (tabulated-list-format):
Accept additional plist in column descriptors.
(tabulated-list-init-header): Obey it.
(tabulated-list-get-entry): New function.
(tabulated-list-put-tag): Use it. Use string-width instead of
length.
(tabulated-list--column-number): New function.
(tabulated-list-print): Use it.
(tabulated-list-print-col): New function. Set
`tabulated-list-column-name' property on each column's text.
(tabulated-list-print-col): New function.
Set `tabulated-list-column-name' property on each column's text.
(tabulated-list-print-entry): Use it.
(tabulated-list-delete-entry, tabulated-list-set-col): New
functions.
(tabulated-list-delete-entry, tabulated-list-set-col):
New functions.
(tabulated-list-sort-column): New command (Bug#11337).
* buff-menu.el (list-buffers): Move C-x C-b binding from

7
lisp/emacs-lisp/cl-macs.el
View file

@ -143,11 +143,16 @@
;;; Count number of times X refers to Y. Return nil for 0 times.
(defun cl-expr-contains (x y)
;; FIXME: This is naive, and it will count Y as referred twice in
;; (let ((Y 1)) Y) even though it should be 0. Also it is often called on
;; non-macroexpanded code, so it may also miss some occurrences that would
;; only appear in the expanded code.
(cond ((equal y x) 1)
((and (consp x) (not (memq (car-safe x) '(quote function function*))))
(let ((sum 0))
(while x
(while (consp x)
(setq sum (+ sum (or (cl-expr-contains (pop x) y) 0))))
(setq sum (+ sum (or (cl-expr-contains x y) 0)))
(and (> sum 0) sum)))
(t nil)))