Function: range-remove

range-remove is a byte-compiled function defined in range.el.gz.

Signature

(range-remove RANGE1 RANGE2)

Documentation

Return a range that has all numbers from RANGE2 removed from RANGE1.

The returned range is always a list. RANGE2 can also be a unsorted list of numbers. RANGE1 is modified by side effects, RANGE2 is not modified.

Aliases

gnus-remove-from-range (obsolete since 29.1)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/range.el.gz
(defun range-remove (range1 range2)
  "Return a range that has all numbers from RANGE2 removed from RANGE1.
The returned range is always a list.  RANGE2 can also be a unsorted
list of numbers.  RANGE1 is modified by side effects, RANGE2 is not
modified."
  (if (or (null range1) (null range2))
      range1
    (let (out r1 r2 r1-min r1-max r2-min r2-max
	      (range2 (copy-tree range2)))
      (setq range1 (if (listp (cdr range1)) range1 (list range1))
	    range2 (sort (if (listp (cdr range2)) range2 (list range2))
			 (lambda (e1 e2)
			   (< (if (consp e1) (car e1) e1)
			      (if (consp e2) (car e2) e2))))
	    r1 (car range1)
	    r2 (car range2)
	    r1-min (if (consp r1) (car r1) r1)
	    r1-max (if (consp r1) (cdr r1) r1)
	    r2-min (if (consp r2) (car r2) r2)
	    r2-max (if (consp r2) (cdr r2) r2))
      (while (and range1 range2)
	(cond ((< r2-max r1-min)	; r2 < r1
	       (pop range2)
	       (setq r2 (car range2)
		     r2-min (if (consp r2) (car r2) r2)
		     r2-max (if (consp r2) (cdr r2) r2)))
	      ((and (<= r2-min r1-min) (<= r1-max r2-max)) ; r2 overlap r1
	       (pop range1)
	       (setq r1 (car range1)
		     r1-min (if (consp r1) (car r1) r1)
		     r1-max (if (consp r1) (cdr r1) r1)))
	      ((and (<= r2-min r1-min) (<= r2-max r1-max)) ; r2 overlap min r1
	       (pop range2)
	       (setq r1-min (1+ r2-max)
		     r2 (car range2)
		     r2-min (if (consp r2) (car r2) r2)
		     r2-max (if (consp r2) (cdr r2) r2)))
	      ((and (<= r1-min r2-min) (<= r2-max r1-max)) ; r2 contained in r1
	       (if (eq r1-min (1- r2-min))
		   (push r1-min out)
		 (push (cons r1-min (1- r2-min)) out))
	       (pop range2)
	       (if (< r2-max r1-max)	; finished with r1?
		   (setq r1-min (1+ r2-max))
		 (pop range1)
		 (setq r1 (car range1)
		       r1-min (if (consp r1) (car r1) r1)
		       r1-max (if (consp r1) (cdr r1) r1)))
	       (setq r2 (car range2)
		     r2-min (if (consp r2) (car r2) r2)
		     r2-max (if (consp r2) (cdr r2) r2)))
	      ((and (<= r2-min r1-max) (<= r1-max r2-max)) ; r2 overlap max r1
	       (if (eq r1-min (1- r2-min))
		   (push r1-min out)
		 (push (cons r1-min (1- r2-min)) out))
	       (pop range1)
	       (setq r1 (car range1)
		     r1-min (if (consp r1) (car r1) r1)
		     r1-max (if (consp r1) (cdr r1) r1)))
	      ((< r1-max r2-min)	; r2 > r1
	       (pop range1)
	       (if (eq r1-min r1-max)
		   (push r1-min out)
		 (push (cons r1-min r1-max) out))
	       (setq r1 (car range1)
		     r1-min (if (consp r1) (car r1) r1)
		     r1-max (if (consp r1) (cdr r1) r1)))))
      (when r1
	(if (eq r1-min r1-max)
	    (push r1-min out)
	  (push (cons r1-min r1-max) out))
	(pop range1))
      (while range1
	(push (pop range1) out))
      (nreverse out))))