Mercurial > hg > xemacs-beta

comparison lisp/cl-extra.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 74fd4e045ea6
children 11054d720c21
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
181 (cl-push (funcall cl-func cl-list) cl-res) 181 (cl-push (funcall cl-func cl-list) cl-res)
182 (setq cl-list (cdr cl-list))) 182 (setq cl-list (cdr cl-list)))
183 (nreverse cl-res)))) 183 (nreverse cl-res))))
184 184
185 185
186 (defun mapc (cl-func cl-seq &rest cl-rest) 186 ;; mapc is now in C, renamed from `mapc-internal'.
187 "Like `mapcar', but does not accumulate values returned by the function." 187
188 (if cl-rest 188 ;(defun mapc (cl-func cl-seq &rest cl-rest)
189 (apply 'map nil cl-func cl-seq cl-rest) 189 ; "Like `mapcar', but does not accumulate values returned by the function."
190 ;; XEmacs change: in the simplest case we call mapc-internal, 190 ; (if cl-rest
191 ;; which really doesn't accumulate any results. 191 ; (apply 'map nil cl-func cl-seq cl-rest)
192 (mapc-internal cl-func cl-seq)) 192 ; ;; XEmacs change: we call mapc-internal, which really doesn't
193 cl-seq) 193 ; ;; accumulate any results.
194 ; (mapc-internal cl-func cl-seq))
195 ; cl-seq)
194 196
195 (defun mapl (cl-func cl-list &rest cl-rest) 197 (defun mapl (cl-func cl-list &rest cl-rest)
196 "Like `maplist', but does not accumulate values returned by the function." 198 "Like `maplist', but does not accumulate values returned by the function."
197 (if cl-rest 199 (if cl-rest
198 (apply 'maplist cl-func cl-list cl-rest) 200 (apply 'maplist cl-func cl-list cl-rest)
636 638
637 ;;; Property lists. 639 ;;; Property lists.
638 640
639 ;; XEmacs: our `get' groks DEFAULT. 641 ;; XEmacs: our `get' groks DEFAULT.
640 (defalias 'get* 'get) 642 (defalias 'get* 'get)
641 (defalias 'getf 'plist-get) 643
644 (defun getf (plist tag &optional def)
645 "Search PROPLIST for property PROPNAME; return its value or DEFAULT.
646 PROPLIST is a list of the sort returned by `symbol-plist'."
647 (setplist '--cl-getf-symbol-- plist)
648 (or (get '--cl-getf-symbol-- tag)
649 (and def (get* '--cl-getf-symbol-- tag def))))
642 650
643 (defun cl-set-getf (plist tag val) 651 (defun cl-set-getf (plist tag val)
644 (let ((p plist)) 652 (let ((p plist))
645 (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) 653 (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p))))
646 (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) 654 (if p (progn (setcar (cdr p) val) plist) (list* tag val plist))))
648 (defun cl-do-remf (plist tag) 656 (defun cl-do-remf (plist tag)
649 (let ((p (cdr plist))) 657 (let ((p (cdr plist)))
650 (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) 658 (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
651 (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) 659 (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
652 660
661 (defun cl-remprop (sym tag)
662 "Remove from SYMBOL's plist the property PROP and its value."
663 (let ((plist (symbol-plist sym)))
664 (if (and plist (eq tag (car plist)))
665 (progn (setplist sym (cdr (cdr plist))) t)
666 (cl-do-remf plist tag))))
667 (or (and (fboundp 'remprop) (subrp (symbol-function 'remprop)))
668 (defalias 'remprop 'cl-remprop))
669
670
671
653 ;;; Hash tables. 672 ;;; Hash tables.
654 673
655 ;; The `regular' Common Lisp hash-table stuff has been moved into C. 674 ;; The `regular' Common Lisp hash-table stuff has been moved into C.
656 ;; Only backward compatibility stuff remains here. 675 ;; Only backward compatibility stuff remains here.
657 (defun make-hashtable (size &optional test) 676 (defun make-hashtable (size &optional test)
658 (make-hash-table :test test :size size)) 677 (make-hash-table :size size :test test :type 'non-weak))
659 (defun make-weak-hashtable (size &optional test) 678 (defun make-weak-hashtable (size &optional test)
660 (make-hash-table :test test :size size :weakness t)) 679 (make-hash-table :size size :test test :type 'weak))
661 (defun make-key-weak-hashtable (size &optional test) 680 (defun make-key-weak-hashtable (size &optional test)
662 (make-hash-table :test test :size size :weakness 'key)) 681 (make-hash-table :size size :test test :type 'key-weak))
663 (defun make-value-weak-hashtable (size &optional test) 682 (defun make-value-weak-hashtable (size &optional test)
664 (make-hash-table :test test :size size :weakness 'value)) 683 (make-hash-table :size size :test test :type 'value-weak))
665 684
666 (define-obsolete-function-alias 'hashtablep 'hash-table-p) 685 (define-obsolete-function-alias 'hashtablep 'hash-table-p)
667 (define-obsolete-function-alias 'hashtable-fullness 'hash-table-count) 686 (define-obsolete-function-alias 'hashtable-fullness 'hash-table-count)
668 (define-obsolete-function-alias 'hashtable-test-function 'hash-table-test) 687 (define-obsolete-function-alias 'hashtable-test-function 'hash-table-test)
669 (define-obsolete-function-alias 'hashtable-type 'hash-table-type) 688 (define-obsolete-function-alias 'hashtable-type 'hash-table-type)
672 691
673 (make-obsolete 'make-hashtable 'make-hash-table) 692 (make-obsolete 'make-hashtable 'make-hash-table)
674 (make-obsolete 'make-weak-hashtable 'make-hash-table) 693 (make-obsolete 'make-weak-hashtable 'make-hash-table)
675 (make-obsolete 'make-key-weak-hashtable 'make-hash-table) 694 (make-obsolete 'make-key-weak-hashtable 'make-hash-table)
676 (make-obsolete 'make-value-weak-hashtable 'make-hash-table) 695 (make-obsolete 'make-value-weak-hashtable 'make-hash-table)
677 (make-obsolete 'hash-table-type 'hash-table-weakness)
678 696
679 (when (fboundp 'x-keysym-hash-table) 697 (when (fboundp 'x-keysym-hash-table)
680 (make-obsolete 'x-keysym-hashtable 'x-keysym-hash-table)) 698 (make-obsolete 'x-keysym-hashtable 'x-keysym-hash-table))
681 699
682 ;; Compatibility stuff for old kludgy cl.el hash table implementation 700 ;; Compatibility stuff for old kludgy cl.el hash table implementation