diff lisp/cl-seq.el @ 5292:e4305eb6fb8c

Merge some permissions corrections to trunk.
author Stephen J. Turnbull <stephen@xemacs.org>
date Mon, 18 Oct 2010 23:21:23 +0900
parents 69f687b3ba9d
children d1b17a33450b 308d34e9f07d
line wrap: on
line diff
--- a/lisp/cl-seq.el	Mon Oct 18 23:03:27 2010 +0900
+++ b/lisp/cl-seq.el	Mon Oct 18 23:21:23 2010 +0900
@@ -142,48 +142,7 @@
 (defvar cl-if) (defvar cl-if-not)
 (defvar cl-key)
 
-(defun replace (cl-seq1 cl-seq2 &rest cl-keys)
-  "Replace the elements of SEQ1 with the elements of SEQ2.
-SEQ1 is destructively modified, then returned.
-Keywords supported:  :start1 :end1 :start2 :end2
-:start1 and :end1 specify a subsequence of SEQ1, and :start2 and :end2 a
-subsequence of SEQ2; see `search' for more information."
-  (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
-    (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
-	(or (= cl-start1 cl-start2)
-	    (let* ((cl-len (length cl-seq1))
-		   (cl-n (min (- (or cl-end1 cl-len) cl-start1)
-			      (- (or cl-end2 cl-len) cl-start2))))
-	      (while (>= (setq cl-n (1- cl-n)) 0)
-		(cl-set-elt cl-seq1 (+ cl-start1 cl-n)
-			    (elt cl-seq2 (+ cl-start2 cl-n))))))
-      (if (listp cl-seq1)
-	  (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
-		(cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000)))
-	    (if (listp cl-seq2)
-		(let ((cl-p2 (nthcdr cl-start2 cl-seq2))
-		      (cl-n (min cl-n1
-				 (if cl-end2 (- cl-end2 cl-start2) 4000000))))
-		  (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0))
-		    (setcar cl-p1 (car cl-p2))
-		    (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
-	      (setq cl-end2 (min (or cl-end2 (length cl-seq2))
-				 (+ cl-start2 cl-n1)))
-	      (while (and cl-p1 (< cl-start2 cl-end2))
-		(setcar cl-p1 (aref cl-seq2 cl-start2))
-		(setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
-	(setq cl-end1 (min (or cl-end1 (length cl-seq1))
-			   (+ cl-start1 (- (or cl-end2 (length cl-seq2))
-					   cl-start2))))
-	(if (listp cl-seq2)
-	    (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
-	      (while (< cl-start1 cl-end1)
-		(aset cl-seq1 cl-start1 (car cl-p2))
-		(setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
-	  (while (< cl-start1 cl-end1)
-	    (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
-	    (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
-    cl-seq1))
+;; XEmacs; #'replace is in fns.c.
 
 (defun remove* (cl-item cl-seq &rest cl-keys)
   "Remove all occurrences of ITEM in SEQ.
@@ -215,8 +174,11 @@
 						 (list :end (1+ cl-i))
 					       (list :start cl-i))
 					     cl-keys))))
-		  (if (listp cl-seq) cl-res
-		    (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
+                  (typecase cl-seq
+                    (list cl-res)
+                    (string (concat cl-res))
+                    (vector (vconcat cl-res))
+                    (bit-vector (bvconcat cl-res))))
 	      cl-seq))
 	(setq cl-end (- (or cl-end 8000000) cl-start))
 	(if (= cl-start 0)
@@ -382,7 +344,10 @@
 	      (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
 	    cl-seq)))
     (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil)))
-      (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
+      (typecase cl-seq
+        (string (concat cl-res))
+        (vector (vconcat cl-res))
+        (bit-vector (bvconcat cl-res))))))
 
 (defun substitute (cl-new cl-old cl-seq &rest cl-keys)
   "Substitute NEW for OLD in SEQ.