;;; Control structures.
;;;###autoload
-(defun cl--mapcar-many (cl-func cl-seqs &optional acc)
- (if (cdr (cdr cl-seqs))
- (let* ((cl-res nil)
- (cl-n (apply #'min (mapcar #'length cl-seqs)))
- (cl-i 0)
- (cl-args (copy-sequence cl-seqs))
- cl-p1 cl-p2)
- (setq cl-seqs (copy-sequence cl-seqs))
- (while (< cl-i cl-n)
- (setq cl-p1 cl-seqs cl-p2 cl-args)
- (while cl-p1
- (setcar cl-p2
- (if (consp (car cl-p1))
- (prog1 (car (car cl-p1))
- (setcar cl-p1 (cdr (car cl-p1))))
- (aref (car cl-p1) cl-i)))
- (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))
+(defun cl--mapcar-many (func seqs &optional acc)
+ (if (cdr (cdr seqs))
+ (let* ((res nil)
+ (n (apply #'min (mapcar #'length seqs)))
+ (i 0)
+ (args (copy-sequence seqs))
+ p1 p2)
+ (setq seqs (copy-sequence seqs))
+ (while (< i n)
+ (setq p1 seqs p2 args)
+ (while p1
+ (setcar p2
+ (if (consp (car p1))
+ (prog1 (car (car p1))
+ (setcar p1 (cdr (car p1))))
+ (aref (car p1) i)))
+ (setq p1 (cdr p1) p2 (cdr p2)))
(if acc
- (push (apply cl-func cl-args) cl-res)
- (apply cl-func cl-args))
- (setq cl-i (1+ cl-i)))
- (and acc (nreverse cl-res)))
- (let ((cl-res nil)
- (cl-x (car cl-seqs))
- (cl-y (nth 1 cl-seqs)))
- (let ((cl-n (min (length cl-x) (length cl-y)))
- (cl-i -1))
- (while (< (setq cl-i (1+ cl-i)) cl-n)
- (let ((val (funcall cl-func
- (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
- (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))))
+ (push (apply func args) res)
+ (apply func args))
+ (setq i (1+ i)))
+ (and acc (nreverse res)))
+ (let ((res nil)
+ (x (car seqs))
+ (y (nth 1 seqs)))
+ (let ((n (min (length x) (length y)))
+ (i -1))
+ (while (< (setq i (1+ i)) n)
+ (let ((val (funcall func
+ (if (consp x) (pop x) (aref x i))
+ (if (consp y) (pop y) (aref y i)))))
(when acc
- (push val cl-res)))))
- (and acc (nreverse cl-res)))))
+ (push val res)))))
+ (and acc (nreverse res)))))
;;;###autoload
-(defsubst cl-map (cl-type cl-func cl-seq &rest cl-rest)
+(defsubst cl-map (type func seq &rest rest)
"Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
TYPE is the sequence type to return.
\n(fn TYPE FUNCTION SEQUENCE...)"
(declare (important-return-value t))
- (let ((cl-res (apply 'cl-mapcar cl-func cl-seq cl-rest)))
- (and cl-type (cl-coerce cl-res cl-type))))
+ (let ((res (apply 'cl-mapcar func seq rest)))
+ (and type (cl-coerce res type))))
;;;###autoload
-(defun cl-maplist (cl-func cl-list &rest cl-rest)
+(defun cl-maplist (func list &rest rest)
"Map FUNCTION to each sublist of LIST or LISTs.
Like `cl-mapcar', except applies to lists and their cdr's rather than to
the elements themselves.
\n(fn FUNCTION LIST...)"
(declare (important-return-value t))
- (if cl-rest
- (let ((cl-res nil)
- (cl-args (cons cl-list (copy-sequence cl-rest)))
- cl-p)
- (while (not (memq nil cl-args))
- (push (apply cl-func cl-args) cl-res)
- (setq cl-p cl-args)
- (while cl-p (setcar cl-p (cdr (pop cl-p)))))
- (nreverse cl-res))
- (let ((cl-res nil))
- (while cl-list
- (push (funcall cl-func cl-list) cl-res)
- (setq cl-list (cdr cl-list)))
- (nreverse cl-res))))
-
-;;;###autoload
-(defun cl-mapc (cl-func cl-seq &rest cl-rest)
+ (if rest
+ (let ((res nil)
+ (args (cons list (copy-sequence rest)))
+ p)
+ (while (not (memq nil args))
+ (push (apply func args) res)
+ (setq p args)
+ (while p (setcar p (cdr (pop p)))))
+ (nreverse res))
+ (let ((res nil))
+ (while list
+ (push (funcall func list) res)
+ (setq list (cdr list)))
+ (nreverse res))))
+
+;;;###autoload
+(defun cl-mapc (func seq &rest rest)
"Like `cl-mapcar', but does not accumulate values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
- (if cl-rest
- (if (or (cdr cl-rest) (nlistp cl-seq) (nlistp (car cl-rest)))
+ (if rest
+ (if (or (cdr rest) (nlistp seq) (nlistp (car rest)))
(progn
- (cl--mapcar-many cl-func (cons cl-seq cl-rest))
- cl-seq)
- (let ((cl-x cl-seq) (cl-y (car cl-rest)))
- (while (and cl-x cl-y)
- (funcall cl-func (pop cl-x) (pop cl-y)))
- cl-seq))
- (mapc cl-func cl-seq)))
+ (cl--mapcar-many func (cons seq rest))
+ seq)
+ (let ((x seq) (y (car rest)))
+ (while (and x y)
+ (funcall func (pop x) (pop y)))
+ seq))
+ (mapc func seq)))
;;;###autoload
-(defun cl-mapl (cl-func cl-list &rest cl-rest)
+(defun cl-mapl (func list &rest rest)
"Like `cl-maplist', but does not accumulate values returned by the function.
\n(fn FUNCTION LIST...)"
- (if cl-rest
- (let ((cl-args (cons cl-list (copy-sequence cl-rest)))
- cl-p)
- (while (not (memq nil cl-args))
- (apply cl-func cl-args)
- (setq cl-p cl-args)
- (while cl-p (setcar cl-p (cdr (pop cl-p))))))
- (let ((cl-p cl-list))
- (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p)))))
- cl-list)
-
-;;;###autoload
-(defun cl-mapcan (cl-func cl-seq &rest cl-rest)
+ (if rest
+ (let ((args (cons list (copy-sequence rest)))
+ p)
+ (while (not (memq nil args))
+ (apply func args)
+ (setq p args)
+ (while p (setcar p (cdr (pop p))))))
+ (let ((p list))
+ (while p (funcall func p) (setq p (cdr p)))))
+ list)
+
+;;;###autoload
+(defun cl-mapcan (func seq &rest rest)
"Like `cl-mapcar', but nconc's together the values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
(declare (important-return-value t))
- (if cl-rest
- (apply #'nconc (apply #'cl-mapcar cl-func cl-seq cl-rest))
- (mapcan cl-func cl-seq)))
+ (if rest
+ (apply #'nconc (apply #'cl-mapcar func seq rest))
+ (mapcan func seq)))
;;;###autoload
-(defun cl-mapcon (cl-func cl-list &rest cl-rest)
+(defun cl-mapcon (func list &rest rest)
"Like `cl-maplist', but nconc's together the values returned by the function.
\n(fn FUNCTION LIST...)"
(declare (important-return-value t))
- (apply #'nconc (apply #'cl-maplist cl-func cl-list cl-rest)))
+ (apply #'nconc (apply #'cl-maplist func list rest)))
;;;###autoload
-(defun cl-some (cl-pred cl-seq &rest cl-rest)
+(defun cl-some (pred seq &rest rest)
"Say whether PREDICATE is true for any element in the SEQ sequences.
More specifically, the return value of this function will be the
same as the first return value of PREDICATE where PREDICATE has a
\n(fn PREDICATE SEQ...)"
(declare (important-return-value t))
- (if (or cl-rest (nlistp cl-seq))
+ (if (or rest (nlistp seq))
(catch 'cl-some
(apply #'cl-map nil
- (lambda (&rest cl-x)
- (let ((cl-res (apply cl-pred cl-x)))
- (if cl-res (throw 'cl-some cl-res))))
- cl-seq cl-rest) nil)
- (let ((cl-x nil))
- (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq))))))
- cl-x)))
+ (lambda (&rest x)
+ (let ((res (apply pred x)))
+ (if res (throw 'cl-some res))))
+ seq rest) nil)
+ (let ((x nil))
+ (while (and seq (not (setq x (funcall pred (pop seq))))))
+ x)))
;;;###autoload
-(defun cl-every (cl-pred cl-seq &rest cl-rest)
+(defun cl-every (pred seq &rest rest)
"Return true if PREDICATE is true of every element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
(declare (important-return-value t))
- (if (or cl-rest (nlistp cl-seq))
+ (if (or rest (nlistp seq))
(catch 'cl-every
(apply #'cl-map nil
- (lambda (&rest cl-x)
- (or (apply cl-pred cl-x) (throw 'cl-every nil)))
- cl-seq cl-rest) t)
- (while (and cl-seq (funcall cl-pred (car cl-seq)))
- (setq cl-seq (cdr cl-seq)))
- (null cl-seq)))
+ (lambda (&rest x)
+ (or (apply pred x) (throw 'cl-every nil)))
+ seq rest) t)
+ (while (and seq (funcall pred (car seq)))
+ (setq seq (cdr seq)))
+ (null seq)))
;;;###autoload
-(defsubst cl-notany (cl-pred cl-seq &rest cl-rest)
+(defsubst cl-notany (pred seq &rest rest)
"Return true if PREDICATE is false of every element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
(declare (important-return-value t))
- (not (apply #'cl-some cl-pred cl-seq cl-rest)))
+ (not (apply #'cl-some pred seq rest)))
;;;###autoload
-(defsubst cl-notevery (cl-pred cl-seq &rest cl-rest)
+(defsubst cl-notevery (pred seq &rest rest)
"Return true if PREDICATE is false of some element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
(declare (important-return-value t))
- (not (apply #'cl-every cl-pred cl-seq cl-rest)))
+ (not (apply #'cl-every pred seq rest)))
;;;###autoload
-(defun cl--map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
- (or cl-base
- (setq cl-base (copy-sequence [0])))
+(defun cl--map-keymap-recursively (func-rec map &optional base)
+ (or base
+ (setq base (copy-sequence [0])))
(map-keymap
- (lambda (cl-key cl-bind)
- (aset cl-base (1- (length cl-base)) cl-key)
- (if (keymapp cl-bind)
+ (lambda (key bind)
+ (aset base (1- (length base)) key)
+ (if (keymapp bind)
(cl--map-keymap-recursively
- cl-func-rec cl-bind
- (vconcat cl-base (list 0)))
- (funcall cl-func-rec cl-base cl-bind)))
- cl-map))
-
-;;;###autoload
-(defun cl--map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end)
- (or cl-what (setq cl-what (current-buffer)))
- (if (bufferp cl-what)
- (let (cl-mark cl-mark2 (cl-next t) cl-next2)
- (with-current-buffer cl-what
- (setq cl-mark (copy-marker (or cl-start (point-min))))
- (setq cl-mark2 (and cl-end (copy-marker cl-end))))
- (while (and cl-next (or (not cl-mark2) (< cl-mark cl-mark2)))
- (setq cl-next (if cl-prop (next-single-property-change
- cl-mark cl-prop cl-what)
- (next-property-change cl-mark cl-what))
- cl-next2 (or cl-next (with-current-buffer cl-what
- (point-max))))
- (funcall cl-func (prog1 (marker-position cl-mark)
- (set-marker cl-mark cl-next2))
- (if cl-mark2 (min cl-next2 cl-mark2) cl-next2)))
- (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil)))
- (or cl-start (setq cl-start 0))
- (or cl-end (setq cl-end (length cl-what)))
- (while (< cl-start cl-end)
- (let ((cl-next (or (if cl-prop (next-single-property-change
- cl-start cl-prop cl-what)
- (next-property-change cl-start cl-what))
- cl-end)))
- (funcall cl-func cl-start (min cl-next cl-end))
- (setq cl-start cl-next)))))
-
-;;;###autoload
-(defun cl--map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
- (or cl-buffer (setq cl-buffer (current-buffer)))
- (let (cl-ovl)
- (with-current-buffer cl-buffer
- (setq cl-ovl (overlay-lists))
- (if cl-start (setq cl-start (copy-marker cl-start)))
- (if cl-end (setq cl-end (copy-marker cl-end))))
- (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl)))
- (while (and cl-ovl
- (or (not (overlay-start (car cl-ovl)))
- (and cl-end (>= (overlay-start (car cl-ovl)) cl-end))
- (and cl-start (<= (overlay-end (car cl-ovl)) cl-start))
- (not (funcall cl-func (car cl-ovl) cl-arg))))
- (setq cl-ovl (cdr cl-ovl)))
- (if cl-start (set-marker cl-start nil))
- (if cl-end (set-marker cl-end nil))))
+ func-rec bind
+ (vconcat base (list 0)))
+ (funcall func-rec base bind)))
+ map))
+
+;;;###autoload
+(defun cl--map-intervals (func &optional what prop start end)
+ (or what (setq what (current-buffer)))
+ (if (bufferp what)
+ (let (mark mark2 (next t) next2)
+ (with-current-buffer what
+ (setq mark (copy-marker (or start (point-min))))
+ (setq mark2 (and end (copy-marker end))))
+ (while (and next (or (not mark2) (< mark mark2)))
+ (setq next (if prop (next-single-property-change
+ mark prop what)
+ (next-property-change mark what))
+ next2 (or next (with-current-buffer what
+ (point-max))))
+ (funcall func (prog1 (marker-position mark)
+ (set-marker mark next2))
+ (if mark2 (min next2 mark2) next2)))
+ (set-marker mark nil) (if mark2 (set-marker mark2 nil)))
+ (or start (setq start 0))
+ (or end (setq end (length what)))
+ (while (< start end)
+ (let ((next (or (if prop (next-single-property-change
+ start prop what)
+ (next-property-change start what))
+ end)))
+ (funcall func start (min next end))
+ (setq start next)))))
+
+;;;###autoload
+(defun cl--map-overlays (func &optional buffer start end arg)
+ (or buffer (setq buffer (current-buffer)))
+ (let (ovl)
+ (with-current-buffer buffer
+ (setq ovl (overlay-lists))
+ (if start (setq start (copy-marker start)))
+ (if end (setq end (copy-marker end))))
+ (setq ovl (nconc (car ovl) (cdr ovl)))
+ (while (and ovl
+ (or (not (overlay-start (car ovl)))
+ (and end (>= (overlay-start (car ovl)) end))
+ (and start (<= (overlay-end (car ovl)) start))
+ (not (funcall func (car ovl) arg))))
+ (setq ovl (cdr ovl)))
+ (if start (set-marker start nil))
+ (if end (set-marker end nil))))
;;; Support for `setf'.
;;;###autoload
(null x))
;;;###autoload
-(defun cl-reduce (cl-func cl-seq &rest cl-keys)
+(defun cl-reduce (func seq &rest cl-keys)
"Reduce two-argument FUNCTION across SEQ.
\nKeywords supported: :start :end :from-end :initial-value :key
\n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
(cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
- (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
- (setq cl-seq (cl-subseq cl-seq cl-start cl-end))
- (if cl-from-end (setq cl-seq (nreverse cl-seq)))
- (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
- (cl-seq (cl--check-key (pop cl-seq)))
- (t (funcall cl-func)))))
+ (or (listp seq) (setq seq (append seq nil)))
+ (setq seq (cl-subseq seq cl-start cl-end))
+ (if cl-from-end (setq seq (nreverse seq)))
+ (let ((accum (cond ((memq :initial-value cl-keys) cl-initial-value)
+ (seq (cl--check-key (pop seq)))
+ (t (funcall func)))))
(if cl-from-end
- (while cl-seq
- (setq cl-accum (funcall cl-func (cl--check-key (pop cl-seq))
- cl-accum)))
- (while cl-seq
- (setq cl-accum (funcall cl-func cl-accum
- (cl--check-key (pop cl-seq))))))
- cl-accum)))
+ (while seq
+ (setq accum (funcall func (cl--check-key (pop seq))
+ accum)))
+ (while seq
+ (setq accum (funcall func accum
+ (cl--check-key (pop seq))))))
+ accum)))
;;;###autoload
-(defun cl-fill (cl-seq cl-item &rest cl-keys)
+(defun cl-fill (seq item &rest cl-keys)
"Fill the elements of SEQ with ITEM.
\nKeywords supported: :start :end
\n(fn SEQ ITEM [KEYWORD VALUE]...)"
(cl--parsing-keywords ((:start 0) :end) ()
- (if (listp cl-seq)
- (let ((p (nthcdr cl-start cl-seq))
+ (if (listp seq)
+ (let ((p (nthcdr cl-start seq))
(n (and cl-end (- cl-end cl-start))))
(while (and p (or (null n) (>= (decf n) 0)))
- (setcar p cl-item)
+ (setcar p item)
(setq p (cdr p))))
- (or cl-end (setq cl-end (length cl-seq)))
- (if (and (= cl-start 0) (= cl-end (length cl-seq)))
- (fillarray cl-seq cl-item)
+ (or cl-end (setq cl-end (length seq)))
+ (if (and (= cl-start 0) (= cl-end (length seq)))
+ (fillarray seq item)
(while (< cl-start cl-end)
- (aset cl-seq cl-start cl-item)
+ (aset seq cl-start item)
(setq cl-start (1+ cl-start)))))
- cl-seq))
+ seq))
;;;###autoload
-(defun cl-replace (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-replace (seq1 seq2 &rest cl-keys)
"Replace the elements of SEQ1 with the elements of SEQ2.
SEQ1 is destructively modified, then returned.
\nKeywords supported: :start1 :end1 :start2 :end2
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
(cl--parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
- (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
+ (if (and (eq seq1 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)
- (setf (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 (and cl-end1 (- cl-end1 cl-start1))))
- (if (listp cl-seq2)
- (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
- (cl-n (cond ((and cl-n1 cl-end2)
- (min cl-n1 (- cl-end2 cl-start2)))
- ((and cl-n1 (null cl-end2)) cl-n1)
- ((and (null cl-n1) cl-end2) (- cl-end2 cl-start2)))))
- (while (and cl-p1 cl-p2 (or (null cl-n) (>= (decf cl-n) 0)))
- (setcar cl-p1 (car cl-p2))
- (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
- (setq cl-end2 (if (null cl-n1)
- (or cl-end2 (length cl-seq2))
- (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))
+ (let* ((len (length seq1))
+ (n (min (- (or cl-end1 len) cl-start1)
+ (- (or cl-end2 len) cl-start2))))
+ (while (>= (setq n (1- n)) 0)
+ (setf (elt seq1 (+ cl-start1 n))
+ (elt seq2 (+ cl-start2 n))))))
+ (if (listp seq1)
+ (let ((p1 (nthcdr cl-start1 seq1))
+ (n1 (and cl-end1 (- cl-end1 cl-start1))))
+ (if (listp seq2)
+ (let ((p2 (nthcdr cl-start2 seq2))
+ (n (cond ((and n1 cl-end2)
+ (min n1 (- cl-end2 cl-start2)))
+ ((and n1 (null cl-end2)) n1)
+ ((and (null n1) cl-end2) (- cl-end2 cl-start2)))))
+ (while (and p1 p2 (or (null n) (>= (decf n) 0)))
+ (setcar p1 (car p2))
+ (setq p1 (cdr p1) p2 (cdr p2))))
+ (setq cl-end2 (if (null n1)
+ (or cl-end2 (length seq2))
+ (min (or cl-end2 (length seq2))
+ (+ cl-start2 n1))))
+ (while (and p1 (< cl-start2 cl-end2))
+ (setcar p1 (aref seq2 cl-start2))
+ (setq p1 (cdr p1) cl-start2 (1+ cl-start2)))))
+ (setq cl-end1 (min (or cl-end1 (length seq1))
+ (+ cl-start1 (- (or cl-end2 (length seq2))
cl-start2))))
- (if (listp cl-seq2)
- (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
+ (if (listp seq2)
+ (let ((p2 (nthcdr cl-start2 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))))
+ (aset seq1 cl-start1 (car p2))
+ (setq p2 (cdr p2) cl-start1 (1+ cl-start1))))
(while (< cl-start1 cl-end1)
- (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
+ (aset seq1 cl-start1 (aref seq2 cl-start2))
(setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
- cl-seq1))
+ seq1))
;;;###autoload
-(defun cl-remove (cl-item cl-seq &rest cl-keys)
+(defun cl-remove (item seq &rest cl-keys)
"Remove all occurrences of ITEM in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
- (:start 0) :end) ()
- (let ((len (length cl-seq)))
+ (cl--parsing-keywords ( :test :test-not :key :if :if-not :count :from-end
+ (:start 0) :end) ()
+ (let ((len (length seq)))
(if (<= (or cl-count (setq cl-count len)) 0)
- cl-seq
- (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2))))
- (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end
- cl-from-end)))
- (if cl-i
- (let ((cl-res (apply 'cl-delete cl-item (append cl-seq nil)
- (append (if cl-from-end
- (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))))
- cl-seq))
+ seq
+ (if (or (nlistp seq) (and cl-from-end (< cl-count (/ len 2))))
+ (let ((i (cl--position item seq cl-start cl-end
+ cl-from-end)))
+ (if i
+ (let ((res (apply #'cl-delete item (append seq nil)
+ (append (if cl-from-end
+ (list :end (1+ i))
+ (list :start i))
+ cl-keys))))
+ (if (listp seq) res
+ (if (stringp seq) (concat res) (vconcat res))))
+ seq))
(setq cl-end (- (or cl-end len) cl-start))
- (if (= cl-start 0)
- (while (and cl-seq (> cl-end 0)
- (cl--check-test cl-item (car cl-seq))
- (setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
- (> (setq cl-count (1- cl-count)) 0))))
- (if (and (> cl-count 0) (> cl-end 0))
- (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq)
- (setq cl-end (1- cl-end)) (cdr cl-seq))))
- (while (and cl-p (> cl-end 0)
- (not (cl--check-test cl-item (car cl-p))))
- (setq cl-p (cdr cl-p) cl-end (1- cl-end)))
- (if (and cl-p (> cl-end 0))
- (nconc (cl-ldiff cl-seq cl-p)
- (if (= cl-count 1) (cdr cl-p)
- (and (cdr cl-p)
- (apply 'cl-delete cl-item
- (copy-sequence (cdr cl-p))
- :start 0 :end (1- cl-end)
- :count (1- cl-count) cl-keys))))
- cl-seq))
- cl-seq))))))
+ (if (= cl-start 0)
+ (while (and seq (> cl-end 0)
+ (cl--check-test item (car seq))
+ (setq cl-end (1- cl-end) seq (cdr seq))
+ (> (setq cl-count (1- cl-count)) 0))))
+ (if (and (> cl-count 0) (> cl-end 0))
+ (let ((p (if (> cl-start 0) (nthcdr cl-start seq)
+ (setq cl-end (1- cl-end)) (cdr seq))))
+ (while (and p (> cl-end 0)
+ (not (cl--check-test item (car p))))
+ (setq p (cdr p) cl-end (1- cl-end)))
+ (if (and p (> cl-end 0))
+ (nconc (cl-ldiff seq p)
+ (if (= cl-count 1) (cdr p)
+ (and (cdr p)
+ (apply #'cl-delete item
+ (copy-sequence (cdr p))
+ :start 0 :end (1- cl-end)
+ :count (1- cl-count) cl-keys))))
+ seq))
+ seq))))))
;;;###autoload
-(defun cl-remove-if (cl-pred cl-list &rest cl-keys)
+(defun cl-remove-if (pred list &rest cl-keys)
"Remove all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-remove nil cl-list :if cl-pred cl-keys))
+ (apply #'cl-remove nil list :if pred cl-keys))
;;;###autoload
-(defun cl-remove-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-remove-if-not (pred list &rest cl-keys)
"Remove all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-remove nil cl-list :if-not cl-pred cl-keys))
+ (apply #'cl-remove nil list :if-not pred cl-keys))
;;;###autoload
-(defun cl-delete (cl-item cl-seq &rest cl-keys)
+(defun cl-delete (item seq &rest cl-keys)
"Remove all occurrences of ITEM in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
- (:start 0) :end) ()
- (let ((len (length cl-seq)))
+ (cl--parsing-keywords ( :test :test-not :key :if :if-not :count :from-end
+ (:start 0) :end) ()
+ (let ((len (length seq)))
(if (<= (or cl-count (setq cl-count len)) 0)
- cl-seq
- (if (listp cl-seq)
- (if (and cl-from-end (< cl-count (/ len 2)))
- (let (cl-i)
- (while (and (>= (setq cl-count (1- cl-count)) 0)
- (setq cl-i (cl--position cl-item cl-seq cl-start
- cl-end cl-from-end)))
- (if (= cl-i 0) (setq cl-seq (cdr cl-seq))
- (let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
- (setcdr cl-tail (cdr (cdr cl-tail)))))
- (setq cl-end cl-i))
- cl-seq)
- (setq cl-end (- (or cl-end len) cl-start))
- (if (= cl-start 0)
- (progn
- (while (and cl-seq
- (> cl-end 0)
- (cl--check-test cl-item (car cl-seq))
- (setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
- (> (setq cl-count (1- cl-count)) 0)))
- (setq cl-end (1- cl-end)))
- (setq cl-start (1- cl-start)))
- (if (and (> cl-count 0) (> cl-end 0))
- (let ((cl-p (nthcdr cl-start cl-seq)))
- (while (and (cdr cl-p) (> cl-end 0))
- (if (cl--check-test cl-item (car (cdr cl-p)))
- (progn
- (setcdr cl-p (cdr (cdr cl-p)))
- (if (= (setq cl-count (1- cl-count)) 0)
- (setq cl-end 1)))
- (setq cl-p (cdr cl-p)))
- (setq cl-end (1- cl-end)))))
- cl-seq)
- (apply 'cl-remove cl-item cl-seq cl-keys))))))
+ seq
+ (if (listp seq)
+ (if (and cl-from-end (< cl-count (/ len 2)))
+ (let (i)
+ (while (and (>= (setq cl-count (1- cl-count)) 0)
+ (setq i (cl--position item seq cl-start
+ cl-end cl-from-end)))
+ (if (= i 0) (setq seq (cdr seq))
+ (let ((tail (nthcdr (1- i) seq)))
+ (setcdr tail (cdr (cdr tail)))))
+ (setq cl-end i))
+ seq)
+ (setq cl-end (- (or cl-end len) cl-start))
+ (if (= cl-start 0)
+ (progn
+ (while (and seq
+ (> cl-end 0)
+ (cl--check-test item (car seq))
+ (setq cl-end (1- cl-end) seq (cdr seq))
+ (> (setq cl-count (1- cl-count)) 0)))
+ (setq cl-end (1- cl-end)))
+ (setq cl-start (1- cl-start)))
+ (if (and (> cl-count 0) (> cl-end 0))
+ (let ((p (nthcdr cl-start seq)))
+ (while (and (cdr p) (> cl-end 0))
+ (if (cl--check-test item (car (cdr p)))
+ (progn
+ (setcdr p (cdr (cdr p)))
+ (if (= (setq cl-count (1- cl-count)) 0)
+ (setq cl-end 1)))
+ (setq p (cdr p)))
+ (setq cl-end (1- cl-end)))))
+ seq)
+ (apply #'cl-remove item seq cl-keys))))))
;;;###autoload
-(defun cl-delete-if (cl-pred cl-list &rest cl-keys)
+(defun cl-delete-if (pred list &rest cl-keys)
"Remove all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-delete nil cl-list :if cl-pred cl-keys))
+ (apply #'cl-delete nil list :if pred cl-keys))
;;;###autoload
-(defun cl-delete-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-delete-if-not (pred list &rest cl-keys)
"Remove all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-delete nil cl-list :if-not cl-pred cl-keys))
+ (apply #'cl-delete nil list :if-not pred cl-keys))
;;;###autoload
-(defun cl-remove-duplicates (cl-seq &rest cl-keys)
+(defun cl-remove-duplicates (seq &rest cl-keys)
"Return a copy of SEQ with all duplicate elements removed.
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cl--delete-duplicates cl-seq cl-keys t))
+ (cl--delete-duplicates seq cl-keys t))
;;;###autoload
-(defun cl-delete-duplicates (cl-seq &rest cl-keys)
+(defun cl-delete-duplicates (seq &rest cl-keys)
"Remove all duplicate elements from SEQ (destructively).
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cl--delete-duplicates cl-seq cl-keys nil))
+ (cl--delete-duplicates seq cl-keys nil))
-(defun cl--delete-duplicates (cl-seq cl-keys cl-copy)
- (if (listp cl-seq)
+(defun cl--delete-duplicates (seq cl-keys copy)
+ (if (listp seq)
(cl--parsing-keywords
;; We need to parse :if, otherwise `cl-if' is unbound.
(:test :test-not :key (:start 0) :end :from-end :if)
()
(if cl-from-end
- (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
- (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
+ (let ((p (nthcdr cl-start seq)) i)
+ (setq cl-end (- (or cl-end (length seq)) cl-start))
(while (> cl-end 1)
- (setq cl-i 0)
- (while (setq cl-i (cl--position (cl--check-key (car cl-p))
- (cdr cl-p) cl-i (1- cl-end)))
- (if cl-copy (setq cl-seq (copy-sequence cl-seq)
- cl-p (nthcdr cl-start cl-seq) cl-copy nil))
- (let ((cl-tail (nthcdr cl-i cl-p)))
- (setcdr cl-tail (cdr (cdr cl-tail))))
+ (setq i 0)
+ (while (setq i (cl--position (cl--check-key (car p))
+ (cdr p) i (1- cl-end)))
+ (if copy (setq seq (copy-sequence seq)
+ p (nthcdr cl-start seq) copy nil))
+ (let ((tail (nthcdr i p)))
+ (setcdr tail (cdr (cdr tail))))
(setq cl-end (1- cl-end)))
- (setq cl-p (cdr cl-p) cl-end (1- cl-end)
+ (setq p (cdr p) cl-end (1- cl-end)
cl-start (1+ cl-start)))
- cl-seq)
- (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
- (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
- (cl--position (cl--check-key (car cl-seq))
- (cdr cl-seq) 0 (1- cl-end)))
- (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
- (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
- (setq cl-end (1- cl-end) cl-start 1) cl-seq)))
- (while (and (cdr (cdr cl-p)) (> cl-end 1))
- (if (cl--position (cl--check-key (car (cdr cl-p)))
- (cdr (cdr cl-p)) 0 (1- cl-end))
+ seq)
+ (setq cl-end (- (or cl-end (length seq)) cl-start))
+ (while (and (cdr seq) (= cl-start 0) (> cl-end 1)
+ (cl--position (cl--check-key (car seq))
+ (cdr seq) 0 (1- cl-end)))
+ (setq seq (cdr seq) cl-end (1- cl-end)))
+ (let ((p (if (> cl-start 0) (nthcdr (1- cl-start) seq)
+ (setq cl-end (1- cl-end) cl-start 1) seq)))
+ (while (and (cdr (cdr p)) (> cl-end 1))
+ (if (cl--position (cl--check-key (car (cdr p)))
+ (cdr (cdr p)) 0 (1- cl-end))
(progn
- (if cl-copy (setq cl-seq (copy-sequence cl-seq)
- cl-p (nthcdr (1- cl-start) cl-seq)
- cl-copy nil))
- (setcdr cl-p (cdr (cdr cl-p))))
- (setq cl-p (cdr cl-p)))
+ (if copy (setq seq (copy-sequence seq)
+ p (nthcdr (1- cl-start) seq)
+ copy nil))
+ (setcdr p (cdr (cdr p))))
+ (setq p (cdr p)))
(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)))))
+ seq)))
+ (let ((res (cl--delete-duplicates (append seq nil) cl-keys nil)))
+ (if (stringp seq) (concat res) (vconcat res)))))
;;;###autoload
-(defun cl-substitute (cl-new cl-old cl-seq &rest cl-keys)
+(defun cl-substitute (new old seq &rest cl-keys)
"Substitute NEW for OLD in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cl--parsing-keywords (:test :test-not :key :if :if-not :count
- (:start 0) :end :from-end) ()
- (if (or (eq cl-old cl-new)
+ (cl--parsing-keywords ( :test :test-not :key :if :if-not :count
+ (:start 0) :end :from-end) ()
+ (if (or (eq old new)
(<= (or cl-count (setq cl-from-end nil
- cl-count (length cl-seq))) 0))
- cl-seq
- (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end)))
- (if (not cl-i)
- cl-seq
- (setq cl-seq (copy-sequence cl-seq))
+ cl-count (length seq))) 0))
+ seq
+ (let ((i (cl--position old seq cl-start cl-end)))
+ (if (not i)
+ seq
+ (setq seq (copy-sequence seq))
(unless cl-from-end
- (setf (elt cl-seq cl-i) cl-new)
- (incf cl-i)
+ (setf (elt seq i) new)
+ (incf i)
(decf cl-count))
- (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
- :start cl-i cl-keys))))))
+ (apply #'cl-nsubstitute new old seq :count cl-count
+ :start i cl-keys))))))
;;;###autoload
-(defun cl-substitute-if (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-substitute-if (new pred cl-list &rest cl-keys)
"Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-substitute cl-new nil cl-list :if cl-pred cl-keys))
+ (apply #'cl-substitute new nil cl-list :if pred cl-keys))
;;;###autoload
-(defun cl-substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-substitute-if-not (new pred cl-list &rest cl-keys)
"Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-substitute cl-new nil cl-list :if-not cl-pred cl-keys))
+ (apply #'cl-substitute new nil cl-list :if-not pred cl-keys))
;;;###autoload
-(defun cl-nsubstitute (cl-new cl-old seq &rest cl-keys)
+(defun cl-nsubstitute (new old seq &rest cl-keys)
"Substitute NEW for OLD in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cl--parsing-keywords (:test :test-not :key :if :if-not :count
- (:start 0) :end :from-end) ()
- (let* ((cl-seq (if (stringp seq) (string-to-vector seq) seq))
- (len (length cl-seq)))
- (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count len)) 0)
- (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count (/ len 2))))
- (let ((cl-p (nthcdr cl-start cl-seq)))
- (setq cl-end (- (or cl-end len) cl-start))
- (while (and cl-p (> cl-end 0) (> cl-count 0))
- (if (cl--check-test cl-old (car cl-p))
- (progn
- (setcar cl-p cl-new)
- (setq cl-count (1- cl-count))))
- (setq cl-p (cdr cl-p) cl-end (1- cl-end))))
+ (cl--parsing-keywords ( :test :test-not :key :if :if-not :count
+ (:start 0) :end :from-end) ()
+ (let* ((seq (if (stringp seq) (string-to-vector seq) seq))
+ (len (length seq)))
+ (or (eq old new) (<= (or cl-count (setq cl-count len)) 0)
+ (if (and (listp seq) (or (not cl-from-end) (> cl-count (/ len 2))))
+ (let ((p (nthcdr cl-start seq)))
+ (setq cl-end (- (or cl-end len) cl-start))
+ (while (and p (> cl-end 0) (> cl-count 0))
+ (if (cl--check-test old (car p))
+ (progn
+ (setcar p new)
+ (setq cl-count (1- cl-count))))
+ (setq p (cdr p) cl-end (1- cl-end))))
(or cl-end (setq cl-end len))
- (if cl-from-end
- (while (and (< cl-start cl-end) (> cl-count 0))
- (setq cl-end (1- cl-end))
- (if (cl--check-test cl-old (elt cl-seq cl-end))
- (progn
- (setf (elt cl-seq cl-end) cl-new)
- (setq cl-count (1- cl-count)))))
- (while (and (< cl-start cl-end) (> cl-count 0))
- (if (cl--check-test cl-old (aref cl-seq cl-start))
- (progn
- (aset cl-seq cl-start cl-new)
- (setq cl-count (1- cl-count))))
- (setq cl-start (1+ cl-start))))))
- (if (stringp seq) (concat cl-seq) cl-seq))))
+ (if cl-from-end
+ (while (and (< cl-start cl-end) (> cl-count 0))
+ (setq cl-end (1- cl-end))
+ (if (cl--check-test old (elt seq cl-end))
+ (progn
+ (setf (elt seq cl-end) new)
+ (setq cl-count (1- cl-count)))))
+ (while (and (< cl-start cl-end) (> cl-count 0))
+ (if (cl--check-test old (aref seq cl-start))
+ (progn
+ (aset seq cl-start new)
+ (setq cl-count (1- cl-count))))
+ (setq cl-start (1+ cl-start))))))
+ (if (stringp seq) (concat seq) seq))))
;;;###autoload
-(defun cl-nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-nsubstitute-if (new pred list &rest cl-keys)
"Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
+ (apply #'cl-nsubstitute new nil list :if pred cl-keys))
;;;###autoload
-(defun cl-nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-nsubstitute-if-not (new pred list &rest cl-keys)
"Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
+ (apply #'cl-nsubstitute new nil list :if-not pred cl-keys))
;;;###autoload
-(defun cl-find (cl-item cl-seq &rest cl-keys)
+(defun cl-find (item seq &rest cl-keys)
"Find the first occurrence of ITEM in SEQ.
Return the matching ITEM, or nil if not found.
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (let ((cl-pos (apply 'cl-position cl-item cl-seq cl-keys)))
- (and cl-pos (elt cl-seq cl-pos))))
+ (let ((pos (apply #'cl-position item seq cl-keys)))
+ (and pos (elt seq pos))))
;;;###autoload
-(defun cl-find-if (cl-pred cl-list &rest cl-keys)
+(defun cl-find-if (pred list &rest cl-keys)
"Find the first item satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-find nil cl-list :if cl-pred cl-keys))
+ (apply #'cl-find nil list :if pred cl-keys))
;;;###autoload
-(defun cl-find-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-find-if-not (pred list &rest cl-keys)
"Find the first item not satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-find nil cl-list :if-not cl-pred cl-keys))
+ (apply #'cl-find nil list :if-not pred cl-keys))
;;;###autoload
-(defun cl-position (cl-item cl-seq &rest cl-keys)
+(defun cl-position (item seq &rest cl-keys)
"Find the first occurrence of ITEM in SEQ.
Return the index of the matching item, or nil if not found.
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cl--parsing-keywords (:test :test-not :key :if :if-not
- (:start 0) :end :from-end) ()
- (cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
-
-(defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
- (if (listp cl-seq)
- (let ((cl-p (nthcdr cl-start cl-seq))
- cl-res)
- (while (and cl-p (or (null cl-end) (< cl-start cl-end)) (or (null cl-res) cl-from-end))
- (if (cl--check-test cl-item (car cl-p))
- (setq cl-res cl-start))
- (setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
- cl-res)
- (or cl-end (setq cl-end (length cl-seq)))
- (if cl-from-end
+ (cl--parsing-keywords ( :test :test-not :key :if :if-not
+ (:start 0) :end :from-end) ()
+ (cl--position item seq cl-start cl-end cl-from-end)))
+
+(defun cl--position (item seq start &optional end from-end)
+ (if (listp seq)
+ (let ((p (nthcdr start seq))
+ res)
+ (while (and p (or (null end) (< start end)) (or (null res) from-end))
+ (if (cl--check-test item (car p))
+ (setq res start))
+ (setq p (cdr p) start (1+ start)))
+ res)
+ (or end (setq end (length seq)))
+ (if from-end
(progn
- (while (and (>= (setq cl-end (1- cl-end)) cl-start)
- (not (cl--check-test cl-item (aref cl-seq cl-end)))))
- (and (>= cl-end cl-start) cl-end))
- (while (and (< cl-start cl-end)
- (not (cl--check-test cl-item (aref cl-seq cl-start))))
- (setq cl-start (1+ cl-start)))
- (and (< cl-start cl-end) cl-start))))
+ (while (and (>= (setq end (1- end)) start)
+ (not (cl--check-test item (aref seq end)))))
+ (and (>= end start) end))
+ (while (and (< start end)
+ (not (cl--check-test item (aref seq start))))
+ (setq start (1+ start)))
+ (and (< start end) start))))
;;;###autoload
-(defun cl-position-if (cl-pred cl-list &rest cl-keys)
+(defun cl-position-if (pred list &rest cl-keys)
"Find the first item satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-position nil cl-list :if cl-pred cl-keys))
+ (apply #'cl-position nil list :if pred cl-keys))
;;;###autoload
-(defun cl-position-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-position-if-not (pred list &rest cl-keys)
"Find the first item not satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-position nil cl-list :if-not cl-pred cl-keys))
+ (apply #'cl-position nil list :if-not pred cl-keys))
;;;###autoload
-(defun cl-count (cl-item cl-seq &rest cl-keys)
+(defun cl-count (item seq &rest cl-keys)
"Count the number of occurrences of ITEM in SEQ.
\nKeywords supported: :test :test-not :key :start :end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
(cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
- (let ((cl-count 0) cl-x)
- (or cl-end (setq cl-end (length cl-seq)))
- (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
+ (let ((count 0) cl-x)
+ (or cl-end (setq cl-end (length seq)))
+ (if (consp seq) (setq seq (nthcdr cl-start seq)))
(while (< cl-start cl-end)
- (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
- (if (cl--check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
+ (setq cl-x (if (consp seq) (pop seq) (aref seq cl-start)))
+ (if (cl--check-test item cl-x) (setq count (1+ count)))
(setq cl-start (1+ cl-start)))
- cl-count)))
+ count)))
;;;###autoload
-(defun cl-count-if (cl-pred cl-list &rest cl-keys)
+(defun cl-count-if (pred list &rest cl-keys)
"Count the number of items satisfying PREDICATE in SEQ.
\nKeywords supported: :key :start :end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-count nil cl-list :if cl-pred cl-keys))
+ (apply #'cl-count nil list :if pred cl-keys))
;;;###autoload
-(defun cl-count-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-count-if-not (pred list &rest cl-keys)
"Count the number of items not satisfying PREDICATE in SEQ.
\nKeywords supported: :key :start :end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-count nil cl-list :if-not cl-pred cl-keys))
+ (apply #'cl-count nil list :if-not pred cl-keys))
;;;###autoload
-(defun cl-mismatch (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-mismatch (seq1 seq2 &rest cl-keys)
"Compare SEQ1 with SEQ2, return index of first mismatching element.
Return nil if the sequences match. If one sequence is a prefix of the
other, the return value indicates the end of the shorter sequence.
\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cl--parsing-keywords (:test :test-not :key :from-end
- (:start1 0) :end1 (:start2 0) :end2) ()
- (or cl-end1 (setq cl-end1 (length cl-seq1)))
- (or cl-end2 (setq cl-end2 (length cl-seq2)))
+ (cl--parsing-keywords ( :test :test-not :key :from-end
+ (:start1 0) :end1 (:start2 0) :end2) ()
+ (or cl-end1 (setq cl-end1 (length seq1)))
+ (or cl-end2 (setq cl-end2 (length seq2)))
(if cl-from-end
(progn
(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
- (cl--check-match (elt cl-seq1 (1- cl-end1))
- (elt cl-seq2 (1- cl-end2))))
+ (cl--check-match (elt seq1 (1- cl-end1))
+ (elt seq2 (1- cl-end2))))
(setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
(1- cl-end1)))
- (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
- (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
+ (let ((p1 (and (listp seq1) (nthcdr cl-start1 seq1)))
+ (p2 (and (listp seq2) (nthcdr cl-start2 seq2))))
(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
- (cl--check-match (if cl-p1 (car cl-p1)
- (aref cl-seq1 cl-start1))
- (if cl-p2 (car cl-p2)
- (aref cl-seq2 cl-start2))))
- (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
+ (cl--check-match (if p1 (car p1)
+ (aref seq1 cl-start1))
+ (if p2 (car p2)
+ (aref seq2 cl-start2))))
+ (setq p1 (cdr p1) p2 (cdr p2)
cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
cl-start1)))))
;;;###autoload
-(defun cl-search (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-search (seq1 seq2 &rest cl-keys)
"Search for SEQ1 as a subsequence of SEQ2.
Return the index of the leftmost element of the first match found;
return nil if there are no matches.
\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cl--parsing-keywords (:test :test-not :key :from-end
- (:start1 0) :end1 (:start2 0) :end2) ()
- (or cl-end1 (setq cl-end1 (length cl-seq1)))
- (or cl-end2 (setq cl-end2 (length cl-seq2)))
+ (cl--parsing-keywords ( :test :test-not :key :from-end
+ (:start1 0) :end1 (:start2 0) :end2) ()
+ (or cl-end1 (setq cl-end1 (length seq1)))
+ (or cl-end2 (setq cl-end2 (length seq2)))
(if (>= cl-start1 cl-end1)
(if cl-from-end cl-end2 cl-start2)
- (let* ((cl-len (- cl-end1 cl-start1))
- (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
- (cl-if nil) cl-pos)
- (setq cl-end2 (- cl-end2 (1- cl-len)))
+ (let* ((len (- cl-end1 cl-start1))
+ (first (cl--check-key (elt seq1 cl-start1)))
+ (cl-if nil) pos)
+ (setq cl-end2 (- cl-end2 (1- len)))
(while (and (< cl-start2 cl-end2)
- (setq cl-pos (cl--position cl-first cl-seq2
- cl-start2 cl-end2 cl-from-end))
- (apply 'cl-mismatch cl-seq1 cl-seq2
+ (setq pos (cl--position first seq2
+ cl-start2 cl-end2 cl-from-end))
+ (apply #'cl-mismatch seq1 seq2
:start1 (1+ cl-start1) :end1 cl-end1
- :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
+ :start2 (1+ pos) :end2 (+ pos len)
:from-end nil cl-keys))
- (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
- (and (< cl-start2 cl-end2) cl-pos)))))
+ (if cl-from-end (setq cl-end2 pos) (setq cl-start2 (1+ pos))))
+ (and (< cl-start2 cl-end2) pos)))))
;;;###autoload
-(defun cl-sort (cl-seq cl-pred &rest cl-keys)
+(defun cl-sort (seq pred &rest cl-keys)
"Sort the argument SEQ according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
\nKeywords supported: :key
;; It's safe to ignore the return value when used on arrays,
;; but most calls pass lists.
(declare (important-return-value t))
- (if (nlistp cl-seq)
- (if (stringp cl-seq)
- (concat (apply #'cl-sort (vconcat cl-seq) cl-pred cl-keys))
- (cl-replace cl-seq
- (apply #'cl-sort (append cl-seq nil) cl-pred cl-keys)))
+ (if (nlistp seq)
+ (if (stringp seq)
+ (concat (apply #'cl-sort (vconcat seq) pred cl-keys))
+ (cl-replace seq
+ (apply #'cl-sort (append seq nil) pred cl-keys)))
(cl--parsing-keywords (:key) ()
(if (memq cl-key '(nil identity))
- (sort cl-seq cl-pred)
- (sort cl-seq (lambda (cl-x cl-y)
- (funcall cl-pred (funcall cl-key cl-x)
- (funcall cl-key cl-y))))))))
+ (sort seq pred)
+ (sort seq (lambda (cl-x cl-y)
+ (funcall pred (funcall cl-key cl-x)
+ (funcall cl-key cl-y))))))))
;;;###autoload
-(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)
+(defun cl-stable-sort (seq pred &rest cl-keys)
"Sort the argument SEQ stably according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
\nKeywords supported: :key
;; It's safe to ignore the return value when used on arrays,
;; but most calls pass lists.
(declare (important-return-value t))
- (apply 'cl-sort cl-seq cl-pred cl-keys))
+ (apply #'cl-sort seq pred cl-keys))
;;;###autoload
-(defun cl-merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
+(defun cl-merge (type seq1 seq2 pred &rest cl-keys)
"Destructively merge the two sequences to produce a new sequence.
TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
sequences, and PREDICATE is a `less-than' predicate on the elements.
\nKeywords supported: :key
\n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
- (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
+ (or (listp seq1) (setq seq1 (append seq1 nil)))
+ (or (listp seq2) (setq seq2 (append seq2 nil)))
(cl--parsing-keywords (:key) ()
- (let ((cl-res nil))
- (while (and cl-seq1 cl-seq2)
- (if (funcall cl-pred (cl--check-key (car cl-seq2))
- (cl--check-key (car cl-seq1)))
- (push (pop cl-seq2) cl-res)
- (push (pop cl-seq1) cl-res)))
- (cl-coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
+ (let ((res nil))
+ (while (and seq1 seq2)
+ (if (funcall pred (cl--check-key (car seq2))
+ (cl--check-key (car seq1)))
+ (push (pop seq2) res)
+ (push (pop seq1) res)))
+ (cl-coerce (nconc (nreverse res) seq1 seq2) type))))
;;;###autoload
-(defun cl-member (cl-item cl-list &rest cl-keys)
+(defun cl-member (item list &rest cl-keys)
"Find the first occurrence of ITEM in LIST.
Return the sublist of LIST whose car is ITEM.
\nKeywords supported: :test :test-not :key
(compiler-macro cl--compiler-macro-member))
(if cl-keys
(cl--parsing-keywords (:test :test-not :key :if :if-not) ()
- (while (and cl-list (not (cl--check-test cl-item (car cl-list))))
- (setq cl-list (cdr cl-list)))
- cl-list)
- (memql cl-item cl-list)))
+ (while (and list (not (cl--check-test item (car list))))
+ (setq list (cdr list)))
+ list)
+ (memql item list)))
(autoload 'cl--compiler-macro-member "cl-macs")
;;;###autoload
-(defun cl-member-if (cl-pred cl-list &rest cl-keys)
+(defun cl-member-if (pred list &rest cl-keys)
"Find the first item satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-member nil cl-list :if cl-pred cl-keys))
+ (apply #'cl-member nil list :if pred cl-keys))
;;;###autoload
-(defun cl-member-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-member-if-not (pred list &rest cl-keys)
"Find the first item not satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-member nil cl-list :if-not cl-pred cl-keys))
+ (apply #'cl-member nil list :if-not pred cl-keys))
;;;###autoload
-(defun cl--adjoin (cl-item cl-list &rest cl-keys)
+(defun cl--adjoin (item list &rest cl-keys)
(if (cl--parsing-keywords (:key) t
- (apply 'cl-member (cl--check-key cl-item) cl-list cl-keys))
- cl-list
- (cons cl-item cl-list)))
+ (apply #'cl-member (cl--check-key item) list cl-keys))
+ list
+ (cons item list)))
;;;###autoload
-(defun cl-assoc (cl-item cl-alist &rest cl-keys)
+(defun cl-assoc (item alist &rest cl-keys)
"Find the first item whose car matches ITEM in LIST.
\nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(compiler-macro cl--compiler-macro-assoc))
(if cl-keys
(cl--parsing-keywords (:test :test-not :key :if :if-not) ()
- (while (and cl-alist
- (or (not (consp (car cl-alist)))
- (not (cl--check-test cl-item (car (car cl-alist))))))
- (setq cl-alist (cdr cl-alist)))
- (and cl-alist (car cl-alist)))
- (if (and (numberp cl-item) (not (fixnump cl-item)))
- (assoc cl-item cl-alist)
- (assq cl-item cl-alist))))
+ (while (and alist
+ (or (not (consp (car alist)))
+ (not (cl--check-test item (car (car alist))))))
+ (setq alist (cdr alist)))
+ (and alist (car alist)))
+ (if (and (numberp item) (not (fixnump item)))
+ (assoc item alist)
+ (assq item alist))))
(autoload 'cl--compiler-macro-assoc "cl-macs")
;;;###autoload
-(defun cl-assoc-if (cl-pred cl-list &rest cl-keys)
+(defun cl-assoc-if (pred list &rest cl-keys)
"Find the first item whose car satisfies PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-assoc nil cl-list :if cl-pred cl-keys))
+ (apply #'cl-assoc nil list :if pred cl-keys))
;;;###autoload
-(defun cl-assoc-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-assoc-if-not (pred list &rest cl-keys)
"Find the first item whose car does not satisfy PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-assoc nil cl-list :if-not cl-pred cl-keys))
+ (apply #'cl-assoc nil list :if-not pred cl-keys))
;;;###autoload
-(defun cl-rassoc (cl-item cl-alist &rest cl-keys)
+(defun cl-rassoc (item alist &rest cl-keys)
"Find the first item whose cdr matches ITEM in LIST.
\nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (if (or cl-keys (numberp cl-item))
+ (if (or cl-keys (numberp item))
(cl--parsing-keywords (:test :test-not :key :if :if-not) ()
- (while (and cl-alist
- (or (not (consp (car cl-alist)))
- (not (cl--check-test cl-item (cdr (car cl-alist))))))
- (setq cl-alist (cdr cl-alist)))
- (and cl-alist (car cl-alist)))
- (rassq cl-item cl-alist)))
+ (while (and alist
+ (or (not (consp (car alist)))
+ (not (cl--check-test item (cdr (car alist))))))
+ (setq alist (cdr alist)))
+ (and alist (car alist)))
+ (rassq item alist)))
;;;###autoload
-(defun cl-rassoc-if (cl-pred cl-list &rest cl-keys)
+(defun cl-rassoc-if (pred list &rest cl-keys)
"Find the first item whose cdr satisfies PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-rassoc nil cl-list :if cl-pred cl-keys))
+ (apply #'cl-rassoc nil list :if pred cl-keys))
;;;###autoload
-(defun cl-rassoc-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-rassoc-if-not (pred list &rest cl-keys)
"Find the first item whose cdr does not satisfy PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-rassoc nil cl-list :if-not cl-pred cl-keys))
+ (apply #'cl-rassoc nil list :if-not pred cl-keys))
;;;###autoload
-(defun cl-union (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-union (list1 list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-union operation.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
- ((and (not cl-keys) (equal cl-list1 cl-list2)) cl-list1)
+ (cond ((null list1) list2) ((null list2) list1)
+ ((and (not cl-keys) (equal list1 list2)) list1)
(t
- (or (>= (length cl-list1) (length cl-list2))
- (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
- (while cl-list2
- (if (or cl-keys (numberp (car cl-list2)))
- (setq cl-list1
- (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys))
- (or (memq (car cl-list2) cl-list1)
- (push (car cl-list2) cl-list1)))
- (pop cl-list2))
- cl-list1)))
+ (or (>= (length list1) (length list2))
+ (setq list1 (prog1 list2 (setq list2 list1))))
+ (while list2
+ (if (or cl-keys (numberp (car list2)))
+ (setq list1
+ (apply #'cl-adjoin (car list2) list1 cl-keys))
+ (or (memq (car list2) list1)
+ (push (car list2) list1)))
+ (pop list2))
+ list1)))
;;;###autoload
-(defun cl-nunion (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nunion (list1 list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-union operation.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
- (t (apply 'cl-union cl-list1 cl-list2 cl-keys))))
+ (cond ((null list1) list2) ((null list2) list1)
+ (t (apply #'cl-union list1 list2 cl-keys))))
;;;###autoload
-(defun cl-intersection (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-intersection (list1 list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-intersection operation.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (and cl-list1 cl-list2
- (if (equal cl-list1 cl-list2) cl-list1
+ (and list1 list2
+ (if (equal list1 list2) list1
(cl--parsing-keywords (:key) (:test :test-not)
- (let ((cl-res nil))
- (or (>= (length cl-list1) (length cl-list2))
- (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
- (while cl-list2
- (if (if (or cl-keys (numberp (car cl-list2)))
- (apply 'cl-member (cl--check-key (car cl-list2))
- cl-list1 cl-keys)
- (memq (car cl-list2) cl-list1))
- (push (car cl-list2) cl-res))
- (pop cl-list2))
- cl-res)))))
+ (let ((res nil))
+ (or (>= (length list1) (length list2))
+ (setq list1 (prog1 list2 (setq list2 list1))))
+ (while list2
+ (if (if (or cl-keys (numberp (car list2)))
+ (apply #'cl-member (cl--check-key (car list2))
+ list1 cl-keys)
+ (memq (car list2) list1))
+ (push (car list2) res))
+ (pop list2))
+ res)))))
;;;###autoload
-(defun cl-nintersection (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nintersection (list1 list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-intersection operation.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a destructive function; it reuses the storage of LIST1 (but not
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (and cl-list1 cl-list2 (apply 'cl-intersection cl-list1 cl-list2 cl-keys)))
+ (and list1 list2 (apply #'cl-intersection list1 list2 cl-keys)))
;;;###autoload
-(defun cl-set-difference (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-set-difference (list1 list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (if (or (null cl-list1) (null cl-list2)) cl-list1
+ (if (or (null list1) (null list2)) list1
(cl--parsing-keywords (:key) (:test :test-not)
- (let ((cl-res nil))
- (while cl-list1
- (or (if (or cl-keys (numberp (car cl-list1)))
- (apply 'cl-member (cl--check-key (car cl-list1))
- cl-list2 cl-keys)
- (memq (car cl-list1) cl-list2))
- (push (car cl-list1) cl-res))
- (pop cl-list1))
- (nreverse cl-res)))))
+ (let ((res nil))
+ (while list1
+ (or (if (or cl-keys (numberp (car list1)))
+ (apply #'cl-member (cl--check-key (car list1))
+ list2 cl-keys)
+ (memq (car list1) list2))
+ (push (car list1) res))
+ (pop list1))
+ (nreverse res)))))
;;;###autoload
-(defun cl-nset-difference (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nset-difference (list1 list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a destructive function; it reuses the storage of LIST1 (but not
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (if (or (null cl-list1) (null cl-list2)) cl-list1
- (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)))
+ (if (or (null list1) (null list2)) list1
+ (apply #'cl-set-difference list1 list2 cl-keys)))
;;;###autoload
-(defun cl-set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-set-exclusive-or (list1 list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-exclusive-or operation.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
- ((equal cl-list1 cl-list2) nil)
- (t (append (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)
- (apply 'cl-set-difference cl-list2 cl-list1 cl-keys)))))
+ (cond ((null list1) list2) ((null list2) list1)
+ ((equal list1 list2) nil)
+ (t (append (apply #'cl-set-difference list1 list2 cl-keys)
+ (apply #'cl-set-difference list2 list1 cl-keys)))))
;;;###autoload
-(defun cl-nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nset-exclusive-or (list1 list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-exclusive-or operation.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
- ((equal cl-list1 cl-list2) nil)
- (t (nconc (apply 'cl-nset-difference cl-list1 cl-list2 cl-keys)
- (apply 'cl-nset-difference cl-list2 cl-list1 cl-keys)))))
+ (cond ((null list1) list2) ((null list2) list1)
+ ((equal list1 list2) nil)
+ (t (nconc (apply #'cl-nset-difference list1 list2 cl-keys)
+ (apply #'cl-nset-difference list2 list1 cl-keys)))))
;;;###autoload
-(defun cl-subsetp (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-subsetp (list1 list2 &rest cl-keys)
"Return true if LIST1 is a subset of LIST2.
I.e., if every element of LIST1 also appears in LIST2.
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (cond ((null cl-list1) t) ((null cl-list2) nil)
- ((equal cl-list1 cl-list2) t)
+ (cond ((null list1) t) ((null list2) nil)
+ ((equal list1 list2) t)
(t (cl--parsing-keywords (:key) (:test :test-not)
- (while (and cl-list1
- (apply 'cl-member (cl--check-key (car cl-list1))
- cl-list2 cl-keys))
- (pop cl-list1))
- (null cl-list1)))))
+ (while (and list1
+ (apply #'cl-member (cl--check-key (car list1))
+ list2 cl-keys))
+ (pop list1))
+ (null list1)))))
;;;###autoload
-(defun cl-subst-if (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-subst-if (new pred tree &rest cl-keys)
"Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced by NEW.
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
+ (apply #'cl-sublis (list (cons nil new)) tree :if pred cl-keys))
;;;###autoload
-(defun cl-subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-subst-if-not (new pred tree &rest cl-keys)
"Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all non-matching elements replaced by NEW.
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+ (apply #'cl-sublis (list (cons nil new)) tree :if-not pred cl-keys))
;;;###autoload
-(defun cl-nsubst (cl-new cl-old cl-tree &rest cl-keys)
+(defun cl-nsubst (new old tree &rest cl-keys)
"Substitute NEW for OLD everywhere in TREE (destructively).
Any element of TREE which is `eql' to OLD is changed to NEW (via a call
to `setcar').
\nKeywords supported: :test :test-not :key
\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
+ (apply #'cl-nsublis (list (cons old new)) tree cl-keys))
;;;###autoload
-(defun cl-nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-nsubst-if (new pred tree &rest cl-keys)
"Substitute NEW for elements matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
+ (apply #'cl-nsublis (list (cons nil new)) tree :if pred cl-keys))
;;;###autoload
-(defun cl-nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-nsubst-if-not (new pred tree &rest cl-keys)
"Substitute NEW for elements not matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
(declare (important-return-value t))
- (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+ (apply #'cl-nsublis (list (cons nil new)) tree :if-not pred cl-keys))
(defvar cl--alist)
;;;###autoload
-(defun cl-sublis (cl-alist cl-tree &rest cl-keys)
+(defun cl-sublis (alist tree &rest cl-keys)
"Perform substitutions indicated by ALIST in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced.
\nKeywords supported: :test :test-not :key
\n(fn ALIST TREE [KEYWORD VALUE]...)"
(declare (important-return-value t))
(cl--parsing-keywords (:test :test-not :key :if :if-not) ()
- (let ((cl--alist cl-alist))
- (cl--sublis-rec cl-tree))))
-
-(defun cl--sublis-rec (cl-tree) ;Uses cl--alist cl-key/test*/if*.
- (let ((cl-temp (cl--check-key cl-tree)) (cl-p cl--alist))
- (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
- (setq cl-p (cdr cl-p)))
- (if cl-p (cdr (car cl-p))
- (if (consp cl-tree)
- (let ((cl-a (cl--sublis-rec (car cl-tree)))
- (cl-d (cl--sublis-rec (cdr cl-tree))))
- (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree)))
- cl-tree
- (cons cl-a cl-d)))
- cl-tree))))
+ (let ((cl--alist alist))
+ (cl--sublis-rec tree))))
+
+(defun cl--sublis-rec (tree) ;Uses cl--alist cl-key/test*/if*.
+ (let ((temp (cl--check-key tree))
+ (p cl--alist))
+ (while (and p (not (cl--check-test-nokey (car (car p)) temp)))
+ (setq p (cdr p)))
+ (if p (cdr (car p))
+ (if (consp tree)
+ (let ((a (cl--sublis-rec (car tree)))
+ (d (cl--sublis-rec (cdr tree))))
+ (if (and (eq a (car tree)) (eq d (cdr tree)))
+ tree
+ (cons a d)))
+ tree))))
;;;###autoload
-(defun cl-nsublis (cl-alist cl-tree &rest cl-keys)
+(defun cl-nsublis (alist tree &rest cl-keys)
"Perform substitutions indicated by ALIST in TREE (destructively).
Any matching element of TREE is changed via a call to `setcar'.
\nKeywords supported: :test :test-not :key
\n(fn ALIST TREE [KEYWORD VALUE]...)"
(declare (important-return-value t))
(cl--parsing-keywords (:test :test-not :key :if :if-not) ()
- (let ((cl-hold (list cl-tree))
- (cl--alist cl-alist))
- (cl--nsublis-rec cl-hold)
- (car cl-hold))))
-
-(defun cl--nsublis-rec (cl-tree) ;Uses cl--alist cl-key/test*/if*.
- (while (consp cl-tree)
- (let ((cl-temp (cl--check-key (car cl-tree))) (cl-p cl--alist))
- (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
- (setq cl-p (cdr cl-p)))
- (if cl-p (setcar cl-tree (cdr (car cl-p)))
- (if (consp (car cl-tree)) (cl--nsublis-rec (car cl-tree))))
- (setq cl-temp (cl--check-key (cdr cl-tree)) cl-p cl--alist)
- (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
- (setq cl-p (cdr cl-p)))
- (if cl-p
- (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
- (setq cl-tree (cdr cl-tree))))))
+ (let ((hold (list tree))
+ (cl--alist alist))
+ (cl--nsublis-rec hold)
+ (car hold))))
+
+(defun cl--nsublis-rec (tree) ;Uses cl--alist cl-key/test*/if*.
+ (while (consp tree)
+ (let ((temp (cl--check-key (car tree)))
+ (p cl--alist))
+ (while (and p (not (cl--check-test-nokey (car (car p)) temp)))
+ (setq p (cdr p)))
+ (if p (setcar tree (cdr (car p)))
+ (if (consp (car tree)) (cl--nsublis-rec (car tree))))
+ (setq temp (cl--check-key (cdr tree)) p cl--alist)
+ (while (and p (not (cl--check-test-nokey (car (car p)) temp)))
+ (setq p (cdr p)))
+ (if p
+ (progn (setcdr tree (cdr (car p))) (setq tree nil))
+ (setq tree (cdr tree))))))
;;;###autoload
-(defun cl-tree-equal (cl-x cl-y &rest cl-keys)
+(defun cl-tree-equal (x y &rest cl-keys)
"Return t if trees TREE1 and TREE2 have `eql' leaves.
Atoms are compared by `eql'; cons cells are compared recursively.
\nKeywords supported: :test :test-not :key
\n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
(declare (important-return-value t))
(cl--parsing-keywords (:test :test-not :key) ()
- (cl--tree-equal-rec cl-x cl-y)))
+ (cl--tree-equal-rec x y)))
-(defun cl--tree-equal-rec (cl-x cl-y) ;Uses cl-key/test*.
- (while (and (consp cl-x) (consp cl-y)
- (cl--tree-equal-rec (car cl-x) (car cl-y)))
- (setq cl-x (cdr cl-x) cl-y (cdr cl-y)))
- (and (not (consp cl-x)) (not (consp cl-y)) (cl--check-match cl-x cl-y)))
+(defun cl--tree-equal-rec (x y) ;Uses cl-key/test*.
+ (while (and (consp x) (consp y)
+ (cl--tree-equal-rec (car x) (car y)))
+ (setq x (cdr x) y (cdr y)))
+ (and (not (consp x)) (not (consp y)) (cl--check-match x y)))
(make-obsolete-variable 'cl-seq-load-hook
projects / emacs.git / commitdiff