(gnus-group-completing-read): Remove all newlines from group names. They mess up...

[gnus] / lisp / gnus-range.el

diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el
index ffe47c1..a4262df 100644 (file)
--- a/lisp/gnus-range.el
+++ b/lisp/gnus-range.el
@@ -1,27 +1,25 @@
 ;;; 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, 2004
-;;        Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008, 2009, 2010 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 2, 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -61,6 +59,36 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
       (setq list2 (cdr list2)))
     list1))
 
       (setq list2 (cdr list2)))
     list1))
 

+(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.
 Both ranges must be in ascending order."
 (defun gnus-range-difference (range1 range2)
   "Return the range of elements in RANGE1 that do not appear in RANGE2.
 Both ranges must be in ascending order."


@@ -189,9 +217,19 @@ 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) min1 (prog1 (cdr min1) (setq min1 (car min1)))))
+         (max1 (if (numberp min1)
+                   (if (numberp (cdr range1))
+                       (prog1 (cdr range1)
+                         (setq range1 nil)) min1)
+                 (prog1 (cdr min1)
+                   (setq min1 (car min1)))))

          (min2 (car range2))
          (min2 (car range2))

-         (max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2))))))
+         (max2 (if (numberp min2)
+                   (if (numberp (cdr range2))
+                       (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)
     (setq range1 (cdr range1)
           range2 (cdr range2))
     (while (and min1 min2)


@@ -218,7 +256,12 @@ RANGE1 and RANGE2 have to be sorted over <."
         (setq min2 (car range2)
               max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2))))
               range2 (cdr range2))))
         (setq min2 (car range2)
               max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2))))
               range2 (cdr range2))))

-    (nreverse out)))
+    (cond ((cdr out)
+        (nreverse out))
+          ((numberp (car out))
+           out)
+          (t
+           (car out)))))

 
 ;;;###autoload
 (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
 
 ;;;###autoload
 (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)


@@ -628,6 +671,7 @@ LIST is a sorted list."
 
 (defun gnus-range-map (func range)
   "Apply FUNC to each value contained by RANGE."
 
 (defun gnus-range-map (func range)
   "Apply FUNC to each value contained by RANGE."

+  (setq range (gnus-range-normalize range))

   (while range
     (let ((span (pop range)))
       (if (numberp span)
   (while range
     (let ((span (pop range)))
       (if (numberp span)