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