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))