Mercurial > hg > xemacs-beta

comparison lisp/cl-extra.el @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 1ccc32a20af4
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
636 636
637 ;;; Property lists. 637 ;;; Property lists.
638 638
639 ;; XEmacs: our `get' groks DEFAULT. 639 ;; XEmacs: our `get' groks DEFAULT.
640 (defalias 'get* 'get) 640 (defalias 'get* 'get)
641 641 (defalias 'getf 'plist-get)
642 (defun getf (plist property &optional default)
643 "Search PLIST for property PROPERTY; return its value or DEFAULT.
644 PLIST is a list of the sort returned by `symbol-plist'."
645 (setplist '--cl-getf-symbol-- plist)
646 (get '--cl-getf-symbol-- property default))
647 642
648 (defun cl-set-getf (plist tag val) 643 (defun cl-set-getf (plist tag val)
649 (let ((p plist)) 644 (let ((p plist))
650 (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) 645 (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p))))
651 (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) 646 (if p (progn (setcar (cdr p) val) plist) (list* tag val plist))))
652 647
653 (defun cl-do-remf (plist tag) 648 (defun cl-do-remf (plist tag)
654 (let ((p (cdr plist))) 649 (let ((p (cdr plist)))
655 (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) 650 (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
656 (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) 651 (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
657
658 (defun cl-remprop (sym tag)
659 "Remove from SYMBOL's plist the property PROP and its value."
660 (let ((plist (symbol-plist sym)))
661 (if (and plist (eq tag (car plist)))
662 (progn (setplist sym (cdr (cdr plist))) t)
663 (cl-do-remf plist tag))))
664 (or (and (fboundp 'remprop) (subrp (symbol-function 'remprop)))
665 (defalias 'remprop 'cl-remprop))
666
667
668 652
669 ;;; Hash tables. 653 ;;; Hash tables.
670 654
671 ;; The `regular' Common Lisp hash-table stuff has been moved into C. 655 ;; The `regular' Common Lisp hash-table stuff has been moved into C.
672 ;; Only backward compatibility stuff remains here. 656 ;; Only backward compatibility stuff remains here.