X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-range.el;h=a4262df5328277d7c5396cfdb92f50067827c1fc;hp=337e43693f500bdf4693b797da78b72a3e4eb161;hb=b7df893161350265e845a70d711a97a32536a221;hpb=02c8d3376994d6880c386a24162624064eb944e2 diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 337e43693..a4262df53 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -1,27 +1,25 @@ ;;; gnus-range.el --- range and sequence functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -61,6 +59,78 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE." (setq list2 (cdr list2))) list1)) +(defun gnus-range-nconcat (&rest ranges) + "Return a range comprising all the RANGES, which are pre-sorted. +RANGES will be destructively altered." + (setq ranges (delete nil ranges)) + (let* ((result (gnus-range-normalize (pop ranges))) + (last (last result))) + (dolist (range ranges) + (setq range (gnus-range-normalize range)) + ;; Normalize the single-number case, so that we don't need to + ;; special-case that so much. + (when (numberp (car last)) + (setcar last (cons (car last) (car last)))) + (when (numberp (car range)) + (setcar range (cons (car range) (car range)))) + (if (= (1+ (cdar last)) (caar range)) + (progn + (setcdr (car last) (cdar range)) + (setcdr last (cdr range))) + (setcdr last range) + ;; Denormalize back, since we couldn't join the ranges up. + (when (= (caar range) (cdar range)) + (setcar range (caar range))) + (when (= (caar last) (cdar last)) + (setcar last (caar last)))) + (setq last (last last))) + (if (and (consp (car result)) + (= (length result) 1)) + (car result) + result))) + +(defun gnus-range-difference (range1 range2) + "Return the range of elements in RANGE1 that do not appear in RANGE2. +Both ranges must be in ascending order." + (setq range1 (gnus-range-normalize range1)) + (setq range2 (gnus-range-normalize range2)) + (let* ((new-range (cons nil (copy-sequence range1))) + (r new-range) + (safe t)) + (while (cdr r) + (let* ((r1 (cadr r)) + (r2 (car range2)) + (min1 (if (numberp r1) r1 (car r1))) + (max1 (if (numberp r1) r1 (cdr r1))) + (min2 (if (numberp r2) r2 (car r2))) + (max2 (if (numberp r2) r2 (cdr r2)))) + + (cond ((> min1 max1) + ;; Invalid range: may result from overlap condition (below) + ;; remove Invalid range + (setcdr r (cddr r))) + ((and (= min1 max1) + (listp r1)) + ;; Inefficient representation: may result from overlap condition (below) + (setcar (cdr r) min1)) + ((not min2) + ;; All done with range2 + (setq r nil)) + ((< max1 min2) + ;; No overlap: range1 preceeds range2 + (pop r)) + ((< max2 min1) + ;; No overlap: range2 preceeds range1 + (pop range2)) + ((and (<= min2 min1) (<= max1 max2)) + ;; Complete overlap: range1 removed + (setcdr r (cddr r))) + (t + (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r))))))) + (cdr new-range))) + + + ;;;###autoload (defun gnus-sorted-difference (list1 list2) "Return a list of elements of LIST1 that do not appear in LIST2. @@ -141,6 +211,58 @@ LIST1 and LIST2 have to be sorted over <." (setq list2 (cdr list2))))) (nreverse out))) +;;;###autoload +(defun gnus-sorted-range-intersection (range1 range2) + "Return intersection of RANGE1 and RANGE2. +RANGE1 and RANGE2 have to be sorted over <." + (let* (out + (min1 (car range1)) + (max1 (if (numberp min1) + (if (numberp (cdr range1)) + (prog1 (cdr range1) + (setq range1 nil)) min1) + (prog1 (cdr min1) + (setq min1 (car min1))))) + (min2 (car range2)) + (max2 (if (numberp min2) + (if (numberp (cdr range2)) + (prog1 (cdr range2) + (setq range2 nil)) min2) + (prog1 (cdr min2) + (setq min2 (car min2)))))) + (setq range1 (cdr range1) + range2 (cdr range2)) + (while (and min1 min2) + (cond ((< max1 min2) ; range1 preceeds range2 + (setq range1 (cdr range1) + min1 nil)) + ((< max2 min1) ; range2 preceeds range1 + (setq range2 (cdr range2) + min2 nil)) + (t ; some sort of overlap is occurring + (let ((min (max min1 min2)) + (max (min max1 max2))) + (setq out (if (= min max) + (cons min out) + (cons (cons min max) out)))) + (if (< max1 max2) ; range1 ends before range2 + (setq min1 nil) ; incr range1 + (setq min2 nil)))) ; incr range2 + (unless min1 + (setq min1 (car range1) + max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1)))) + range1 (cdr range1))) + (unless min2 + (setq min2 (car range2) + max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2)))) + range2 (cdr range2)))) + (cond ((cdr out) + (nreverse out)) + ((numberp (car out)) + out) + (t + (car out))))) + ;;;###autoload (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection) @@ -213,7 +335,7 @@ LIST1 and LIST2 have to be sorted over <." (cdr top))) (defun gnus-compress-sequence (numbers &optional always-list) - "Convert list of numbers to a list of ranges or a single range. + "Convert sorted list of numbers to a list of ranges or a single range. If ALWAYS-LIST is non-nil, this function will always release a list of ranges." (let* ((first (car numbers)) @@ -433,7 +555,7 @@ LIST is a sorted list." (if (numberp (car ranges)) (= (car ranges) number) ;; (caar ranges) <= number <= (cdar ranges) - (>= number (caar ranges)))) + (>= number (caar ranges)))) (push number result))) (nreverse result))) @@ -547,6 +669,19 @@ LIST is a sorted list." (setcdr prev (cons num list))) (cdr top))) +(defun gnus-range-map (func range) + "Apply FUNC to each value contained by RANGE." + (setq range (gnus-range-normalize range)) + (while range + (let ((span (pop range))) + (if (numberp span) + (funcall func span) + (let ((first (car span)) + (last (cdr span))) + (while (<= first last) + (funcall func first) + (setq first (1+ first)))))))) + (provide 'gnus-range) ;;; gnus-range.el ends here