gnus-sum.el (gnus-move-group-prefix-function): Add, default to
[gnus] / lisp / gnus-sum.el
index 592bd34..fb360fb 100644 (file)
@@ -44,6 +44,7 @@
 (autoload 'gnus-cache-write-active "gnus-cache")
 (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
 (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
+(autoload 'gnus-pick-line-number "gnus-salt" nil t)
 (autoload 'mm-uu-dissect "mm-uu")
 (autoload 'gnus-article-outlook-deuglify-article "deuglify"
   "Deuglify broken Outlook (Express) articles and redisplay."
@@ -421,6 +422,13 @@ this variable specifies group names."
                         (cons :value ("" "") regexp (repeat string))
                         (sexp :value nil))))
 
+(defcustom gnus-move-group-prefix-function 'gnus-group-real-prefix
+  "Function used to compute default prefix for article move/copy/etc prompts.
+The function should take one argument, a group name, and return a
+string with the suggested prefix."
+  :group 'gnus-summary-mail
+  :type 'function)
+
 (defcustom gnus-unread-mark ?           ;Whitespace
   "*Mark used for unread articles."
   :group 'gnus-summary-marks
@@ -1166,7 +1174,6 @@ the normal Gnus MIME machinery."
     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
     (?i gnus-tmp-score ?d)
     (?z gnus-tmp-score-char ?c)
-    (?l (bbb-grouplens-score gnus-tmp-header) ?s)
     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
     (?U gnus-tmp-unread ?c)
     (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
@@ -3984,8 +3991,7 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
   "Translate STRING into something that doesn't contain weird characters."
   (mm-subst-char-in-string
    ?\r ?\-
-   (mm-subst-char-in-string
-    ?\n ?\- string)))
+   (mm-subst-char-in-string ?\n ?\- string t) t))
 
 ;; This function has to be called with point after the article number
 ;; on the beginning of the line.
@@ -4962,23 +4968,20 @@ or a straight list of headers."
                  gnus-list-identifiers))
        changed subject)
     (when regexp
+      (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)"))
       (dolist (header gnus-newsgroup-headers)
        (setq subject (mail-header-subject header)
              changed nil)
-       (while (string-match
-               (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)")
-               subject)
+       (while (string-match regexp subject)
          (setq subject
-               (concat (substring subject 0 (match-beginning 2))
+               (concat (substring subject 0 (match-beginning 1))
                        (substring subject (match-end 0)))
                changed t))
-       (when (and changed
-                  (string-match
-                   "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject))
-         (setq subject
-               (concat (substring subject 0 (match-beginning 1))
-                       (substring subject (match-end 1)))))
        (when changed
+         (when (string-match "^\\(\\(?:R[Ee]: +\\)+\\)R[Ee]: +" subject)
+           (setq subject
+                 (concat (substring subject 0 (match-beginning 1))
+                         (substring subject (match-end 1)))))
          (mail-header-set-subject header subject))))))
 
 (defun gnus-fetch-headers (articles)
@@ -5035,17 +5038,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
             group (gnus-status-message group)))
 
     (when gnus-agent
-      ;; The agent may be storing articles that are no longer in the
-      ;; server's active range.  If that is the case, the active range
-      ;; needs to be expanded such that the agent's articles can be
-      ;; included in the summary.
-      (let* ((gnus-command-method (gnus-find-method-for-group group))
-             (alist (gnus-agent-load-alist group))
-             (active (gnus-active group)))
-        (if (and (car alist)
-                 (< (caar alist) (car active)))
-            (gnus-set-active group (cons (caar alist) (cdr active)))))
-
+      (gnus-agent-possibly-alter-active group (gnus-active group) info)
+      
       (setq gnus-summary-use-undownloaded-faces
            (gnus-agent-find-parameter
             group
@@ -5374,7 +5368,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
         (min (car active))
         (max (cdr active))
         (types gnus-article-mark-lists)
-        marks var articles article mark mark-type)
+        marks var articles article mark mark-type
+         bgn end)
 
     (dolist (marks marked-lists)
       (setq mark (car marks)
@@ -5384,13 +5379,30 @@ If SELECT-ARTICLES, only select those articles from GROUP."
       ;; We set the variable according to the type of the marks list,
       ;; and then adjust the marks to a subset of the active articles.
       (cond
-       ;; Adjust "simple" lists.
+       ;; Adjust "simple" lists - compressed yet unsorted
        ((eq mark-type 'list)
-       (set var (setq articles (gnus-uncompress-range (cdr marks))))
-       (when (memq mark '(tick dormant expire reply save))
-         (while articles
-           (when (or (< (setq article (pop articles)) min) (> article max))
-             (set var (delq article (symbol-value var)))))))
+        ;; Simultaneously uncompress and clip to active range
+        ;; See gnus-uncompress-range for a description of possible marks
+        (let (l lh)
+          (if (not (cadr marks))
+              (set var nil)
+            (setq articles (if (numberp (cddr marks))
+                               (list (cdr marks))
+                             (cdr marks))
+                  lh (cons nil nil)
+                  l lh)
+
+            (while (setq article (pop articles))
+              (cond ((consp article)
+                     (setq bgn (max (car article) min)
+                           end (min (cdr article) max))
+                     (while (<= bgn end)
+                       (setq l (setcdr l (cons bgn nil))
+                             bgn (1+ bgn))))
+                    ((and (<= min article)
+                          (>= max article))
+                     (setq l (setcdr l (cons article nil))))))
+            (set var (cdr lh)))))
        ;; Adjust assocs.
        ((eq mark-type 'tuple)
        (set var (setq articles (cdr marks)))
@@ -6317,15 +6329,15 @@ displayed, no centering will be performed."
        (while read
          (when first
            (while (< first nlast)
-             (push first unread)
-             (setq first (1+ first))))
+             (setq unread (cons first unread)
+                    first (1+ first))))
          (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
          (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
          (setq read (cdr read)))))
     ;; And add the last unread articles.
     (while (<= first last)
-      (push first unread)
-      (setq first (1+ first)))
+      (setq unread (cons first unread)
+            first (1+ first)))
     ;; Return the list of unread articles.
     (delq 0 (nreverse unread))))
 
@@ -6343,6 +6355,44 @@ displayed, no centering will be performed."
           (cdr (assq 'dormant marked)))
          (cdr (assq 'tick marked))))))
 
+;; This function returns a sequence of article numbers based on the
+;; difference between the ranges of read articles in this group and
+;; the range of active articles.
+(defun gnus-sequence-of-unread-articles (group)
+  (let* ((read (gnus-info-read (gnus-get-info group)))
+        (active (or (gnus-active group) (gnus-activate-group group)))
+        (last (cdr active))
+        first nlast unread)
+    ;; If none are read, then all are unread.
+    (if (not read)
+       (setq first (car active))
+      ;; If the range of read articles is a single range, then the
+      ;; first unread article is the article after the last read
+      ;; article.  Sounds logical, doesn't it?
+      (if (and (not (listp (cdr read)))
+              (or (< (car read) (car active))
+                  (progn (setq read (list read))
+                         nil)))
+         (setq first (max (car active) (1+ (cdr read))))
+       ;; `read' is a list of ranges.
+       (when (/= (setq nlast (or (and (numberp (car read)) (car read))
+                                 (caar read)))
+                 1)
+         (setq first (car active)))
+       (while read
+         (when first
+            (push (cons first nlast) unread))
+         (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
+         (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
+         (setq read (cdr read)))))
+    ;; And add the last unread articles.
+    (cond ((< first last)
+           (push (cons first last) unread))
+          ((= first last)
+           (push first unread)))
+    ;; Return the sequence of unread articles.
+    (delq 0 (nreverse unread))))
+
 ;; Various summary commands
 
 (defun gnus-summary-select-article-buffer ()
@@ -7546,10 +7596,9 @@ articles that are younger than AGE days."
        (if (numberp days)
           (progn
             (setq days-got t)
-            (if (< days 0)
-                (progn
-                  (setq younger (not younger))
-                  (setq days (* days -1)))))
+            (when (< days 0)
+              (setq younger (not younger))
+              (setq days (* days -1))))
         (message "Please enter a number.")
         (sleep-for 1)))
      (list days younger)))
@@ -7990,13 +8039,12 @@ fetch-old-headers verbiage, and so on."
            (and gnus-newsgroup-display
                 (not (funcall gnus-newsgroup-display)))
            ;; Check NoCeM things.
-           (if (and gnus-use-nocem
-                    (gnus-nocem-unwanted-article-p
-                     (mail-header-id (car thread))))
-               (progn
-                 (setq gnus-newsgroup-unreads
-                       (delq number gnus-newsgroup-unreads))
-                 t))))
+           (when (and gnus-use-nocem
+                      (gnus-nocem-unwanted-article-p
+                       (mail-header-id (car thread))))
+             (setq gnus-newsgroup-unreads
+                   (delq number gnus-newsgroup-unreads))
+             t)))
          ;; Nope, invisible article.
          0
        ;; Ok, this article is to be visible, so we add it to the limit
@@ -8832,7 +8880,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
   (let ((articles (gnus-summary-work-articles n))
        (prefix (if (gnus-check-backend-function
                     'request-move-article gnus-newsgroup-name)
-                   (gnus-group-real-prefix gnus-newsgroup-name)
+                   (funcall gnus-move-group-prefix-function
+                            gnus-newsgroup-name)
                  ""))
        (names '((move "Move" "Moving")
                 (copy "Copy" "Copying")