/[emacs]/emacs/lisp/gnus/gnus-range.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-range.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5.18.2 by miles, Tue Oct 14 23:34:50 2003 UTC revision 1.5.18.3 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
1  ;;; gnus-range.el --- range and sequence functions for Gnus  ;;; gnus-range.el --- range and sequence functions for Gnus
2    
3  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
4    ;;        Free Software Foundation, Inc.
5    
6  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7  ;; Keywords: news  ;; Keywords: news
# Line 30  Line 31 
31    
32  ;;; List and range functions  ;;; List and range functions
33    
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    
39  (defun gnus-last-element (list)  (defun gnus-last-element (list)
40    "Return last element of LIST."    "Return last element of LIST."
41    (while (cdr list)    (while (cdr list)
# Line 55  Line 61 
61        (setq list2 (cdr list2)))        (setq list2 (cdr list2)))
62      list1))      list1))
63    
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
143  (defun gnus-sorted-complement (list1 list2)  (defun gnus-sorted-complement (list1 list2)
144    "Return a list of elements that are in LIST1 or LIST2 but not both.    "Return a list of elements that are in LIST1 or LIST2 but not both.
145  Both lists have to be sorted over <."  Both lists have to be sorted over <."
# Line 73  Both lists have to be sorted over <." Line 158  Both lists have to be sorted over <."
158                 (setq list2 (cdr list2)))))                 (setq list2 (cdr list2)))))
159        (nconc (nreverse out) (or list1 list2)))))        (nconc (nreverse out) (or list1 list2)))))
160    
161    ;;;###autoload
162  (defun gnus-intersection (list1 list2)  (defun gnus-intersection (list1 list2)
163    (let ((result nil))    (let ((result nil))
164      (while list2      (while list2
# Line 81  Both lists have to be sorted over <." Line 167  Both lists have to be sorted over <."
167        (setq list2 (cdr list2)))        (setq list2 (cdr list2)))
168      result))      result))
169    
170    ;;;###autoload
171  (defun gnus-sorted-intersection (list1 list2)  (defun gnus-sorted-intersection (list1 list2)
172    ;; LIST1 and LIST2 have to be sorted over <.    "Return intersection of LIST1 and LIST2.
173    LIST1 and LIST2 have to be sorted over <."
174    (let (out)    (let (out)
175      (while (and list1 list2)      (while (and list1 list2)
176        (cond ((= (car list1) (car list2))        (cond ((= (car list1) (car list2))
# Line 95  Both lists have to be sorted over <." Line 183  Both lists have to be sorted over <."
183               (setq list2 (cdr list2)))))               (setq list2 (cdr list2)))))
184      (nreverse out)))      (nreverse out)))
185    
186  (defun gnus-set-sorted-intersection (list1 list2)  ;;;###autoload
187    ;; LIST1 and LIST2 have to be sorted over <.  (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
188    ;; This function modifies LIST1.  
189    ;;;###autoload
190    (defun gnus-sorted-nintersection (list1 list2)
191      "Return intersection of LIST1 and LIST2 by modifying cdr pointers of LIST1.
192    LIST1 and LIST2 have to be sorted over <."
193    (let* ((top (cons nil list1))    (let* ((top (cons nil list1))
194           (prev top))           (prev top))
195      (while (and list1 list2)      (while (and list1 list2)
# Line 113  Both lists have to be sorted over <." Line 205  Both lists have to be sorted over <."
205      (setcdr prev nil)      (setcdr prev nil)
206      (cdr top)))      (cdr top)))
207    
208    ;;;###autoload
209    (defun gnus-sorted-union (list1 list2)
210      "Return union of LIST1 and LIST2.
211    LIST1 and LIST2 have to be sorted over <."
212      (let (out)
213        (while (and list1 list2)
214          (cond ((= (car list1) (car list2))
215                 (setq out (cons (car list1) out)
216                       list1 (cdr list1)
217                       list2 (cdr list2)))
218                ((< (car list1) (car list2))
219                 (setq out (cons (car list1) out)
220                       list1 (cdr list1)))
221                (t
222                 (setq out (cons (car list2) out)
223                       list2 (cdr list2)))))
224        (while list1
225          (setq out (cons (car list1) out)
226                list1 (cdr list1)))
227        (while list2
228          (setq out (cons (car list2) out)
229                list2 (cdr list2)))
230        (nreverse out)))
231    
232    ;;;###autoload
233    (defun gnus-sorted-nunion (list1 list2)
234      "Return union of LIST1 and LIST2 by modifying cdr pointers of LIST1.
235    LIST1 and LIST2 have to be sorted over <."
236      (let* ((top (cons nil list1))
237             (prev top))
238        (while (and list1 list2)
239          (cond ((= (car list1) (car list2))
240                 (setq prev list1
241                       list1 (cdr list1)
242                       list2 (cdr list2)))
243                ((< (car list1) (car list2))
244                 (setq prev list1
245                       list1 (cdr list1)))
246                (t
247                 (setcdr prev (list (car list2)))
248                 (setq prev (cdr prev)
249                       list2 (cdr list2))
250                 (setcdr prev list1))))
251        (while list2
252          (setcdr prev (list (car list2)))
253          (setq prev (cdr prev)
254                list2 (cdr list2)))
255        (cdr top)))
256    
257  (defun gnus-compress-sequence (numbers &optional always-list)  (defun gnus-compress-sequence (numbers &optional always-list)
258    "Convert list of numbers to a list of ranges or a single range.    "Convert list of numbers to a list of ranges or a single range.
259  If ALWAYS-LIST is non-nil, this function will always release a list of  If ALWAYS-LIST is non-nil, this function will always release a list of
# Line 319  modified." Line 460  modified."
460          (setq ranges (cdr ranges)))          (setq ranges (cdr ranges)))
461        (not not-stop))))        (not not-stop))))
462    
463    (defun gnus-list-range-intersection (list ranges)
464      "Return a list of numbers in LIST that are members of RANGES.
465    LIST is a sorted list."
466      (setq ranges (gnus-range-normalize ranges))
467      (let (number result)
468        (while (setq number (pop list))
469          (while (and ranges
470                      (if (numberp (car ranges))
471                          (< (car ranges) number)
472                        (< (cdar ranges) number)))
473            (setq ranges (cdr ranges)))
474          (when (and ranges
475                     (if (numberp (car ranges))
476                          (= (car ranges) number)
477                       ;; (caar ranges) <= number <= (cdar ranges)
478                       (>= number (caar ranges))))
479            (push number result)))
480        (nreverse result)))
481    
482    (defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference)
483    
484    (defun gnus-list-range-difference (list ranges)
485      "Return a list of numbers in LIST that are not members of RANGES.
486    LIST is a sorted list."
487      (setq ranges (gnus-range-normalize ranges))
488      (let (number result)
489        (while (setq number (pop list))
490          (while (and ranges
491                      (if (numberp (car ranges))
492                          (< (car ranges) number)
493                        (< (cdar ranges) number)))
494            (setq ranges (cdr ranges)))
495          (when (or (not ranges)
496                    (if (numberp (car ranges))
497                        (not (= (car ranges) number))
498                      ;; not ((caar ranges) <= number <= (cdar ranges))
499                      (< number (caar ranges))))
500            (push number result)))
501        (nreverse result)))
502    
503  (defun gnus-range-length (range)  (defun gnus-range-length (range)
504    "Return the length RANGE would have if uncompressed."    "Return the length RANGE would have if uncompressed."
505    (length (gnus-uncompress-range range)))    (cond
506       ((null range)
507        0)
508       ((not (listp (cdr range)))
509        (- (cdr range) (car range) -1))
510       (t
511        (let ((sum 0))
512          (dolist (x range sum)
513            (setq sum
514                  (+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
515    
516  (defun gnus-sublist-p (list sublist)  (defun gnus-sublist-p (list sublist)
517    "Test whether all elements in SUBLIST are members of LIST."    "Test whether all elements in SUBLIST are members of LIST."
# Line 387  modified." Line 577  modified."
577      (if item (push item range))      (if item (push item range))
578      (reverse range)))      (reverse range)))
579    
580    ;;;###autoload
581    (defun gnus-add-to-sorted-list (list num)
582      "Add NUM into sorted LIST by side effect."
583      (let* ((top (cons nil list))
584             (prev top))
585        (while (and list (< (car list) num))
586          (setq prev list
587                list (cdr list)))
588        (unless (eq (car list) num)
589          (setcdr prev (cons num list)))
590        (cdr top)))
591    
592  (provide 'gnus-range)  (provide 'gnus-range)
593    
594  ;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad  ;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad

Legend:
Removed from v.1.5.18.2  
changed lines
  Added in v.1.5.18.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26