/[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.6.6.2 by miles, Thu Sep 9 09:36:25 2004 UTC revision 1.6.6.3 by miles, Fri Oct 22 10:13:32 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, 2001, 2002  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004
4  ;;        Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
5    
6  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
# Line 184  LIST1 and LIST2 have to be sorted over < Line 184  LIST1 and LIST2 have to be sorted over <
184      (nreverse out)))      (nreverse out)))
185    
186  ;;;###autoload  ;;;###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    
238    ;;;###autoload
239  (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)  (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
240    
241  ;;;###autoload  ;;;###autoload
# Line 589  LIST is a sorted list." Line 641  LIST is a sorted list."
641        (setcdr prev (cons num list)))        (setcdr prev (cons num list)))
642      (cdr top)))      (cdr top)))
643    
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    
657  (provide 'gnus-range)  (provide 'gnus-range)
658    
659  ;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad  ;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad

Legend:
Removed from v.1.6.6.2  
changed lines
  Added in v.1.6.6.3

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