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