Mercurial > hg > xemacs-beta
comparison lisp/cl.el @ 5448:89331fa1c819
Merged with trunk.
| author | Mats Lidell <matsl@xemacs.org> |
|---|---|
| date | Thu, 06 Jan 2011 00:35:22 +0100 |
| parents | 6506fcb40fcf d1b17a33450b |
| children | 0af042a0c116 |
comparison
equal
deleted
inserted
replaced
| 5447:4b08f375e2fb | 5448:89331fa1c819 |
|---|---|
| 552 (defalias 'cl-floor 'floor*) | 552 (defalias 'cl-floor 'floor*) |
| 553 (defalias 'cl-ceiling 'ceiling*) | 553 (defalias 'cl-ceiling 'ceiling*) |
| 554 (defalias 'cl-truncate 'truncate*) | 554 (defalias 'cl-truncate 'truncate*) |
| 555 (defalias 'cl-round 'round*) | 555 (defalias 'cl-round 'round*) |
| 556 (defalias 'cl-mod 'mod*) | 556 (defalias 'cl-mod 'mod*) |
| 557 | |
| 558 (defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs | |
| 559 "Return ITEM consed onto the front of LIST only if it's not already there. | |
| 560 Otherwise, return LIST unmodified. | |
| 561 Keywords supported: :test :test-not :key | |
| 562 See `member*' for the meaning of :test, :test-not and :key." | |
| 563 (cond ((or (equal cl-keys '(:test eq)) | |
| 564 (and (null cl-keys) (not (numberp cl-item)))) | |
| 565 (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) | |
| 566 ((or (equal cl-keys '(:test equal)) (null cl-keys)) | |
| 567 (if (member cl-item cl-list) cl-list (cons cl-item cl-list))) | |
| 568 (t (apply 'cl-adjoin cl-item cl-list cl-keys)))) | |
| 569 | |
| 570 (defun subst (cl-new cl-old cl-tree &rest cl-keys) | |
| 571 "Substitute NEW for OLD everywhere in TREE (non-destructively). | |
| 572 Return a copy of TREE with all elements `eql' to OLD replaced by NEW. | |
| 573 Keywords supported: :test :test-not :key | |
| 574 See `member*' for the meaning of :test, :test-not and :key." | |
| 575 (if (or cl-keys (and (numberp cl-old) (not (fixnump cl-old)))) | |
| 576 (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys) | |
| 577 (cl-do-subst cl-new cl-old cl-tree))) | |
| 578 | |
| 579 (defun cl-do-subst (cl-new cl-old cl-tree) | |
| 580 (cond ((eq cl-tree cl-old) cl-new) | |
| 581 ((consp cl-tree) | |
| 582 (let ((a (cl-do-subst cl-new cl-old (car cl-tree))) | |
| 583 (d (cl-do-subst cl-new cl-old (cdr cl-tree)))) | |
| 584 (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree))) | |
| 585 cl-tree (cons a d)))) | |
| 586 (t cl-tree))) | |
| 587 | 557 |
| 588 (defun acons (key value alist) | 558 (defun acons (key value alist) |
| 589 "Return a new alist created by adding (KEY . VALUE) to ALIST." | 559 "Return a new alist created by adding (KEY . VALUE) to ALIST." |
| 590 (cons (cons key value) alist)) | 560 (cons (cons key value) alist)) |
| 591 | 561 |