48 |
(error "Tried to load `cl-seq' before `cl'!")) |
(error "Tried to load `cl-seq' before `cl'!")) |
49 |
|
|
50 |
|
|
|
;;; We define these here so that this file can compile without having |
|
|
;;; loaded the cl.el file already. |
|
|
|
|
|
(defmacro cl-push (x place) (list 'setq place (list 'cons x place))) |
|
|
(defmacro cl-pop (place) |
|
|
(list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) |
|
|
|
|
|
|
|
51 |
;;; Keyword parsing. This is special-cased here so that we can compile |
;;; Keyword parsing. This is special-cased here so that we can compile |
52 |
;;; this file independent from cl-macs. |
;;; this file independent from cl-macs. |
53 |
|
|
132 |
(setq cl-seq (subseq cl-seq cl-start cl-end)) |
(setq cl-seq (subseq cl-seq cl-start cl-end)) |
133 |
(if cl-from-end (setq cl-seq (nreverse cl-seq))) |
(if cl-from-end (setq cl-seq (nreverse cl-seq))) |
134 |
(let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value) |
(let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value) |
135 |
(cl-seq (cl-check-key (cl-pop cl-seq))) |
(cl-seq (cl-check-key (pop cl-seq))) |
136 |
(t (funcall cl-func))))) |
(t (funcall cl-func))))) |
137 |
(if cl-from-end |
(if cl-from-end |
138 |
(while cl-seq |
(while cl-seq |
139 |
(setq cl-accum (funcall cl-func (cl-check-key (cl-pop cl-seq)) |
(setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq)) |
140 |
cl-accum))) |
cl-accum))) |
141 |
(while cl-seq |
(while cl-seq |
142 |
(setq cl-accum (funcall cl-func cl-accum |
(setq cl-accum (funcall cl-func cl-accum |
143 |
(cl-check-key (cl-pop cl-seq)))))) |
(cl-check-key (pop cl-seq)))))) |
144 |
cl-accum))) |
cl-accum))) |
145 |
|
|
146 |
(defun fill (seq item &rest cl-keys) |
(defun fill (seq item &rest cl-keys) |
510 |
(or cl-end (setq cl-end (length cl-seq))) |
(or cl-end (setq cl-end (length cl-seq))) |
511 |
(if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) |
(if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) |
512 |
(while (< cl-start cl-end) |
(while (< cl-start cl-end) |
513 |
(setq cl-x (if (consp cl-seq) (cl-pop cl-seq) (aref cl-seq cl-start))) |
(setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start))) |
514 |
(if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count))) |
(if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count))) |
515 |
(setq cl-start (1+ cl-start))) |
(setq cl-start (1+ cl-start))) |
516 |
cl-count))) |
cl-count))) |
610 |
(while (and cl-seq1 cl-seq2) |
(while (and cl-seq1 cl-seq2) |
611 |
(if (funcall cl-pred (cl-check-key (car cl-seq2)) |
(if (funcall cl-pred (cl-check-key (car cl-seq2)) |
612 |
(cl-check-key (car cl-seq1))) |
(cl-check-key (car cl-seq1))) |
613 |
(cl-push (cl-pop cl-seq2) cl-res) |
(push (pop cl-seq2) cl-res) |
614 |
(cl-push (cl-pop cl-seq1) cl-res))) |
(push (pop cl-seq1) cl-res))) |
615 |
(coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type)))) |
(coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type)))) |
616 |
|
|
617 |
;;; See compiler macro in cl-macs.el |
;;; See compiler macro in cl-macs.el |
708 |
(if (or cl-keys (numberp (car cl-list2))) |
(if (or cl-keys (numberp (car cl-list2))) |
709 |
(setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys)) |
(setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys)) |
710 |
(or (memq (car cl-list2) cl-list1) |
(or (memq (car cl-list2) cl-list1) |
711 |
(cl-push (car cl-list2) cl-list1))) |
(push (car cl-list2) cl-list1))) |
712 |
(cl-pop cl-list2)) |
(pop cl-list2)) |
713 |
cl-list1))) |
cl-list1))) |
714 |
|
|
715 |
(defun nunion (cl-list1 cl-list2 &rest cl-keys) |
(defun nunion (cl-list1 cl-list2 &rest cl-keys) |
738 |
(apply 'member* (cl-check-key (car cl-list2)) |
(apply 'member* (cl-check-key (car cl-list2)) |
739 |
cl-list1 cl-keys) |
cl-list1 cl-keys) |
740 |
(memq (car cl-list2) cl-list1)) |
(memq (car cl-list2) cl-list1)) |
741 |
(cl-push (car cl-list2) cl-res)) |
(push (car cl-list2) cl-res)) |
742 |
(cl-pop cl-list2)) |
(pop cl-list2)) |
743 |
cl-res))))) |
cl-res))))) |
744 |
|
|
745 |
(defun nintersection (cl-list1 cl-list2 &rest cl-keys) |
(defun nintersection (cl-list1 cl-list2 &rest cl-keys) |
764 |
(apply 'member* (cl-check-key (car cl-list1)) |
(apply 'member* (cl-check-key (car cl-list1)) |
765 |
cl-list2 cl-keys) |
cl-list2 cl-keys) |
766 |
(memq (car cl-list1) cl-list2)) |
(memq (car cl-list1) cl-list2)) |
767 |
(cl-push (car cl-list1) cl-res)) |
(push (car cl-list1) cl-res)) |
768 |
(cl-pop cl-list1)) |
(pop cl-list1)) |
769 |
cl-res)))) |
cl-res)))) |
770 |
|
|
771 |
(defun nset-difference (cl-list1 cl-list2 &rest cl-keys) |
(defun nset-difference (cl-list1 cl-list2 &rest cl-keys) |
809 |
(while (and cl-list1 |
(while (and cl-list1 |
810 |
(apply 'member* (cl-check-key (car cl-list1)) |
(apply 'member* (cl-check-key (car cl-list1)) |
811 |
cl-list2 cl-keys)) |
cl-list2 cl-keys)) |
812 |
(cl-pop cl-list1)) |
(pop cl-list1)) |
813 |
(null cl-list1))))) |
(null cl-list1))))) |
814 |
|
|
815 |
(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) |
(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) |