comparison lisp/cl-seq.el @ 4886:1e9078742fa7

Merge.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 26 Jan 2010 15:16:31 +0000
parents 6772ce4d982b
children 545ec923b4eb
comparison
equal deleted inserted replaced
4884:29fb3baea939 4886:1e9078742fa7
662 (if cl-keys 662 (if cl-keys
663 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 663 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
664 (while (and cl-list (not (cl-check-test cl-item (car cl-list)))) 664 (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
665 (setq cl-list (cdr cl-list))) 665 (setq cl-list (cdr cl-list)))
666 cl-list) 666 cl-list)
667 (if (and (numberp cl-item) (not (integerp cl-item))) 667 (if (and (numberp cl-item) (not (fixnump cl-item)))
668 (member cl-item cl-list) 668 (member cl-item cl-list)
669 (memq cl-item cl-list)))) 669 (memq cl-item cl-list))))
670 670
671 (defun member-if (cl-pred cl-list &rest cl-keys) 671 (defun member-if (cl-pred cl-list &rest cl-keys)
672 "Find the first item satisfying PREDICATE in LIST. 672 "Find the first item satisfying PREDICATE in LIST.
695 (while (and cl-alist 695 (while (and cl-alist
696 (or (not (consp (car cl-alist))) 696 (or (not (consp (car cl-alist)))
697 (not (cl-check-test cl-item (car (car cl-alist)))))) 697 (not (cl-check-test cl-item (car (car cl-alist))))))
698 (setq cl-alist (cdr cl-alist))) 698 (setq cl-alist (cdr cl-alist)))
699 (and cl-alist (car cl-alist))) 699 (and cl-alist (car cl-alist)))
700 (if (and (numberp cl-item) (not (integerp cl-item))) 700 (if (and (numberp cl-item) (not (fixnump cl-item)))
701 (assoc cl-item cl-alist) 701 (assoc cl-item cl-alist)
702 (assq cl-item cl-alist)))) 702 (assq cl-item cl-alist))))
703 703
704 (defun assoc-if (cl-pred cl-list &rest cl-keys) 704 (defun assoc-if (cl-pred cl-list &rest cl-keys)
705 "Find the first item whose car satisfies PREDICATE in LIST. 705 "Find the first item whose car satisfies PREDICATE in LIST.
712 (apply 'assoc* nil cl-list :if-not cl-pred cl-keys)) 712 (apply 'assoc* nil cl-list :if-not cl-pred cl-keys))
713 713
714 (defun rassoc* (cl-item cl-alist &rest cl-keys) 714 (defun rassoc* (cl-item cl-alist &rest cl-keys)
715 "Find the first item whose cdr matches ITEM in LIST. 715 "Find the first item whose cdr matches ITEM in LIST.
716 Keywords supported: :test :test-not :key" 716 Keywords supported: :test :test-not :key"
717 (if (or cl-keys (numberp cl-item)) 717 (if (or cl-keys (and (numberp cl-item) (not (fixnump cl-item))))
718 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 718 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
719 (while (and cl-alist 719 (while (and cl-alist
720 (or (not (consp (car cl-alist))) 720 (or (not (consp (car cl-alist)))
721 (not (cl-check-test cl-item (cdr (car cl-alist)))))) 721 (not (cl-check-test cl-item (cdr (car cl-alist))))))
722 (setq cl-alist (cdr cl-alist))) 722 (setq cl-alist (cdr cl-alist)))