1 ;;; gnus-range.el --- range and sequence functions for Gnus
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 (eval-when-compile (require 'cl))
30 ;;; List and range functions
32 (defsubst gnus-range-normalize (range)
34 If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
35 (if (listp (cdr-safe range)) range (list range)))
37 (defun gnus-last-element (list)
38 "Return last element of LIST."
40 (setq list (cdr list)))
43 (defun gnus-copy-sequence (list)
44 "Do a complete, total copy of a list."
47 (if (consp (car list))
48 (push (gnus-copy-sequence (pop list)) out)
49 (push (pop list) out)))
51 (nconc (nreverse out) list)
54 (defun gnus-set-difference (list1 list2)
55 "Return a list of elements of LIST1 that do not appear in LIST2."
56 (let ((list1 (copy-sequence list1)))
58 (setq list1 (delq (car list2) list1))
59 (setq list2 (cdr list2)))
62 (defun gnus-range-nconcat (&rest ranges)
63 "Return a range comprising all the RANGES, which are pre-sorted.
64 RANGES will be destructively altered."
65 (setq ranges (delete nil ranges))
66 (let* ((result (gnus-range-normalize (pop ranges)))
68 (dolist (range ranges)
69 (setq range (gnus-range-normalize range))
70 ;; Normalize the single-number case, so that we don't need to
71 ;; special-case that so much.
72 (when (numberp (car last))
73 (setcar last (cons (car last) (car last))))
74 (when (numberp (car range))
75 (setcar range (cons (car range) (car range))))
76 (if (= (1+ (cdar last)) (caar range))
78 (setcdr (car last) (cdar range))
79 (setcdr last (cdr range)))
81 ;; Denormalize back, since we couldn't join the ranges up.
82 (when (= (caar range) (cdar range))
83 (setcar range (caar range)))
84 (when (= (caar last) (cdar last))
85 (setcar last (caar last))))
86 (setq last (last last)))
87 (if (and (consp (car result))
88 (= (length result) 1))
92 (defun gnus-range-difference (range1 range2)
93 "Return the range of elements in RANGE1 that do not appear in RANGE2.
94 Both ranges must be in ascending order."
95 (setq range1 (gnus-range-normalize range1))
96 (setq range2 (gnus-range-normalize range2))
97 (let* ((new-range (cons nil (copy-sequence range1)))
103 (min1 (if (numberp r1) r1 (car r1)))
104 (max1 (if (numberp r1) r1 (cdr r1)))
105 (min2 (if (numberp r2) r2 (car r2)))
106 (max2 (if (numberp r2) r2 (cdr r2))))
109 ;; Invalid range: may result from overlap condition (below)
110 ;; remove Invalid range
114 ;; Inefficient representation: may result from overlap condition (below)
115 (setcar (cdr r) min1))
117 ;; All done with range2
120 ;; No overlap: range1 preceeds range2
123 ;; No overlap: range2 preceeds range1
125 ((and (<= min2 min1) (<= max1 max2))
126 ;; Complete overlap: range1 removed
129 (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r)))))))
135 (defun gnus-sorted-difference (list1 list2)
136 "Return a list of elements of LIST1 that do not appear in LIST2.
137 Both lists have to be sorted over <.
138 The tail of LIST1 is not copied."
140 (while (and list1 list2)
141 (cond ((= (car list1) (car list2))
142 (setq list1 (cdr list1)
144 ((< (car list1) (car list2))
145 (setq out (cons (car list1) out))
146 (setq list1 (cdr list1)))
148 (setq list2 (cdr list2)))))
149 (nconc (nreverse out) list1)))
152 (defun gnus-sorted-ndifference (list1 list2)
153 "Return a list of elements of LIST1 that do not appear in LIST2.
154 Both lists have to be sorted over <.
156 (let* ((top (cons nil list1))
158 (while (and list1 list2)
159 (cond ((= (car list1) (car list2))
160 (setcdr prev (cdr list1))
161 (setq list1 (cdr list1)
163 ((< (car list1) (car list2))
167 (setq list2 (cdr list2)))))
171 (defun gnus-sorted-complement (list1 list2)
172 "Return a list of elements that are in LIST1 or LIST2 but not both.
173 Both lists have to be sorted over <."
175 (if (or (null list1) (null list2))
177 (while (and list1 list2)
178 (cond ((= (car list1) (car list2))
179 (setq list1 (cdr list1)
181 ((< (car list1) (car list2))
182 (setq out (cons (car list1) out))
183 (setq list1 (cdr list1)))
185 (setq out (cons (car list2) out))
186 (setq list2 (cdr list2)))))
187 (nconc (nreverse out) (or list1 list2)))))
190 (defun gnus-intersection (list1 list2)
193 (when (memq (car list2) list1)
194 (setq result (cons (car list2) result)))
195 (setq list2 (cdr list2)))
199 (defun gnus-sorted-intersection (list1 list2)
200 "Return intersection of LIST1 and LIST2.
201 LIST1 and LIST2 have to be sorted over <."
203 (while (and list1 list2)
204 (cond ((= (car list1) (car list2))
205 (setq out (cons (car list1) out)
208 ((< (car list1) (car list2))
209 (setq list1 (cdr list1)))
211 (setq list2 (cdr list2)))))
215 (defun gnus-sorted-range-intersection (range1 range2)
216 "Return intersection of RANGE1 and RANGE2.
217 RANGE1 and RANGE2 have to be sorted over <."
220 (max1 (if (numberp min1)
221 (if (numberp (cdr range1))
223 (setq range1 nil)) min1)
225 (setq min1 (car min1)))))
227 (max2 (if (numberp min2)
228 (if (numberp (cdr range2))
230 (setq range2 nil)) min2)
232 (setq min2 (car min2))))))
233 (setq range1 (cdr range1)
235 (while (and min1 min2)
236 (cond ((< max1 min2) ; range1 preceeds range2
237 (setq range1 (cdr range1)
239 ((< max2 min1) ; range2 preceeds range1
240 (setq range2 (cdr range2)
242 (t ; some sort of overlap is occurring
243 (let ((min (max min1 min2))
244 (max (min max1 max2)))
245 (setq out (if (= min max)
247 (cons (cons min max) out))))
248 (if (< max1 max2) ; range1 ends before range2
249 (setq min1 nil) ; incr range1
250 (setq min2 nil)))) ; incr range2
252 (setq min1 (car range1)
253 max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1))))