gnus-art.el (gnus-mime-buttonize-attachments-in-header): Improve criterion that finds...

[gnus] / lisp / gnus-range.el

diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el
index 38d4b84..fd06df8 100644 (file)
--- a/lisp/gnus-range.el
+++ b/lisp/gnus-range.el
@@ -1,27 +1,24 @@
 ;;; gnus-range.el --- range and sequence functions for Gnus
 
 ;;; gnus-range.el --- range and sequence functions for Gnus
 

-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2014 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of

-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -55,11 +52,43 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
 
 (defun gnus-set-difference (list1 list2)
   "Return a list of elements of LIST1 that do not appear in LIST2."
 
 (defun gnus-set-difference (list1 list2)
   "Return a list of elements of LIST1 that do not appear in LIST2."

-  (let ((list1 (copy-sequence list1)))
-    (while list2
-      (setq list1 (delq (car list2) list1))
-      (setq list2 (cdr list2)))
-    list1))
+  (let ((hash2 (make-hash-table :test 'eq))
+        (result nil))
+    (dolist (elt list2) (puthash elt t hash2))
+    (dolist (elt list1)
+      (unless (gethash elt hash2)
+        (setq result (cons elt result))))
+    (nreverse result)))
+
+(defun gnus-range-nconcat (&rest ranges)
+  "Return a range comprising all the RANGES, which are pre-sorted.
+RANGES will be destructively altered."
+  (setq ranges (delete nil ranges))
+  (let* ((result (gnus-range-normalize (pop ranges)))
+        (last (last result)))
+    (dolist (range ranges)
+      (setq range (gnus-range-normalize range))
+      ;; Normalize the single-number case, so that we don't need to
+      ;; special-case that so much.
+      (when (numberp (car last))
+       (setcar last (cons (car last) (car last))))
+      (when (numberp (car range))
+       (setcar range (cons (car range) (car range))))
+      (if (= (1+ (cdar last)) (caar range))
+         (progn
+           (setcdr (car last) (cdar range))
+           (setcdr last (cdr range)))
+       (setcdr last range)
+       ;; Denormalize back, since we couldn't join the ranges up.
+       (when (= (caar range) (cdar range))
+         (setcar range (caar range)))
+       (when (= (caar last) (cdar last))
+         (setcar last (caar last))))
+      (setq last (last last)))
+    (if (and (consp (car result))
+            (= (length result) 1))
+       (car result)
+      result)))

 
 (defun gnus-range-difference (range1 range2)
   "Return the range of elements in RANGE1 that do not appear in RANGE2.
 
 (defun gnus-range-difference (range1 range2)
   "Return the range of elements in RANGE1 that do not appear in RANGE2.


@@ -89,10 +118,10 @@ Both ranges must be in ascending order."
                ;; All done with range2
                (setq r nil))
               ((< max1 min2)
                ;; All done with range2
                (setq r nil))
               ((< max1 min2)

-               ;; No overlap: range1 preceeds range2
+               ;; No overlap: range1 precedes range2

                (pop r))
               ((< max2 min1)
                (pop r))
               ((< max2 min1)

-               ;; No overlap: range2 preceeds range1
+               ;; No overlap: range2 precedes range1

                (pop range2))
               ((and (<= min2 min1) (<= max1 max2))
                ;; Complete overlap: range1 removed
                (pop range2))
               ((and (<= min2 min1) (<= max1 max2))
                ;; Complete overlap: range1 removed


@@ -189,7 +218,7 @@ LIST1 and LIST2 have to be sorted over <."
 RANGE1 and RANGE2 have to be sorted over <."
   (let* (out
          (min1 (car range1))
 RANGE1 and RANGE2 have to be sorted over <."
   (let* (out
          (min1 (car range1))

-         (max1 (if (numberp min1) 
+         (max1 (if (numberp min1)

                    (if (numberp (cdr range1))
                        (prog1 (cdr range1)
                          (setq range1 nil)) min1)
                    (if (numberp (cdr range1))
                        (prog1 (cdr range1)
                          (setq range1 nil)) min1)


@@ -198,17 +227,17 @@ RANGE1 and RANGE2 have to be sorted over <."
          (min2 (car range2))
          (max2 (if (numberp min2)
                    (if (numberp (cdr range2))
          (min2 (car range2))
          (max2 (if (numberp min2)
                    (if (numberp (cdr range2))

-                       (prog1 (cdr range2) 
-                         (setq range2 nil)) min2) 
+                       (prog1 (cdr range2)
+                         (setq range2 nil)) min2)

                  (prog1 (cdr min2)
                    (setq min2 (car min2))))))
     (setq range1 (cdr range1)
           range2 (cdr range2))
     (while (and min1 min2)
                  (prog1 (cdr min2)
                    (setq min2 (car min2))))))
     (setq range1 (cdr range1)
           range2 (cdr range2))
     (while (and min1 min2)

-      (cond ((< max1 min2)              ; range1 preceeds range2
+      (cond ((< max1 min2)              ; range1 precedes range2

              (setq range1 (cdr range1)
                    min1 nil))
              (setq range1 (cdr range1)
                    min1 nil))

-            ((< max2 min1)              ; range2 preceeds range1
+            ((< max2 min1)              ; range2 precedes range1

              (setq range2 (cdr range2)
                    min2 nil))
             (t                     ; some sort of overlap is occurring
              (setq range2 (cdr range2)
                    min2 nil))
             (t                     ; some sort of overlap is occurring


@@ -565,15 +594,6 @@ LIST is a sorted list."
        (setq sum
              (+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
 
        (setq sum
              (+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
 

-(defun gnus-sublist-p (list sublist)
-  "Test whether all elements in SUBLIST are members of LIST."
-  (let ((sublistp t))
-    (while sublist
-      (unless (memq (pop sublist) list)
-       (setq sublistp nil
-             sublist nil)))
-    sublistp))
-

 (defun gnus-range-add (range1 range2)
   "Add RANGE2 to RANGE1 (nondestructively)."
   (unless (listp (cdr range1))
 (defun gnus-range-add (range1 range2)
   "Add RANGE2 to RANGE1 (nondestructively)."
   (unless (listp (cdr range1))


@@ -656,5 +676,4 @@ LIST is a sorted list."
 
 (provide 'gnus-range)
 
 
 (provide 'gnus-range)
 

-;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad

 ;;; gnus-range.el ends here
 ;;; gnus-range.el ends here