Function: allout-range-overlaps

allout-range-overlaps is a byte-compiled function defined in allout-widgets.el.gz.

Signature

(allout-range-overlaps FROM TO RANGES)

Documentation

Return a pair indicating overlap of FROM and TO subtree range in RANGES.

First element of result indicates whether candidate range FROM, TO overlapped any of the existing ranges.

Second element of result is a new version of RANGES incorporating the candidate range with overlaps consolidated.

FROM and TO must be in increasing order, as must be the pairs in RANGES.

Source Code

;; Defined in /usr/src/emacs/lisp/allout-widgets.el.gz
;;;_   > allout-range-overlaps (from to ranges)
(defun allout-range-overlaps (from to ranges)
  "Return a pair indicating overlap of FROM and TO subtree range in RANGES.

First element of result indicates whether candidate range FROM, TO
overlapped any of the existing ranges.

Second element of result is a new version of RANGES incorporating the
candidate range with overlaps consolidated.

FROM and TO must be in increasing order, as must be the pairs in RANGES."
  ;; to append to the end: (rplacd next-to-last-cdr (list 'f))
  (let (new-ranges
        entry
        ;; the start of the range that includes the candidate from:
        included-from
        ;; the end of the range that includes the candidate to:
        included-to
        ;; the candidates were inserted:
        done)
    (while (and ranges (not done))
      (setq entry (car ranges)
            ranges (cdr ranges))

      (cond

       (included-from
        ;; some entry included the candidate from.
        (cond ((> (car entry) to)
               ;; current entry exceeds end of candidate range - done.
               (push (list included-from to) new-ranges)
               (push entry new-ranges)
               (setq included-to to
                     done t))
              ((>= (cadr entry) to)
               ;; current entry includes end of candidate range - done.
               (push (list included-from (cadr entry)) new-ranges)
               (setq included-to (cadr entry)
                     done t))
               ;; current entry contained in candidate range - ditch, continue:
              (t nil)))

       ((> (car entry) to)
        ;; current entry start exceeds candidate end - done, placed as new entry
        (push (list from to) new-ranges)
        (push entry new-ranges)
        (setq included-to to
              done t))

       ((>= (car entry) from)
        ;; current entry start is above candidate start, but not above
        ;; candidate end (by prior case).
        (setq included-from from)
        ;; now we have to check on whether this entry contains to, or continue:
        (when (>= (cadr entry) to)
          ;; current entry contains only candidate end - done:
          (push (list included-from (cadr entry)) new-ranges)
          (setq included-to (cadr entry)
                done t))
        ;; otherwise, we will continue to look for placement of candidate end.
        )

       ((>= (cadr entry) to)
        ;; current entry properly contains candidate range.
        (push entry new-ranges)
        (setq included-from (car entry)
              included-to (cadr entry)
              done t))

       ((>= (cadr entry) from)
        ;; current entry contains start of candidate range.
        (setq included-from (car entry)))

       (t
        ;; current entry is below the candidate range.
        (push entry new-ranges))))

    (cond ((and included-from included-to)
           ;; candidates placed.
           nil)
          ((not (or included-from included-to))
           ;; candidates found no place, must be at the end:
           (push (list from to) new-ranges))
          (included-from
           ;; candidate start placed but end not:
           (push (list included-from to) new-ranges))
          ;; might be included-to and not included-from, indicating new entry.
          )
    (setq new-ranges (nreverse new-ranges))
    (if ranges (setq new-ranges (append new-ranges ranges)))
    (list (if included-from t) new-ranges)))