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 | ||
23f87bed MB |
62 | (defun gnus-range-difference (range1 range2) |
63 | "Return the range of elements in RANGE1 that do not appear in RANGE2. | |
64 | Both ranges must be in ascending order." | |
65 | (setq range1 (gnus-range-normalize range1)) | |
66 | (setq range2 (gnus-range-normalize range2)) | |
67 | (let* ((new-range (cons nil (copy-sequence range1))) | |
68 | (r new-range) | |
69 | (safe t)) | |
70 | (while (cdr r) | |
71 | (let* ((r1 (cadr r)) | |
72 | (r2 (car range2)) | |
73 | (min1 (if (numberp r1) r1 (car r1))) | |
74 | (max1 (if (numberp r1) r1 (cdr r1))) | |
75 | (min2 (if (numberp r2) r2 (car r2))) | |
76 | (max2 (if (numberp r2) r2 (cdr r2)))) | |
77 | ||
78 | (cond ((> min1 max1) | |
79 | ;; Invalid range: may result from overlap condition (below) | |
80 | ;; remove Invalid range | |
81 | (setcdr r (cddr r))) | |
82 | ((and (= min1 max1) | |
83 | (listp r1)) | |
84 | ;; Inefficient representation: may result from overlap condition (below) | |
85 | (setcar (cdr r) min1)) | |
86 | ((not min2) | |
87 | ;; All done with range2 | |
88 | (setq r nil)) | |
89 | ((< max1 min2) | |
90 | ;; No overlap: range1 preceeds range2 | |
91 | (pop r)) | |
92 | ((< max2 min1) | |
93 | ;; No overlap: range2 preceeds range1 | |
94 | (pop range2)) | |
95 | ((and (<= min2 min1) (<= max1 max2)) | |
96 | ;; Complete overlap: range1 removed | |
97 | (setcdr r (cddr r))) | |
98 | (t | |
99 | (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r))))))) | |
100 | (cdr new-range))) | |
101 | ||
102 | ||
103 | ||
104 | ;;;###autoload | |
105 | (defun gnus-sorted-difference (list1 list2) | |
106 | "Return a list of elements of LIST1 that do not appear in LIST2. | |
107 | Both lists have to be sorted over <. | |
108 | The tail of LIST1 is not copied." | |
109 | (let (out) | |
110 | (while (and list1 list2) | |
111 | (cond ((= (car list1) (car list2)) | |
112 | (setq list1 (cdr list1) | |
113 | list2 (cdr list2))) | |
114 | ((< (car list1) (car list2)) | |
115 | (setq out (cons (car list1) out)) | |
116 | (setq list1 (cdr list1))) | |
117 | (t | |
118 | (setq list2 (cdr list2))))) | |
119 | (nconc (nreverse out) list1))) | |
120 | ||
121 | ;;;###autoload | |
122 | (defun gnus-sorted-ndifference (list1 list2) | |
123 | "Return a list of elements of LIST1 that do not appear in LIST2. | |
124 | Both lists have to be sorted over <. | |
125 | LIST1 is modified." | |
126 | (let* ((top (cons nil list1)) | |
127 | (prev top)) | |
128 | (while (and list1 list2) | |
129 | (cond ((= (car list1) (car list2)) | |
130 | (setcdr prev (cdr list1)) | |
131 | (setq list1 (cdr list1) | |
132 | list2 (cdr list2))) | |
133 | ((< (car list1) (car list2)) | |
134 | (setq prev list1 | |
135 | list1 (cdr list1))) | |
136 | (t | |
137 | (setq list2 (cdr list2))))) | |
138 | (cdr top))) | |
139 | ||
140 | ;;;###autoload | |
eec82323 | 141 | (defun gnus-sorted-complement (list1 list2) |
6748645f | 142 | "Return a list of elements that are in LIST1 or LIST2 but not both. |
eec82323 LMI |
143 | Both lists have to be sorted over <." |
144 | (let (out) | |
145 | (if (or (null list1) (null list2)) | |
146 | (or list1 list2) | |
147 | (while (and list1 list2) | |
148 | (cond ((= (car list1) (car list2)) | |
149 | (setq list1 (cdr list1) | |
150 | list2 (cdr list2))) | |
151 | ((< (car list1) (car list2)) | |
152 | (setq out (cons (car list1) out)) | |
153 | (setq list1 (cdr list1))) | |
154 | (t | |
155 | (setq out (cons (car list2) out)) | |
156 | (setq list2 (cdr list2))))) | |
157 | (nconc (nreverse out) (or list1 list2))))) | |
158 | ||
23f87bed | 159 | ;;;###autoload |
eec82323 LMI |
160 | (defun gnus-intersection (list1 list2) |
161 | (let ((result nil)) | |
162 | (while list2 | |
163 | (when (memq (car list2) list1) | |
164 | (setq result (cons (car list2) result))) | |
165 | (setq list2 (cdr list2))) | |
166 | result)) | |
167 | ||
23f87bed | 168 | ;;;###autoload |
eec82323 | 169 | (defun gnus-sorted-intersection (list1 list2) |
23f87bed MB |
170 | "Return intersection of LIST1 and LIST2. |
171 | LIST1 and LIST2 have to be sorted over <." | |
eec82323 LMI |
172 | (let (out) |
173 | (while (and list1 list2) | |
174 | (cond ((= (car list1) (car list2)) | |
175 | (setq out (cons (car list1) out) | |
176 | list1 (cdr list1) | |
177 | list2 (cdr list2))) | |
178 | ((< (car list1) (car list2)) | |
179 | (setq list1 (cdr list1))) | |
180 | (t | |
181 | (setq list2 (cdr list2))))) | |
182 | (nreverse out))) | |
183 | ||
54506618 MB |
184 | ;;;###autoload |
185 | (defun gnus-sorted-range-intersection (range1 range2) | |
186 | "Return intersection of RANGE1 and RANGE2. | |
187 | RANGE1 and RANGE2 have to be sorted over <." | |
188 | (let* (out | |
189 | (min1 (car range1)) | |
190 | (max1 (if (numberp min1) | |
191 | (if (numberp (cdr range1)) | |
192 | (prog1 (cdr range1) | |
193 | (setq range1 nil)) min1) | |
194 | (prog1 (cdr min1) | |
195 | (setq min1 (car min1))))) | |
196 | (min2 (car range2)) | |
197 | (max2 (if (numberp min2) | |
198 | (if (numberp (cdr range2)) | |
199 | (prog1 (cdr range2) | |
200 | (setq range2 nil)) min2) | |
201 | (prog1 (cdr min2) | |
202 | (setq min2 (car min2)))))) | |
203 | (setq range1 (cdr range1) | |
204 | range2 (cdr range2)) | |
205 | (while (and min1 min2) | |
206 | (cond ((< max1 min2) ; range1 preceeds range2 | |
207 | (setq range1 (cdr range1) | |
208 | min1 nil)) | |
209 | ((< max2 min1) ; range2 preceeds range1 | |
210 | (setq range2 (cdr range2) | |
211 | min2 nil)) | |
212 | (t ; some sort of overlap is occurring | |
213 | (let ((min (max min1 min2)) | |
214 | (max (min max1 max2))) | |
215 | (setq out (if (= min max) | |
216 | (cons min out) | |
217 | (cons (cons min max) out)))) | |
218 | (if (< max1 max2) ; range1 ends before range2 | |
219 | (setq min1 nil) ; incr range1 | |
220 | (setq min2 nil)))) ; incr range2 | |
221 | (unless min1 | |
222 | (setq min1 (car range1) | |
223 | max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1)))) | |
224 | range1 (cdr range1))) | |
225 | (unless min2 | |
226 | (setq min2 (car range2) | |
227 | max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2)))) | |
228 | range2 (cdr range2)))) | |
229 | (cond ((cdr out) | |
230 | (nreverse out)) | |
231 | ((numberp (car out)) | |
232 | out) | |
233 | (t | |
234 | (car out))))) | |
235 | ||
23f87bed MB |
236 | ;;;###autoload |
237 | (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection) | |
238 | ||
239 | ;;;###autoload | |
240 | (defun gnus-sorted-nintersection (list1 list2) | |
241 | "Return intersection of LIST1 and LIST2 by modifying cdr pointers of LIST1. | |
242 | LIST1 and LIST2 have to be sorted over <." | |
eec82323 LMI |
243 | (let* ((top (cons nil list1)) |
244 | (prev top)) | |
245 | (while (and list1 list2) | |
246 | (cond ((= (car list1) (car list2)) | |
247 | (setq prev list1 | |
248 | list1 (cdr list1) | |
249 | list2 (cdr list2))) | |
250 | ((< (car list1) (car list2)) | |
251 | (setcdr prev (cdr list1)) | |
252 | (setq list1 (cdr list1))) | |
253 | (t | |
254 | (setq list2 (cdr list2))))) | |
255 | (setcdr prev nil) | |
256 | (cdr top))) | |
257 | ||
23f87bed MB |
258 | ;;;###autoload |
259 | (defun gnus-sorted-union (list1 list2) | |
260 | "Return union of LIST1 and LIST2. | |
261 | LIST1 and LIST2 have to be sorted over <." | |
262 | (let (out) | |
263 | (while (and list1 list2) | |
264 | (cond ((= (car list1) (car list2)) | |
265 | (setq out (cons (car list1) out) | |
266 | list1 (cdr list1) | |
267 | list2 (cdr list2))) | |
268 | ((< (car list1) (car list2)) | |
269 | (setq out (cons (car list1) out) | |
270 | list1 (cdr list1))) | |
271 | (t | |
272 | (setq out (cons (car list2) out) | |
273 | list2 (cdr list2))))) | |
274 | (while list1 | |
275 | (setq out (cons (car list1) out) | |
276 | list1 (cdr list1))) | |
277 | (while list2 | |
278 | (setq out (cons (car list2) out) | |
279 | list2 (cdr list2))) | |
280 | (nreverse out))) | |
281 | ||
282 | ;;;###autoload | |
283 | (defun gnus-sorted-nunion (list1 list2) | |
284 | "Return union of LIST1 and LIST2 by modifying cdr pointers of LIST1. | |
285 | LIST1 and LIST2 have to be sorted over <." | |
286 | (let* ((top (cons nil list1)) | |
287 | (prev top)) | |
288 | (while (and list1 list2) | |
289 | (cond ((= (car list1) (car list2)) | |
290 | (setq prev list1 | |
291 | list1 (cdr list1) | |
292 | list2 (cdr list2))) | |
293 | ((< (car list1) (car list2)) | |
294 | (setq prev list1 | |
295 | list1 (cdr list1))) | |
296 | (t | |
297 | (setcdr prev (list (car list2))) | |
298 | (setq prev (cdr prev) | |
299 | list2 (cdr list2)) | |
300 | (setcdr prev list1)))) | |
301 | (while list2 | |
302 | (setcdr prev (list (car list2))) | |
303 | (setq prev (cdr prev) | |
304 | list2 (cdr list2))) | |
305 | (cdr top))) | |
306 | ||
eec82323 | 307 | (defun gnus-compress-sequence (numbers &optional always-list) |
01c52d31 | 308 | "Convert sorted list of numbers to a list of ranges or a single range. |
eec82323 LMI |
309 | If ALWAYS-LIST is non-nil, this function will always release a list of |
310 | ranges." | |
311 | (let* ((first (car numbers)) | |
312 | (last (car numbers)) | |
313 | result) | |
314 | (if (null numbers) | |
315 | nil | |
316 | (if (not (listp (cdr numbers))) | |
317 | numbers | |
318 | (while numbers | |
319 | (cond ((= last (car numbers)) nil) ;Omit duplicated number | |
320 | ((= (1+ last) (car numbers)) ;Still in sequence | |
321 | (setq last (car numbers))) | |
322 | (t ;End of one sequence | |
323 | (setq result | |
324 | (cons (if (= first last) first | |
325 | (cons first last)) | |
326 | result)) | |
327 | (setq first (car numbers)) | |
328 | (setq last (car numbers)))) | |
329 | (setq numbers (cdr numbers))) | |
330 | (if (and (not always-list) (null result)) | |
331 | (if (= first last) (list first) (cons first last)) | |
332 | (nreverse (cons (if (= first last) first (cons first last)) | |
333 | result))))))) | |
334 | ||
335 | (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) | |
336 | (defun gnus-uncompress-range (ranges) | |
337 | "Expand a list of ranges into a list of numbers. | |
338 | RANGES is either a single range on the form `(num . num)' or a list of | |
339 | these ranges." | |
340 | (let (first last result) | |
341 | (cond | |
342 | ((null ranges) | |
343 | nil) | |
344 | ((not (listp (cdr ranges))) | |
345 | (setq first (car ranges)) | |
346 | (setq last (cdr ranges)) | |
347 | (while (<= first last) | |
348 | (setq result (cons first result)) | |
349 | (setq first (1+ first))) | |
350 | (nreverse result)) | |
351 | (t | |
352 | (while ranges | |
353 | (if (atom (car ranges)) | |
354 | (when (numberp (car ranges)) | |
355 | (setq result (cons (car ranges) result))) | |
356 | (setq first (caar ranges)) | |
357 | (setq last (cdar ranges)) | |
358 | (while (<= first last) | |
359 | (setq result (cons first result)) | |
360 | (setq first (1+ first)))) | |
361 | (setq ranges (cdr ranges))) | |
362 | (nreverse result))))) | |
363 | ||
364 | (defun gnus-add-to-range (ranges list) | |
365 | "Return a list of ranges that has all articles from both RANGES and LIST. | |
366 | Note: LIST has to be sorted over `<'." | |
367 | (if (not ranges) | |
368 | (gnus-compress-sequence list t) | |
369 | (setq list (copy-sequence list)) | |
370 | (unless (listp (cdr ranges)) | |
371 | (setq ranges (list ranges))) | |
372 | (let ((out ranges) | |
373 | ilist lowest highest temp) | |
374 | (while (and ranges list) | |
375 | (setq ilist list) | |
376 | (setq lowest (or (and (atom (car ranges)) (car ranges)) | |
377 | (caar ranges))) | |
378 | (while (and list (cdr list) (< (cadr list) lowest)) | |
379 | (setq list (cdr list))) | |
380 | (when (< (car ilist) lowest) | |
381 | (setq temp list) | |
382 | (setq list (cdr list)) | |
383 | (setcdr temp nil) | |
384 | (setq out (nconc (gnus-compress-sequence ilist t) out))) | |
385 | (setq highest (or (and (atom (car ranges)) (car ranges)) | |
386 | (cdar ranges))) | |
387 | (while (and list (<= (car list) highest)) | |
388 | (setq list (cdr list))) | |
389 | (setq ranges (cdr ranges))) | |
390 | (when list | |
391 | (setq out (nconc (gnus-compress-sequence list t) out))) | |
392 | (setq out (sort out (lambda (r1 r2) | |
393 | (< (or (and (atom r1) r1) (car r1)) | |
394 | (or (and (atom r2) r2) (car r2)))))) | |
395 | (setq ranges out) | |
396 | (while ranges | |
397 | (if (atom (car ranges)) | |
398 | (when (cdr ranges) | |
399 | (if (atom (cadr ranges)) | |
400 | (when (= (1+ (car ranges)) (cadr ranges)) | |
401 | (setcar ranges (cons (car ranges) | |
402 | (cadr ranges))) | |
403 | (setcdr ranges (cddr ranges))) | |
a8151ef7 | 404 | (when (= (1+ (car ranges)) (caadr ranges)) |
eec82323 LMI |
405 | (setcar (cadr ranges) (car ranges)) |
406 | (setcar ranges (cadr ranges)) | |
407 | (setcdr ranges (cddr ranges))))) | |
408 | (when (cdr ranges) | |
409 | (if (atom (cadr ranges)) | |
410 | (when (= (1+ (cdar ranges)) (cadr ranges)) | |
411 | (setcdr (car ranges) (cadr ranges)) | |
412 | (setcdr ranges (cddr ranges))) | |
a8151ef7 LMI |
413 | (when (= (1+ (cdar ranges)) (caadr ranges)) |
414 | (setcdr (car ranges) (cdadr ranges)) | |
eec82323 LMI |
415 | (setcdr ranges (cddr ranges)))))) |
416 | (setq ranges (cdr ranges))) | |
417 | out))) | |
418 | ||
16409b0b GM |
419 | (defun gnus-remove-from-range (range1 range2) |
420 | "Return a range that has all articles from RANGE2 removed from RANGE1. | |
421 | The returned range is always a list. RANGE2 can also be a unsorted | |
422 | list of articles. RANGE1 is modified by side effects, RANGE2 is not | |
423 | modified." | |
424 | (if (or (null range1) (null range2)) | |
425 | range1 | |
426 | (let (out r1 r2 r1_min r1_max r2_min r2_max | |
427 | (range2 (gnus-copy-sequence range2))) | |
428 | (setq range1 (if (listp (cdr range1)) range1 (list range1)) | |
429 | range2 (sort (if (listp (cdr range2)) range2 (list range2)) | |
430 | (lambda (e1 e2) | |
431 | (< (if (consp e1) (car e1) e1) | |
432 | (if (consp e2) (car e2) e2)))) | |
433 | r1 (car range1) | |
434 | r2 (car range2) | |
435 | r1_min (if (consp r1) (car r1) r1) | |
436 | r1_max (if (consp r1) (cdr r1) r1) | |
437 | r2_min (if (consp r2) (car r2) r2) | |
438 | r2_max (if (consp r2) (cdr r2) r2)) | |
439 | (while (and range1 range2) | |
440 | (cond ((< r2_max r1_min) ; r2 < r1 | |
441 | (pop range2) | |
442 | (setq r2 (car range2) | |
443 | r2_min (if (consp r2) (car r2) r2) | |
444 | r2_max (if (consp r2) (cdr r2) r2))) | |
445 | ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1 | |
446 | (pop range1) | |
447 | (setq r1 (car range1) | |
448 | r1_min (if (consp r1) (car r1) r1) | |
449 | r1_max (if (consp r1) (cdr r1) r1))) | |
450 | ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1 | |
451 | (pop range2) | |
452 | (setq r1_min (1+ r2_max) | |
453 | r2 (car range2) | |
454 | r2_min (if (consp r2) (car r2) r2) | |
455 | r2_max (if (consp r2) (cdr r2) r2))) | |
456 | ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1 | |
457 | (if (eq r1_min (1- r2_min)) | |
458 | (push r1_min out) | |
459 | (push (cons r1_min (1- r2_min)) out)) | |
460 | (pop range2) | |
461 | (if (< r2_max r1_max) ; finished with r1? | |
462 | (setq r1_min (1+ r2_max)) | |
463 | (pop range1) | |
464 | (setq r1 (car range1) | |
465 | r1_min (if (consp r1) (car r1) r1) | |
466 | r1_max (if (consp r1) (cdr r1) r1))) | |
467 | (setq r2 (car range2) | |
468 | r2_min (if (consp r2) (car r2) r2) | |
469 | r2_max (if (consp r2) (cdr r2) r2))) | |
470 | ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1 | |
471 | (if (eq r1_min (1- r2_min)) | |
472 | (push r1_min out) | |
473 | (push (cons r1_min (1- r2_min)) out)) | |
474 | (pop range1) | |
475 | (setq r1 (car range1) | |
476 | r1_min (if (consp r1) (car r1) r1) | |
477 | r1_max (if (consp r1) (cdr r1) r1))) | |
478 | ((< r1_max r2_min) ; r2 > r1 | |
479 | (pop range1) | |
480 | (if (eq r1_min r1_max) | |
481 | (push r1_min out) | |
482 | (push (cons r1_min r1_max) out)) | |
483 | (setq r1 (car range1) | |
484 | r1_min (if (consp r1) (car r1) r1) | |
485 | r1_max (if (consp r1) (cdr r1) r1))))) | |
486 | (when r1 | |
487 | (if (eq r1_min r1_max) | |
488 | (push r1_min out) | |
489 | (push (cons r1_min r1_max) out)) | |
490 | (pop range1)) | |
491 | (while range1 | |
492 | (push (pop range1) out)) | |
493 | (nreverse out)))) | |
eec82323 LMI |
494 | |
495 | (defun gnus-member-of-range (number ranges) | |
496 | (if (not (listp (cdr ranges))) | |
497 | (and (>= number (car ranges)) | |
498 | (<= number (cdr ranges))) | |
499 | (let ((not-stop t)) | |
500 | (while (and ranges | |
501 | (if (numberp (car ranges)) | |
502 | (>= number (car ranges)) | |
503 | (>= number (caar ranges))) | |
504 | not-stop) | |
505 | (when (if (numberp (car ranges)) | |
506 | (= number (car ranges)) | |
507 | (and (>= number (caar ranges)) | |
508 | (<= number (cdar ranges)))) | |
509 | (setq not-stop nil)) | |
510 | (setq ranges (cdr ranges))) | |
511 | (not not-stop)))) | |
512 | ||
23f87bed MB |
513 | (defun gnus-list-range-intersection (list ranges) |
514 | "Return a list of numbers in LIST that are members of RANGES. | |
515 | LIST is a sorted list." | |
516 | (setq ranges (gnus-range-normalize ranges)) | |
517 | (let (number result) | |
518 | (while (setq number (pop list)) | |
519 | (while (and ranges | |
520 | (if (numberp (car ranges)) | |
521 | (< (car ranges) number) | |
522 | (< (cdar ranges) number))) | |
523 | (setq ranges (cdr ranges))) | |
524 | (when (and ranges | |
525 | (if (numberp (car ranges)) | |
526 | (= (car ranges) number) | |
527 | ;; (caar ranges) <= number <= (cdar ranges) | |
528 | (>= number (caar ranges)))) | |
529 | (push number result))) | |
530 | (nreverse result))) | |
531 | ||
532 | (defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference) | |
533 | ||
534 | (defun gnus-list-range-difference (list ranges) | |
535 | "Return a list of numbers in LIST that are not members of RANGES. | |
536 | LIST is a sorted list." | |
537 | (setq ranges (gnus-range-normalize ranges)) | |
538 | (let (number result) | |
539 | (while (setq number (pop list)) | |
540 | (while (and ranges | |
541 | (if (numberp (car ranges)) | |
542 | (< (car ranges) number) | |
543 | (< (cdar ranges) number))) | |
544 | (setq ranges (cdr ranges))) | |
545 | (when (or (not ranges) | |
546 | (if (numberp (car ranges)) | |
547 | (not (= (car ranges) number)) | |
548 | ;; not ((caar ranges) <= number <= (cdar ranges)) | |
549 | (< number (caar ranges)))) | |
550 | (push number result))) | |
551 | (nreverse result))) | |
552 | ||
eec82323 LMI |
553 | (defun gnus-range-length (range) |
554 | "Return the length RANGE would have if uncompressed." | |
23f87bed MB |
555 | (cond |
556 | ((null range) | |
557 | 0) | |
558 | ((not (listp (cdr range))) | |
559 | (- (cdr range) (car range) -1)) | |
560 | (t | |
561 | (let ((sum 0)) | |
562 | (dolist (x range sum) | |
563 | (setq sum | |
564 | (+ sum (if (consp x) (- (cdr x) (car x) -1) 1)))))))) | |
eec82323 LMI |
565 | |
566 | (defun gnus-sublist-p (list sublist) | |
567 | "Test whether all elements in SUBLIST are members of LIST." | |
568 | (let ((sublistp t)) | |
569 | (while sublist | |
570 | (unless (memq (pop sublist) list) | |
571 | (setq sublistp nil | |
572 | sublist nil))) | |
573 | sublistp)) | |
574 | ||
575 | (defun gnus-range-add (range1 range2) | |
16409b0b GM |
576 | "Add RANGE2 to RANGE1 (nondestructively)." |
577 | (unless (listp (cdr range1)) | |
578 | (setq range1 (list range1))) | |
579 | (unless (listp (cdr range2)) | |
580 | (setq range2 (list range2))) | |
581 | (let ((item1 (pop range1)) | |
582 | (item2 (pop range2)) | |
583 | range item selector) | |
584 | (while (or item1 item2) | |
585 | (setq selector | |
a1506d29 | 586 | (cond |
16409b0b GM |
587 | ((null item1) nil) |
588 | ((null item2) t) | |
589 | ((and (numberp item1) (numberp item2)) (< item1 item2)) | |
590 | ((numberp item1) (< item1 (car item2))) | |
591 | ((numberp item2) (< (car item1) item2)) | |
592 | (t (< (car item1) (car item2))))) | |
593 | (setq item | |
594 | (or | |
595 | (let ((tmp1 item) (tmp2 (if selector item1 item2))) | |
a1506d29 | 596 | (cond |
16409b0b GM |
597 | ((null tmp1) tmp2) |
598 | ((null tmp2) tmp1) | |
599 | ((and (numberp tmp1) (numberp tmp2)) | |
a1506d29 | 600 | (cond |
16409b0b GM |
601 | ((eq tmp1 tmp2) tmp1) |
602 | ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2)) | |
603 | ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1)) | |
604 | (t nil))) | |
605 | ((numberp tmp1) | |
a1506d29 | 606 | (cond |
16409b0b GM |
607 | ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2) |
608 | ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2))) | |
609 | ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1)) | |
610 | (t nil))) | |
611 | ((numberp tmp2) | |
a1506d29 | 612 | (cond |
16409b0b GM |
613 | ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1) |
614 | ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1))) | |
615 | ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2)) | |
616 | (t nil))) | |
617 | ((< (1+ (cdr tmp1)) (car tmp2)) nil) | |
618 | ((< (1+ (cdr tmp2)) (car tmp1)) nil) | |
a1506d29 | 619 | (t (cons (min (car tmp1) (car tmp2)) |
16409b0b GM |
620 | (max (cdr tmp1) (cdr tmp2)))))) |
621 | (progn | |
622 | (if item (push item range)) | |
623 | (if selector item1 item2)))) | |
624 | (if selector | |
625 | (setq item1 (pop range1)) | |
626 | (setq item2 (pop range2)))) | |
627 | (if item (push item range)) | |
628 | (reverse range))) | |
eec82323 | 629 | |
23f87bed MB |
630 | ;;;###autoload |
631 | (defun gnus-add-to-sorted-list (list num) | |
632 | "Add NUM into sorted LIST by side effect." | |
633 | (let* ((top (cons nil list)) | |
634 | (prev top)) | |
635 | (while (and list (< (car list) num)) | |
636 | (setq prev list | |
637 | list (cdr list))) | |
638 | (unless (eq (car list) num) | |
639 | (setcdr prev (cons num list))) | |
640 | (cdr top))) | |
641 | ||
54506618 MB |
642 | (defun gnus-range-map (func range) |
643 | "Apply FUNC to each value contained by RANGE." | |
644 | (setq range (gnus-range-normalize range)) | |
645 | (while range | |
646 | (let ((span (pop range))) | |
647 | (if (numberp span) | |
648 | (funcall func span) | |
649 | (let ((first (car span)) | |
650 | (last (cdr span))) | |
651 | (while (<= first last) | |
652 | (funcall func first) | |
653 | (setq first (1+ first)))))))) | |
654 | ||
eec82323 LMI |
655 | (provide 'gnus-range) |
656 | ||
cbee283d | 657 | ;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad |
eec82323 | 658 | ;;; gnus-range.el ends here |