1 ;;; gnus-range.el --- range and sequence functions for Gnus
2 ;; Copyright (C) 1996,97 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
28 ;;; List and range functions
30 (defun gnus-last-element (list)
31 "Return last element of LIST."
33 (setq list
(cdr list
)))
36 (defun gnus-copy-sequence (list)
37 "Do a complete, total copy of a list."
40 (if (consp (car list
))
41 (push (gnus-copy-sequence (pop list
)) out
)
42 (push (pop list
) out
)))
44 (nconc (nreverse out
) list
)
47 (defun gnus-set-difference (list1 list2
)
48 "Return a list of elements of LIST1 that do not appear in LIST2."
49 (let ((list1 (copy-sequence list1
)))
51 (setq list1
(delq (car list2
) list1
))
52 (setq list2
(cdr list2
)))
55 (defun gnus-sorted-complement (list1 list2
)
56 "Return a list of elements of LIST1 that do not appear in LIST2.
57 Both lists have to be sorted over <."
59 (if (or (null list1
) (null list2
))
61 (while (and list1 list2
)
62 (cond ((= (car list1
) (car list2
))
63 (setq list1
(cdr list1
)
65 ((< (car list1
) (car list2
))
66 (setq out
(cons (car list1
) out
))
67 (setq list1
(cdr list1
)))
69 (setq out
(cons (car list2
) out
))
70 (setq list2
(cdr list2
)))))
71 (nconc (nreverse out
) (or list1 list2
)))))
73 (defun gnus-intersection (list1 list2
)
76 (when (memq (car list2
) list1
)
77 (setq result
(cons (car list2
) result
)))
78 (setq list2
(cdr list2
)))
81 (defun gnus-sorted-intersection (list1 list2
)
82 ;; LIST1 and LIST2 have to be sorted over <.
84 (while (and list1 list2
)
85 (cond ((= (car list1
) (car list2
))
86 (setq out
(cons (car list1
) out
)
89 ((< (car list1
) (car list2
))
90 (setq list1
(cdr list1
)))
92 (setq list2
(cdr list2
)))))
95 (defun gnus-set-sorted-intersection (list1 list2
)
96 ;; LIST1 and LIST2 have to be sorted over <.
97 ;; This function modifies LIST1.
98 (let* ((top (cons nil list1
))
100 (while (and list1 list2
)
101 (cond ((= (car list1
) (car list2
))
105 ((< (car list1
) (car list2
))
106 (setcdr prev
(cdr list1
))
107 (setq list1
(cdr list1
)))
109 (setq list2
(cdr list2
)))))
113 (defun gnus-compress-sequence (numbers &optional always-list
)
114 "Convert list of numbers to a list of ranges or a single range.
115 If ALWAYS-LIST is non-nil, this function will always release a list of
117 (let* ((first (car numbers
))
122 (if (not (listp (cdr numbers
)))
125 (cond ((= last
(car numbers
)) nil
) ;Omit duplicated number
126 ((= (1+ last
) (car numbers
)) ;Still in sequence
127 (setq last
(car numbers
)))
128 (t ;End of one sequence
130 (cons (if (= first last
) first
133 (setq first
(car numbers
))
134 (setq last
(car numbers
))))
135 (setq numbers
(cdr numbers
)))
136 (if (and (not always-list
) (null result
))
137 (if (= first last
) (list first
) (cons first last
))
138 (nreverse (cons (if (= first last
) first
(cons first last
))
141 (defalias 'gnus-uncompress-sequence
'gnus-uncompress-range
)
142 (defun gnus-uncompress-range (ranges)
143 "Expand a list of ranges into a list of numbers.
144 RANGES is either a single range on the form `(num . num)' or a list of
146 (let (first last result
)
150 ((not (listp (cdr ranges
)))
151 (setq first
(car ranges
))
152 (setq last
(cdr ranges
))
153 (while (<= first last
)
154 (setq result
(cons first result
))
155 (setq first
(1+ first
)))
159 (if (atom (car ranges
))
160 (when (numberp (car ranges
))
161 (setq result
(cons (car ranges
) result
)))
162 (setq first
(caar ranges
))
163 (setq last
(cdar ranges
))
164 (while (<= first last
)
165 (setq result
(cons first result
))
166 (setq first
(1+ first
))))
167 (setq ranges
(cdr ranges
)))
168 (nreverse result
)))))
170 (defun gnus-add-to-range (ranges list
)
171 "Return a list of ranges that has all articles from both RANGES and LIST.
172 Note: LIST has to be sorted over `<'."
174 (gnus-compress-sequence list t
)
175 (setq list
(copy-sequence list
))
176 (unless (listp (cdr ranges
))
177 (setq ranges
(list ranges
)))
179 ilist lowest highest temp
)
180 (while (and ranges list
)
182 (setq lowest
(or (and (atom (car ranges
)) (car ranges
))
184 (while (and list
(cdr list
) (< (cadr list
) lowest
))
185 (setq list
(cdr list
)))
186 (when (< (car ilist
) lowest
)
188 (setq list
(cdr list
))
190 (setq out
(nconc (gnus-compress-sequence ilist t
) out
)))
191 (setq highest
(or (and (atom (car ranges
)) (car ranges
))
193 (while (and list
(<= (car list
) highest
))
194 (setq list
(cdr list
)))
195 (setq ranges
(cdr ranges
)))
197 (setq out
(nconc (gnus-compress-sequence list t
) out
)))
198 (setq out
(sort out
(lambda (r1 r2
)
199 (< (or (and (atom r1
) r1
) (car r1
))
200 (or (and (atom r2
) r2
) (car r2
))))))
203 (if (atom (car ranges
))
205 (if (atom (cadr ranges
))
206 (when (= (1+ (car ranges
)) (cadr ranges
))
207 (setcar ranges
(cons (car ranges
)
209 (setcdr ranges
(cddr ranges
)))
210 (when (= (1+ (car ranges
)) (caadr ranges
))
211 (setcar (cadr ranges
) (car ranges
))
212 (setcar ranges
(cadr ranges
))
213 (setcdr ranges
(cddr ranges
)))))
215 (if (atom (cadr ranges
))
216 (when (= (1+ (cdar ranges
)) (cadr ranges
))
217 (setcdr (car ranges
) (cadr ranges
))
218 (setcdr ranges
(cddr ranges
)))
219 (when (= (1+ (cdar ranges
)) (caadr ranges
))
220 (setcdr (car ranges
) (cdadr ranges
))
221 (setcdr ranges
(cddr ranges
))))))
222 (setq ranges
(cdr ranges
)))
225 (defun gnus-remove-from-range (ranges list
)
226 "Return a list of ranges that has all articles from LIST removed from RANGES.
227 Note: LIST has to be sorted over `<'."
228 ;; !!! This function shouldn't look like this, but I've got a headache.
229 (gnus-compress-sequence
230 (gnus-sorted-complement
231 (gnus-uncompress-range ranges
) list
)))
233 (defun gnus-member-of-range (number ranges
)
234 (if (not (listp (cdr ranges
)))
235 (and (>= number
(car ranges
))
236 (<= number
(cdr ranges
)))
239 (if (numberp (car ranges
))
240 (>= number
(car ranges
))
241 (>= number
(caar ranges
)))
243 (when (if (numberp (car ranges
))
244 (= number
(car ranges
))
245 (and (>= number
(caar ranges
))
246 (<= number
(cdar ranges
))))
248 (setq ranges
(cdr ranges
)))
251 (defun gnus-range-length (range)
252 "Return the length RANGE would have if uncompressed."
253 (length (gnus-uncompress-range range
)))
255 (defun gnus-sublist-p (list sublist
)
256 "Test whether all elements in SUBLIST are members of LIST."
259 (unless (memq (pop sublist
) list
)
264 (defun gnus-range-add (range1 range2
)
265 "Add RANGE2 to RANGE1 destructively."
267 ;; If either are nil, then the job is quite easy.
268 ((or (null range1
) (null range2
))
271 ;; I don't like thinking.
272 (gnus-compress-sequence
275 (gnus-uncompress-range range1
)
276 (gnus-uncompress-range range2
))
279 (provide 'gnus-range
)
281 ;;; gnus-range.el ends here