Commit | Line | Data |
---|---|---|
eec82323 | 1 | ;;; gnus-range.el --- range and sequence functions for Gnus |
16409b0b | 2 | |
e84b4b86 | 3 | ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
114f9c96 | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
eec82323 | 5 | |
6748645f | 6 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
eec82323 LMI |
7 | ;; Keywords: news |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
5e809f55 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
eec82323 | 12 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
eec82323 LMI |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
5e809f55 | 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
eec82323 LMI |
19 | ;; GNU General Public License for more details. |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
eec82323 LMI |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;;; Code: | |
27 | ||
7df7482d RS |
28 | (eval-when-compile (require 'cl)) |
29 | ||
eec82323 LMI |
30 | ;;; List and range functions |
31 | ||
23f87bed MB |
32 | (defsubst gnus-range-normalize (range) |
33 | "Normalize RANGE. | |
34 | If RANGE is a single range, return (RANGE). Otherwise, return RANGE." | |
35 | (if (listp (cdr-safe range)) range (list range))) | |
36 | ||
eec82323 LMI |
37 | (defun gnus-last-element (list) |
38 | "Return last element of LIST." | |
39 | (while (cdr list) | |
40 | (setq list (cdr list))) | |
41 | (car list)) | |
42 | ||
43 | (defun gnus-copy-sequence (list) | |
44 | "Do a complete, total copy of a list." | |
45 | (let (out) | |
46 | (while (consp list) | |
47 | (if (consp (car list)) | |
48 | (push (gnus-copy-sequence (pop list)) out) | |
49 | (push (pop list) out))) | |
50 | (if list | |
51 | (nconc (nreverse out) list) | |
52 | (nreverse out)))) | |
53 | ||
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))) | |
57 | (while list2 | |
58 | (setq list1 (delq (car list2) list1)) | |
59 | (setq list2 (cdr list2))) | |
60 | list1)) | |
61 | ||
20a673b2 KY |
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))) | |
67 | (last (last result))) | |
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)) | |
77 | (progn | |
78 | (setcdr (car last) (cdar range)) | |
79 | (setcdr last (cdr range))) | |
80 | (setcdr last 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)) | |
89 | (car result) | |
90 | result))) | |
91 | ||
23f87bed MB |
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))) | |
98 | (r new-range) | |
99 | (safe t)) | |
100 | (while (cdr r) | |
101 | (let* ((r1 (cadr r)) | |
102 | (r2 (car range2)) | |
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)))) | |
107 | ||
108 | (cond ((> min1 max1) | |
109 | ;; Invalid range: may result from overlap condition (below) | |
110 | ;; remove Invalid range | |
111 | (setcdr r (cddr r))) | |
112 | ((and (= min1 max1) | |
113 | (listp r1)) | |
114 | ;; Inefficient representation: may result from overlap condition (below) | |
115 | (setcar (cdr r) min1)) | |
116 | ((not min2) | |
117 | ;; All done with range2 | |
118 | (setq r nil)) | |
119 | ((< max1 min2) | |
120 | ;; No overlap: range1 preceeds range2 | |
121 | (pop r)) | |
122 | ((< max2 min1) | |
123 | ;; No overlap: range2 preceeds range1 | |
124 | (pop range2)) | |
125 | ((and (<= min2 min1) (<= max1 max2)) | |
126 | ;; Complete overlap: range1 removed | |
127 | (setcdr r (cddr r))) | |
128 | (t | |
129 | (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r))))))) | |
130 | (cdr new-range))) | |
131 | ||
132 | ||
133 | ||
134 | ;;;###autoload | |
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." | |
139 | (let (out) | |
140 | (while (and list1 list2) | |
141 | (cond ((= (car list1) (car list2)) | |
142 | (setq list1 (cdr list1) | |
143 | list2 (cdr list2))) | |
144 | ((< (car list1) (car list2)) | |
145 | (setq out (cons (car list1) out)) | |
146 | (setq list1 (cdr list1))) | |
147 | (t | |
148 | (setq list2 (cdr list2))))) | |
149 | (nconc (nreverse out) list1))) | |
150 | ||
151 | ;;;###autoload | |
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 <. | |
155 | LIST1 is modified." | |
156 | (let* ((top (cons nil list1)) | |
157 | (prev top)) | |
158 | (while (and list1 list2) | |
159 | (cond ((= (car list1) (car list2)) | |
160 | (setcdr prev (cdr list1)) | |
161 | (setq list1 (cdr list1) | |
162 | list2 (cdr list2))) | |
163 | ((< (car list1) (car list2)) | |
164 | (setq prev list1 | |
165 | list1 (cdr list1))) | |
166 | (t | |
167 | (setq list2 (cdr list2))))) | |
168 | (cdr top))) | |
169 | ||
170 | ;;;###autoload | |
eec82323 | 171 | (defun gnus-sorted-complement (list1 list2) |
6748645f | 172 | "Return a list of elements that are in LIST1 or LIST2 but not both. |
eec82323 LMI |
173 | Both lists have to be sorted over <." |
174 | (let (out) | |
175 | (if (or (null list1) (null list2)) | |
176 | (or list1 list2) | |
177 | (while (and list1 list2) | |
178 | (cond ((= (car list1) (car list2)) | |
179 | (setq list1 (cdr list1) | |
180 | list2 (cdr list2))) | |
181 | ((< (car list1) (car list2)) | |
182 | (setq out (cons (car list1) out)) | |
183 | (setq list1 (cdr list1))) | |
184 | (t | |
185 | (setq out (cons (car list2) out)) | |
186 | (setq list2 (cdr list2))))) | |
187 | (nconc (nreverse out) (or list1 list2))))) | |
188 | ||
23f87bed | 189 | ;;;###autoload |
eec82323 LMI |
190 | (defun gnus-intersection (list1 list2) |
191 | (let ((result nil)) | |
192 | (while list2 | |
193 | (when (memq (car list2) list1) | |
194 | (setq result (cons (car list2) result))) | |
195 | (setq list2 (cdr list2))) | |
196 | result)) | |
197 | ||
23f87bed | 198 | ;;;###autoload |
eec82323 | 199 | (defun gnus-sorted-intersection (list1 list2) |
23f87bed MB |
200 | "Return intersection of LIST1 and LIST2. |
201 | LIST1 and LIST2 have to be sorted over <." | |
eec82323 LMI |
202 | (let (out) |
203 | (while (and list1 list2) | |
204 | (cond ((= (car list1) (car list2)) | |
205 | (setq out (cons (car list1) out) | |
206 | list1 (cdr list1) | |
207 | list2 (cdr list2))) | |
208 | ((< (car list1) (car list2)) | |
209 | (setq list1 (cdr list1))) | |
210 | (t | |
211 | (setq list2 (cdr list2))))) | |
212 | (nreverse out))) | |
213 | ||
54506618 MB |
214 | ;;;###autoload |
215 | (defun gnus-sorted-range-intersection (range1 range2) | |
216 | "Return intersection of RANGE1 and RANGE2. | |
217 | RANGE1 and RANGE2 have to be sorted over <." | |
218 | (let* (out | |
219 | (min1 (car range1)) | |
c9fc72fa | 220 | (max1 (if (numberp min1) |
54506618 MB |
221 | (if (numberp (cdr range1)) |
222 | (prog1 (cdr range1) | |
223 | (setq range1 nil)) min1) | |
224 | (prog1 (cdr min1) | |
225 | (setq min1 (car min1))))) | |
226 | (min2 (car range2)) | |
227 | (max2 (if (numberp min2) | |
228 | (if (numberp (cdr range2)) | |
c9fc72fa LMI |
229 | (prog1 (cdr range2) |
230 | (setq range2 nil)) min2) | |
54506618 MB |
231 | (prog1 (cdr min2) |
232 | (setq min2 (car min2)))))) | |
233 | (setq range1 (cdr range1) | |
234 | range2 (cdr range2)) | |
235 | (while (and min1 min2) | |
236 | (cond ((< max1 min2) ; range1 preceeds range2 | |
237 | (setq range1 (cdr range1) | |
238 | min1 nil)) | |
239 | ((< max2 min1) ; range2 preceeds range1 | |
240 | (setq range2 (cdr range2) | |
241 | min2 nil)) | |
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) | |
246 | (cons min out) | |
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 | |
251 | (unless min1 | |
252 | (setq min1 (car range1) | |
253 | max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1)))) | |
254 | range1 (cdr range1))) | |
255 | (unless min2 | |
256 | (setq min2 (car range2) | |
257 | max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2)))) | |
258 | range2 (cdr range2)))) | |
259 | (cond ((cdr out) | |
260 | (nreverse out)) | |
261 | ((numberp (car out)) | |
262 | out) | |
263 | (t | |
264 | (car out))))) | |
265 | ||
23f87bed MB |
266 | ;;;###autoload |
267 | (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection) | |
268 | ||
269 | ;;;###autoload | |
270 | (defun gnus-sorted-nintersection (list1 list2) | |
271 | "Return intersection of LIST1 and LIST2 by modifying cdr pointers of LIST1. | |
272 | LIST1 and LIST2 have to be sorted over <." | |
eec82323 LMI |
273 | (let* ((top (cons nil list1)) |
274 | (prev top)) | |
275 | (while (and list1 list2) | |
276 | (cond ((= (car list1) (car list2)) | |
277 | (setq prev list1 | |
278 | list1 (cdr list1) | |
279 | list2 (cdr list2))) | |
280 | ((< (car list1) (car list2)) | |
281 | (setcdr prev (cdr list1)) | |
282 | (setq list1 (cdr list1))) | |
283 | (t | |
284 | (setq list2 (cdr list2))))) | |
285 | (setcdr prev nil) | |
286 | (cdr top))) | |
287 | ||
23f87bed MB |
288 | ;;;###autoload |
289 | (defun gnus-sorted-union (list1 list2) | |
290 | "Return union of LIST1 and LIST2. | |
291 | LIST1 and LIST2 have to be sorted over <." | |
292 | (let (out) | |
293 | (while (and list1 list2) | |
294 | (cond ((= (car list1) (car list2)) | |
295 | (setq out (cons (car list1) out) | |
296 | list1 (cdr list1) | |
297 | list2 (cdr list2))) | |
298 | ((< (car list1) (car list2)) | |
299 | (setq out (cons (car list1) out) | |
300 | list1 (cdr list1))) | |
301 | (t | |
302 | (setq out (cons (car list2) out) | |
303 | list2 (cdr list2))))) | |
304 | (while list1 | |
305 | (setq out (cons (car list1) out) | |
306 | list1 (cdr list1))) | |
307 | (while list2 | |
308 | (setq out (cons (car list2) out) | |
309 | list2 (cdr list2))) | |
310 | (nreverse out))) | |
311 | ||
312 | ;;;###autoload | |
313 | (defun gnus-sorted-nunion (list1 list2) | |
314 | "Return union of LIST1 and LIST2 by modifying cdr pointers of LIST1. | |
315 | LIST1 and LIST2 have to be sorted over <." | |
316 | (let* ((top (cons nil list1)) | |
317 | (prev top)) | |
318 | (while (and list1 list2) | |
319 | (cond ((= (car list1) (car list2)) | |
320 | (setq prev list1 | |
321 | list1 (cdr list1) | |
322 | list2 (cdr list2))) | |
323 | ((< (car list1) (car list2)) | |
324 | (setq prev list1 | |
325 | list1 (cdr list1))) | |
326 | (t | |
327 | (setcdr prev (list (car list2))) | |
328 | (setq prev (cdr prev) | |
329 | list2 (cdr list2)) | |
330 | (setcdr prev list1)))) | |
331 | (while list2 | |
332 | (setcdr prev (list (car list2))) | |
333 | (setq prev (cdr prev) | |
334 | list2 (cdr list2))) | |
335 | (cdr top))) | |
336 | ||
eec82323 | 337 | (defun gnus-compress-sequence (numbers &optional always-list) |
01c52d31 | 338 | "Convert sorted list of numbers to a list of ranges or a single range. |
eec82323 LMI |
339 | If ALWAYS-LIST is non-nil, this function will always release a list of |
340 | ranges." | |
341 | (let* ((first (car numbers)) | |
342 | (last (car numbers)) | |
343 | result) | |
344 | (if (null numbers) | |
345 | nil | |
346 | (if (not (listp (cdr numbers))) | |
347 | numbers | |
348 | (while numbers | |
349 | (cond ((= last (car numbers)) nil) ;Omit duplicated number | |
350 | ((= (1+ last) (car numbers)) ;Still in sequence | |
351 | (setq last (car numbers))) | |
352 | (t ;End of one sequence | |
353 | (setq result | |
354 | (cons (if (= first last) first | |
355 | (cons first last)) | |
356 | result)) | |
357 | (setq first (car numbers)) | |
358 | (setq last (car numbers)))) | |
359 | (setq numbers (cdr numbers))) | |
360 | (if (and (not always-list) (null result)) | |
361 | (if (= first last) (list first) (cons first last)) | |
362 | (nreverse (cons (if (= first last) first (cons first last)) | |
363 | result))))))) | |
364 | ||
365 | (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) | |
366 | (defun gnus-uncompress-range (ranges) | |
367 | "Expand a list of ranges into a list of numbers. | |
368 | RANGES is either a single range on the form `(num . num)' or a list of | |
369 | these ranges." | |
370 | (let (first last result) | |
371 | (cond | |
372 | ((null ranges) | |
373 | nil) | |
374 | ((not (listp (cdr ranges))) | |
375 | (setq first (car ranges)) | |
376 | (setq last (cdr ranges)) | |
377 | (while (<= first last) | |
378 | (setq result (cons first result)) | |
379 | (setq first (1+ first))) | |
380 | (nreverse result)) | |
381 | (t | |
382 | (while ranges | |
383 | (if (atom (car ranges)) | |
384 | (when (numberp (car ranges)) | |
385 | (setq result (cons (car ranges) result))) | |
386 | (setq first (caar ranges)) | |
387 | (setq last (cdar ranges)) | |
388 | (while (<= first last) | |
389 | (setq result (cons first result)) | |
390 | (setq first (1+ first)))) | |
391 | (setq ranges (cdr ranges))) | |
392 | (nreverse result))))) | |
393 | ||
394 | (defun gnus-add-to-range (ranges list) | |
395 | "Return a list of ranges that has all articles from both RANGES and LIST. | |
396 | Note: LIST has to be sorted over `<'." | |
397 | (if (not ranges) | |
398 | (gnus-compress-sequence list t) | |
399 | (setq list (copy-sequence list)) | |
400 | (unless (listp (cdr ranges)) | |
401 | (setq ranges (list ranges))) | |
402 | (let ((out ranges) | |
403 | ilist lowest highest temp) | |
404 | (while (and ranges list) | |
405 | (setq ilist list) | |
406 | (setq lowest (or (and (atom (car ranges)) (car ranges)) | |
407 | (caar ranges))) | |
408 | (while (and list (cdr list) (< (cadr list) lowest)) | |
409 | (setq list (cdr list))) | |
410 | (when (< (car ilist) lowest) | |
411 | (setq temp list) | |
412 | (setq list (cdr list)) | |
413 | (setcdr temp nil) | |
414 | (setq out (nconc (gnus-compress-sequence ilist t) out))) | |
415 | (setq highest (or (and (atom (car ranges)) (car ranges)) | |
416 | (cdar ranges))) | |
417 | (while (and list (<= (car list) highest)) | |
418 | (setq list (cdr list))) | |
419 | (setq ranges (cdr ranges))) | |
420 | (when list | |
421 | (setq out (nconc (gnus-compress-sequence list t) out))) | |
422 | (setq out (sort out (lambda (r1 r2) | |
423 | (< (or (and (atom r1) r1) (car r1)) | |
424 | (or (and (atom r2) r2) (car r2)))))) | |
425 | (setq ranges out) | |
426 | (while ranges | |
427 | (if (atom (car ranges)) | |
428 | (when (cdr ranges) | |
429 | (if (atom (cadr ranges)) | |
430 | (when (= (1+ (car ranges)) (cadr ranges)) | |
431 | (setcar ranges (cons (car ranges) | |
432 | (cadr ranges))) | |
433 | (setcdr ranges (cddr ranges))) | |
a8151ef7 | 434 | (when (= (1+ (car ranges)) (caadr ranges)) |
eec82323 LMI |
435 | (setcar (cadr ranges) (car ranges)) |
436 | (setcar ranges (cadr ranges)) | |
437 | (setcdr ranges (cddr ranges))))) | |
438 | (when (cdr ranges) | |
439 | (if (atom (cadr ranges)) | |
440 | (when (= (1+ (cdar ranges)) (cadr ranges)) | |
441 | (setcdr (car ranges) (cadr ranges)) | |
442 | (setcdr ranges (cddr ranges))) | |
a8151ef7 LMI |
443 | (when (= (1+ (cdar ranges)) (caadr ranges)) |
444 | (setcdr (car ranges) (cdadr ranges)) | |
eec82323 LMI |
445 | (setcdr ranges (cddr ranges)))))) |
446 | (setq ranges (cdr ranges))) | |
447 | out))) | |
448 | ||
16409b0b GM |
449 | (defun gnus-remove-from-range (range1 range2) |
450 | "Return a range that has all articles from RANGE2 removed from RANGE1. | |
451 | The returned range is always a list. RANGE2 can also be a unsorted | |
452 | list of articles. RANGE1 is modified by side effects, RANGE2 is not | |
453 | modified." | |
454 | (if (or (null range1) (null range2)) | |
455 | range1 | |
456 | (let (out r1 r2 r1_min r1_max r2_min r2_max | |
457 | (range2 (gnus-copy-sequence range2))) | |
458 | (setq range1 (if (listp (cdr range1)) range1 (list range1)) | |
459 | range2 (sort (if (listp (cdr range2)) range2 (list range2)) | |
460 | (lambda (e1 e2) | |
461 | (< (if (consp e1) (car e1) e1) | |
462 | (if (consp e2) (car e2) e2)))) | |
463 | r1 (car range1) | |
464 | r2 (car range2) | |
465 | r1_min (if (consp r1) (car r1) r1) | |
466 | r1_max (if (consp r1) (cdr r1) r1) | |
467 | r2_min (if (consp r2) (car r2) r2) | |
468 | r2_max (if (consp r2) (cdr r2) r2)) | |
469 | (while (and range1 range2) | |
470 | (cond ((< r2_max r1_min) ; r2 < r1 | |
471 | (pop range2) | |
472 | (setq r2 (car range2) | |
473 | r2_min (if (consp r2) (car r2) r2) | |
474 | r2_max (if (consp r2) (cdr r2) r2))) | |
475 | ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1 | |
476 | (pop range1) | |
477 | (setq r1 (car range1) | |
478 | r1_min (if (consp r1) (car r1) r1) | |
479 | r1_max (if (consp r1) (cdr r1) r1))) | |
480 | ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1 | |
481 | (pop range2) | |
482 | (setq r1_min (1+ r2_max) | |
483 | r2 (car range2) | |
484 | r2_min (if (consp r2) (car r2) r2) | |
485 | r2_max (if (consp r2) (cdr r2) r2))) | |
486 | ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1 | |
487 | (if (eq r1_min (1- r2_min)) | |
488 | (push r1_min out) | |
489 | (push (cons r1_min (1- r2_min)) out)) | |
490 | (pop range2) | |
491 | (if (< r2_max r1_max) ; finished with r1? | |
492 | (setq r1_min (1+ r2_max)) | |
493 | (pop range1) | |
494 | (setq r1 (car range1) | |
495 | r1_min (if (consp r1) (car r1) r1) | |
496 | r1_max (if (consp r1) (cdr r1) r1))) | |
497 | (setq r2 (car range2) | |
498 | r2_min (if (consp r2) (car r2) r2) | |
499 | r2_max (if (consp r2) (cdr r2) r2))) | |
500 | ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1 | |
501 | (if (eq r1_min (1- r2_min)) | |
502 | (push r1_min out) | |
503 | (push (cons r1_min (1- r2_min)) out)) | |
504 | (pop range1) | |
505 | (setq r1 (car range1) | |
506 | r1_min (if (consp r1) (car r1) r1) | |
507 | r1_max (if (consp r1) (cdr r1) r1))) | |
508 | ((< r1_max r2_min) ; r2 > r1 | |
509 | (pop range1) | |
510 | (if (eq r1_min r1_max) | |
511 | (push r1_min out) | |
512 | (push (cons r1_min r1_max) out)) | |
513 | (setq r1 (car range1) | |
514 | r1_min (if (consp r1) (car r1) r1) | |
515 | r1_max (if (consp r1) (cdr r1) r1))))) | |
516 | (when r1 | |
517 | (if (eq r1_min r1_max) | |
518 | (push r1_min out) | |
519 | (push (cons r1_min r1_max) out)) | |
520 | (pop range1)) | |
521 | (while range1 | |
522 | (push (pop range1) out)) | |
523 | (nreverse out)))) | |
eec82323 LMI |
524 | |
525 | (defun gnus-member-of-range (number ranges) | |
526 | (if (not (listp (cdr ranges))) | |
527 | (and (>= number (car ranges)) | |
528 | (<= number (cdr ranges))) | |
529 | (let ((not-stop t)) | |
530 | (while (and ranges | |
531 | (if (numberp (car ranges)) | |
532 | (>= number (car ranges)) | |
533 | (>= number (caar ranges))) | |
534 | not-stop) | |
535 | (when (if (numberp (car ranges)) | |
536 | (= number (car ranges)) | |
537 | (and (>= number (caar ranges)) | |
538 | (<= number (cdar ranges)))) | |
539 | (setq not-stop nil)) | |
540 | (setq ranges (cdr ranges))) | |
541 | (not not-stop)))) | |
542 | ||
23f87bed MB |
543 | (defun gnus-list-range-intersection (list ranges) |
544 | "Return a list of numbers in LIST that are members of RANGES. | |
545 | LIST is a sorted list." | |
546 | (setq ranges (gnus-range-normalize ranges)) | |
547 | (let (number result) | |
548 | (while (setq number (pop list)) | |
549 | (while (and ranges | |
550 | (if (numberp (car ranges)) | |
551 | (< (car ranges) number) | |
552 | (< (cdar ranges) number))) | |
553 | (setq ranges (cdr ranges))) | |
554 | (when (and ranges | |
555 | (if (numberp (car ranges)) | |
556 | (= (car ranges) number) | |
557 | ;; (caar ranges) <= number <= (cdar ranges) | |
558 | (>= number (caar ranges)))) | |
559 | (push number result))) | |
560 | (nreverse result))) | |
561 | ||
562 | (defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference) | |
563 | ||
564 | (defun gnus-list-range-difference (list ranges) | |
565 | "Return a list of numbers in LIST that are not members of RANGES. | |
566 | LIST is a sorted list." | |
567 | (setq ranges (gnus-range-normalize ranges)) | |
568 | (let (number result) | |
569 | (while (setq number (pop list)) | |
570 | (while (and ranges | |
571 | (if (numberp (car ranges)) | |
572 | (< (car ranges) number) | |
573 | (< (cdar ranges) number))) | |
574 | (setq ranges (cdr ranges))) | |
575 | (when (or (not ranges) | |
576 | (if (numberp (car ranges)) | |
577 | (not (= (car ranges) number)) | |
578 | ;; not ((caar ranges) <= number <= (cdar ranges)) | |
579 | (< number (caar ranges)))) | |
580 | (push number result))) | |
581 | (nreverse result))) | |
582 | ||
eec82323 LMI |
583 | (defun gnus-range-length (range) |
584 | "Return the length RANGE would have if uncompressed." | |
23f87bed MB |
585 | (cond |
586 | ((null range) | |
587 | 0) | |
588 | ((not (listp (cdr range))) | |
589 | (- (cdr range) (car range) -1)) | |
590 | (t | |
591 | (let ((sum 0)) | |
592 | (dolist (x range sum) | |
593 | (setq sum | |
594 | (+ sum (if (consp x) (- (cdr x) (car x) -1) 1)))))))) | |
eec82323 LMI |
595 | |
596 | (defun gnus-sublist-p (list sublist) | |
597 | "Test whether all elements in SUBLIST are members of LIST." | |
598 | (let ((sublistp t)) | |
599 | (while sublist | |
600 | (unless (memq (pop sublist) list) | |
601 | (setq sublistp nil | |
602 | sublist nil))) | |
603 | sublistp)) | |
604 | ||
605 | (defun gnus-range-add (range1 range2) | |
16409b0b GM |
606 | "Add RANGE2 to RANGE1 (nondestructively)." |
607 | (unless (listp (cdr range1)) | |
608 | (setq range1 (list range1))) | |
609 | (unless (listp (cdr range2)) | |
610 | (setq range2 (list range2))) | |
611 | (let ((item1 (pop range1)) | |
612 | (item2 (pop range2)) | |
613 | range item selector) | |
614 | (while (or item1 item2) | |
615 | (setq selector | |
a1506d29 | 616 | (cond |
16409b0b GM |
617 | ((null item1) nil) |
618 | ((null item2) t) | |
619 | ((and (numberp item1) (numberp item2)) (< item1 item2)) | |
620 | ((numberp item1) (< item1 (car item2))) | |
621 | ((numberp item2) (< (car item1) item2)) | |
622 | (t (< (car item1) (car item2))))) | |
623 | (setq item | |
624 | (or | |
625 | (let ((tmp1 item) (tmp2 (if selector item1 item2))) | |
a1506d29 | 626 | (cond |
16409b0b GM |
627 | ((null tmp1) tmp2) |
628 | ((null tmp2) tmp1) | |
629 | ((and (numberp tmp1) (numberp tmp2)) | |
a1506d29 | 630 | (cond |
16409b0b GM |
631 | ((eq tmp1 tmp2) tmp1) |
632 | ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2)) | |
633 | ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1)) | |
634 | (t nil))) | |
635 | ((numberp tmp1) | |
a1506d29 | 636 | (cond |
16409b0b GM |
637 | ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2) |
638 | ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2))) | |
639 | ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1)) | |
640 | (t nil))) | |
641 | ((numberp tmp2) | |
a1506d29 | 642 | (cond |
16409b0b GM |
643 | ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1) |
644 | ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1))) | |
645 | ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2)) | |
646 | (t nil))) | |
647 | ((< (1+ (cdr tmp1)) (car tmp2)) nil) | |
648 | ((< (1+ (cdr tmp2)) (car tmp1)) nil) | |
a1506d29 | 649 | (t (cons (min (car tmp1) (car tmp2)) |
16409b0b GM |
650 | (max (cdr tmp1) (cdr tmp2)))))) |
651 | (progn | |
652 | (if item (push item range)) | |
653 | (if selector item1 item2)))) | |
654 | (if selector | |
655 | (setq item1 (pop range1)) | |
656 | (setq item2 (pop range2)))) | |
657 | (if item (push item range)) | |
658 | (reverse range))) | |
eec82323 | 659 | |
23f87bed MB |
660 | ;;;###autoload |
661 | (defun gnus-add-to-sorted-list (list num) | |
662 | "Add NUM into sorted LIST by side effect." | |
663 | (let* ((top (cons nil list)) | |
664 | (prev top)) | |
665 | (while (and list (< (car list) num)) | |
666 | (setq prev list | |
667 | list (cdr list))) | |
668 | (unless (eq (car list) num) | |
669 | (setcdr prev (cons num list))) | |
670 | (cdr top))) | |
671 | ||
54506618 MB |
672 | (defun gnus-range-map (func range) |
673 | "Apply FUNC to each value contained by RANGE." | |
674 | (setq range (gnus-range-normalize range)) | |
675 | (while range | |
676 | (let ((span (pop range))) | |
677 | (if (numberp span) | |
678 | (funcall func span) | |
679 | (let ((first (car span)) | |
680 | (last (cdr span))) | |
681 | (while (<= first last) | |
682 | (funcall func first) | |
683 | (setq first (1+ first)))))))) | |
684 | ||
eec82323 LMI |
685 | (provide 'gnus-range) |
686 | ||
687 | ;;; gnus-range.el ends here |