;;; gnus-range.el --- range and sequence functions for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 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 <larsi@gnus.org>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+(eval-when-compile (require 'cl))
+
;;; List and range functions
+(defsubst gnus-range-normalize (range)
+ "Normalize RANGE.
+If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
+ (if (listp (cdr-safe range)) range (list range)))
+
(defun gnus-last-element (list)
"Return last element of LIST."
(while (cdr list)
(defun gnus-copy-sequence (list)
"Do a complete, total copy of a list."
- (if (and (consp list) (not (consp (cdr list))))
- (cons (car list) (cdr list))
- (mapcar (lambda (elem) (if (consp elem)
- (if (consp (cdr elem))
- (gnus-copy-sequence elem)
- (cons (car elem) (cdr elem)))
- elem))
- list)))
+ (let (out)
+ (while (consp list)
+ (if (consp (car list))
+ (push (gnus-copy-sequence (pop list)) out)
+ (push (pop list) out)))
+ (if list
+ (nconc (nreverse out) list)
+ (nreverse out))))
(defun gnus-set-difference (list1 list2)
"Return a list of elements of LIST1 that do not appear in LIST2."
(setq list2 (cdr list2)))
list1))
-(defun gnus-sorted-complement (list1 list2)
+(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.
+Both lists have to be sorted over <.
+The tail of LIST1 is not copied."
+ (let (out)
+ (while (and list1 list2)
+ (cond ((= (car list1) (car list2))
+ (setq list1 (cdr list1)
+ list2 (cdr list2)))
+ ((< (car list1) (car list2))
+ (setq out (cons (car list1) out))
+ (setq list1 (cdr list1)))
+ (t
+ (setq list2 (cdr list2)))))
+ (nconc (nreverse out) list1)))
+
+;;;###autoload
+(defun gnus-sorted-ndifference (list1 list2)
"Return a list of elements of LIST1 that do not appear in LIST2.
+Both lists have to be sorted over <.
+LIST1 is modified."
+ (let* ((top (cons nil list1))
+ (prev top))
+ (while (and list1 list2)
+ (cond ((= (car list1) (car list2))
+ (setcdr prev
projects / gnus / blobdiff