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