Mercurial > hg > xemacs-beta
diff lisp/cl-extra.el @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | 74fd4e045ea6 |
children | 11054d720c21 |
line wrap: on
line diff
--- a/lisp/cl-extra.el Mon Aug 13 11:19:22 2007 +0200 +++ b/lisp/cl-extra.el Mon Aug 13 11:20:41 2007 +0200 @@ -183,14 +183,16 @@ (nreverse cl-res)))) -(defun mapc (cl-func cl-seq &rest cl-rest) - "Like `mapcar', but does not accumulate values returned by the function." - (if cl-rest - (apply 'map nil cl-func cl-seq cl-rest) - ;; XEmacs change: in the simplest case we call mapc-internal, - ;; which really doesn't accumulate any results. - (mapc-internal cl-func cl-seq)) - cl-seq) +;; mapc is now in C, renamed from `mapc-internal'. + +;(defun mapc (cl-func cl-seq &rest cl-rest) +; "Like `mapcar', but does not accumulate values returned by the function." +; (if cl-rest +; (apply 'map nil cl-func cl-seq cl-rest) +; ;; XEmacs change: we call mapc-internal, which really doesn't +; ;; accumulate any results. +; (mapc-internal cl-func cl-seq)) +; cl-seq) (defun mapl (cl-func cl-list &rest cl-rest) "Like `maplist', but does not accumulate values returned by the function." @@ -638,7 +640,13 @@ ;; XEmacs: our `get' groks DEFAULT. (defalias 'get* 'get) -(defalias 'getf 'plist-get) + +(defun getf (plist tag &optional def) + "Search PROPLIST for property PROPNAME; return its value or DEFAULT. +PROPLIST is a list of the sort returned by `symbol-plist'." + (setplist '--cl-getf-symbol-- plist) + (or (get '--cl-getf-symbol-- tag) + (and def (get* '--cl-getf-symbol-- tag def)))) (defun cl-set-getf (plist tag val) (let ((p plist)) @@ -650,18 +658,29 @@ (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) +(defun cl-remprop (sym tag) + "Remove from SYMBOL's plist the property PROP and its value." + (let ((plist (symbol-plist sym))) + (if (and plist (eq tag (car plist))) + (progn (setplist sym (cdr (cdr plist))) t) + (cl-do-remf plist tag)))) +(or (and (fboundp 'remprop) (subrp (symbol-function 'remprop))) + (defalias 'remprop 'cl-remprop)) + + + ;;; Hash tables. ;; The `regular' Common Lisp hash-table stuff has been moved into C. ;; Only backward compatibility stuff remains here. (defun make-hashtable (size &optional test) - (make-hash-table :test test :size size)) + (make-hash-table :size size :test test :type 'non-weak)) (defun make-weak-hashtable (size &optional test) - (make-hash-table :test test :size size :weakness t)) + (make-hash-table :size size :test test :type 'weak)) (defun make-key-weak-hashtable (size &optional test) - (make-hash-table :test test :size size :weakness 'key)) + (make-hash-table :size size :test test :type 'key-weak)) (defun make-value-weak-hashtable (size &optional test) - (make-hash-table :test test :size size :weakness 'value)) + (make-hash-table :size size :test test :type 'value-weak)) (define-obsolete-function-alias 'hashtablep 'hash-table-p) (define-obsolete-function-alias 'hashtable-fullness 'hash-table-count) @@ -674,7 +693,6 @@ (make-obsolete 'make-weak-hashtable 'make-hash-table) (make-obsolete 'make-key-weak-hashtable 'make-hash-table) (make-obsolete 'make-value-weak-hashtable 'make-hash-table) -(make-obsolete 'hash-table-type 'hash-table-weakness) (when (fboundp 'x-keysym-hash-table) (make-obsolete 'x-keysym-hashtable 'x-keysym-hash-table))