Synch to No Gnus 200510261453.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 75682c0..0ca767f 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2005-10-26  Didier Verna  <didier@xemacs.org>
+
+       * gnus-group.el (gnus-group-compact-group): invalidate original
+       article buffer.
+       * gnus-srvr.el (gnus-server-compact-server): ditto.
+       * nnml.el (nnml-request-compact-group): handle self Xref: field in
+       NOV database and in article itself.
+       Invalidate article backlog.
+
 2005-10-26  Reiner Steib  <Reiner.Steib@gmx.de>
 
        * mm-uu.el (mm-uu-hide-markers): Fix XEmacs case.

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index a34987d..b8eddb2 100644 (file)
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -4390,14 +4390,16 @@ This command may read the active file."
 
 
 ;;;
-;;; Group compaction
+;;; Group compaction. -- dvl
 ;;;
 
 (defun gnus-group-compact-group (group)
   "Conpact the current group.
 Compaction means removing gaps between article numbers.  Hence, this
 operation is only meaningful for back ends using one file per article
-\(e.g. nnml)."
+\(e.g. nnml).
+
+Note: currently only implemented in nnml."
   (interactive (list (gnus-group-group-name)))
   (unless group
     (error "No group to compact"))
@@ -4412,6 +4414,12 @@ Compacting group %s... (this may take a long time)"
            (gnus-error 3 "Couldn't compact group %s" group-decoded)
          (gnus-message 6 "Compacting group %s...done" group-decoded)
          t)
+      ;; Invalidate the "original article" buffer which might be out of date.
+      ;; #### NOTE: Yes, this might be a bit rude, but since compaction
+      ;; #### will not happen very often, I think this is acceptable.
+      (let ((original (get-buffer gnus-original-article-buffer)))
+       (and original (gnus-kill-buffer original)))
+      ;; Update the group line to reflect new information (art number etc).
       (gnus-group-update-group-line))))
 
 (provide 'gnus-group)

diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
index 68362ad..c852285 100644 (file)
--- a/lisp/gnus-srvr.el
+++ b/lisp/gnus-srvr.el
@@ -1017,13 +1017,15 @@ If NUMBER, fetch this number of articles."
 
 
 ;;;
-;;; Server compaction
+;;; Server compaction. -- dvl
 ;;;
 
 ;; #### FIXME: this function currently fails to update the Group buffer's
-;; #### FIXME: appearance. -- dvl
+;; #### appearance.
 (defun gnus-server-compact-server ()
-  "Issue a command to the server to compact all its groups."
+  "Issue a command to the server to compact all its groups.
+
+Note: currently only implemented in nnml."
   (interactive)
   (let ((server (gnus-server-server-name)))
     (unless server
@@ -1038,9 +1040,14 @@ Requesting compaction of %s... (this may take a long time)"
                  server)
     (unless (gnus-open-server server)
       (error "Couldn't open server"))
-    (if (gnus-request-compact server)
-       (gnus-message 5 "Requesting compaction of %s...done" server)
-      (gnus-message 5 "Couldn't compact %s" server))))
+    (if (not (gnus-request-compact server))
+       (gnus-message 5 "Couldn't compact %s" server)
+      (gnus-message 5 "Requesting compaction of %s...done" server)
+      ;; Invalidate the original article buffer which might be out of date.
+      ;; #### NOTE: Yes, this might be a bit rude, but since compaction
+      ;; #### will not happen very often, I think this is acceptable.
+      (let ((original (get-buffer gnus-original-article-buffer)))
+       (and original (gnus-kill-buffer original))))))
 
 (provide 'gnus-srvr)
 

diff --git a/lisp/nnml.el b/lisp/nnml.el
index d5e18fa..ee64cb8 100644 (file)
--- a/lisp/nnml.el
+++ b/lisp/nnml.el
@@ -39,6 +39,7 @@
 (require 'gnus)
 (require 'nnheader)
 (require 'nnmail)
+(require 'gnus-bcklg)
 (require 'nnoo)
 
 (eval-and-compile
@@ -1019,9 +1020,24 @@ Use the nov database for the current group if available."
 
 
 ;;;
-;;; Group and server compaction
+;;; Group and server compaction. -- dvl
 ;;;
 
+;; #### FIXME: this function handles self Xref: entry correctly, but I don't
+;; #### know how to handle external cross-references. I actually don't know if
+;; #### this is handled correctly elsewhere. For instance, what happens if you
+;; #### move all articles to a new group (that's what people do for manual
+;; #### compaction) ?
+
+;; #### NOTE: the function below handles the article backlog. This is
+;; #### conceptually the wrong place to do it because the backend is at a
+;; #### lower level. However, this is the only place where we have the needed
+;; #### information to do the job. Ideally, this function should not handle
+;; #### the backlog by itself, but return a list of moved groups / articles to
+;; #### the caller. This will become important to avoid code duplication when
+;; #### other backends get a compaction feature. Also, note that invalidating
+;; #### the "original article buffer" is already done at an upper level.
+
 (defun nnml-request-compact-group (group &optional server save)
   (nnml-possibly-change-directory group server)
   (unless nnml-article-file-alist
@@ -1045,58 +1061,89 @@ Use the nov database for the current group if available."
          (let ((old-number (car article)))
            (when (> old-number new-number)
              ;; There is a gap here:
-             (setq compacted t)
-             ;; #### NOTE: `nnml-article-to-file' calls
-             ;; #### `nnml-update-file-alist'  (which in turn calls
-             ;; #### `nnml-current-group-article-to-file-alist', which might
-             ;; #### use the NOV database). This might turn out to be
-             ;; #### inefficient. In that case, we will do the work manually.
-             ;; 1/ Move the article to a new file:
-             (let* ((oldfile (nnml-article-to-file old-number))
-                    (newfile
-                     (gnus-replace-in-string
-                      oldfile (concat "\\("
-                                      (int-to-string old-number)
-                                      "\\)\\(\\(\\.gz\\)?\\)$")
-                      (concat (int-to-string new-number) "\\2"))))
-               (with-current-buffer nntp-server-buffer
-                 (nnmail-find-file oldfile)
-                 (nnmail-write-region (point-min) (point-max) newfile))
-               (funcall nnmail-delete-file-function oldfile))
-             ;; 2/ Update all marks for this article:
-             ;; #### NOTE: it is possible that the new article number already
-             ;; #### belongs to a range, whereas the corresponding article
-             ;; #### doesn't exist (for example, if you delete an article).
-             ;; #### For that reason, it is important to update the ranges
-             ;; #### (meaning remove inexistant articles) before doing
-             ;; anything on them.
-             ;; 2 a/ read articles:
-             (let ((read (gnus-info-read info)))
-               (setq read (gnus-remove-from-range read (list new-number)))
-               (when (gnus-member-of-range old-number read)
-                 (setq read (gnus-remove-from-range read (list old-number)))
-                 (setq read (gnus-add-to-range read (list new-number))))
-               (gnus-info-set-read info read))
-             ;; 2 b/ marked articles:
-             (let ((oldmarks (gnus-info-marks info))
-                   mark newmarks)
-               (while (setq mark (pop oldmarks))
-                 (setcdr mark (gnus-remove-from-range (cdr mark)
-                                                      (list new-number)))
-                 (when (gnus-member-of-range old-number (cdr mark))
+             (let ((old-number-string (int-to-string old-number))
+                   (new-number-string (int-to-string new-number)))
+               (setq compacted t)
+               ;; #### NOTE: `nnml-article-to-file' calls
+               ;; #### `nnml-update-file-alist'  (which in turn calls
+               ;; #### `nnml-current-group-article-to-file-alist', which
+               ;; #### might use the NOV database). This might turn out to be
+               ;; #### inefficient. In that case, we will do the work
+               ;; #### manually.
+               ;; 1/ Move the article to a new file:
+               (let* ((oldfile (nnml-article-to-file old-number))
+                      (newfile
+                       (gnus-replace-in-string
+                        oldfile (concat "\\("
+                                        old-number-string
+                                        "\\)\\(\\(\\.gz\\)?\\)$")
+                        (concat new-number-string "\\2"))))
+                 (with-current-buffer nntp-server-buffer
+                   (nnmail-find-file oldfile)
+                   ;; Update the Xref header in the article itself:
+                   (when (and (re-search-forward "^Xref: [^ ]+ " nil t)
+                              (re-search-forward
+                               (concat "\\<"
+                                       (regexp-quote
+                                        (concat group ":" old-number-string))
+                                       "\\>")
+                               (point-at-eol) t))
+                     (replace-match
+                      (concat group ":" new-number-string)))
+                   ;; Save to the new file:
+                   (nnmail-write-region (point-min) (point-max) newfile))
+                 (funcall nnmail-delete-file-function oldfile))
+               ;; 2/ Update all marks for this article:
+               ;; #### NOTE: it is possible that the new article number
+               ;; #### already belongs to a range, whereas the corresponding
+               ;; #### article doesn't exist (for example, if you delete an
+               ;; #### article). For that reason, it is important to update
+               ;; #### the ranges (meaning remove inexistant articles) before
+               ;; #### doing anything on them.
+               ;; 2 a/ read articles:
+               (let ((read (gnus-info-read info)))
+                 (setq read (gnus-remove-from-range read (list new-number)))
+                 (when (gnus-member-of-range old-number read)
+                   (setq read (gnus-remove-from-range read (list old-number)))
+                   (setq read (gnus-add-to-range read (list new-number))))
+                 (gnus-info-set-read info read))
+               ;; 2 b/ marked articles:
+               (let ((oldmarks (gnus-info-marks info))
+                     mark newmarks)
+                 (while (setq mark (pop oldmarks))
                    (setcdr mark (gnus-remove-from-range (cdr mark)
-                                                        (list old-number)))
-                   (setcdr mark (gnus-add-to-range (cdr mark)
-                                                   (list new-number))))
-                 (push mark newmarks))
-               (gnus-info-set-marks info newmarks))
-             ;; 3/ Update the NOV entry for this article:
-             (unless nnml-nov-is-evil
-               (save-excursion
-                 (set-buffer (nnml-open-nov group))
-                 (when (nnheader-find-nov-line old-number)
-                   (looking-at (int-to-string old-number))
-                   (replace-match (int-to-string new-number) nil t)))))
+                                                        (list new-number)))
+                   (when (gnus-member-of-range old-number (cdr mark))
+                     (setcdr mark (gnus-remove-from-range (cdr mark)
+                                                          (list old-number)))
+                     (setcdr mark (gnus-add-to-range (cdr mark)
+                                                     (list new-number))))
+                   (push mark newmarks))
+                 (gnus-info-set-marks info newmarks))
+               ;; 3/ Update the NOV entry for this article:
+               (unless nnml-nov-is-evil
+                 (save-excursion
+                   (set-buffer (nnml-open-nov group))
+                   (when (nnheader-find-nov-line old-number)
+                     ;; Replace the article number:
+                     (looking-at old-number-string)
+                     (replace-match new-number-string nil t)
+                     ;; Update the Xref header:
+                     (when (re-search-forward
+                            (concat "\\(Xref:[^\t\n]* \\)\\<"
+                                    (regexp-quote
+                                     (concat group ":" old-number-string))
+                                    "\\>")
+                            (point-at-eol) t)
+                       (replace-match
+                        (concat "\\1" group ":" new-number-string))))))
+               ;; 4/ Possibly remove the article from the backlog:
+               (when gnus-keep-backlog
+                 ;; #### NOTE: instead of removing the article, we could
+                 ;; #### modify the backlog to reflect the numbering change,
+                 ;; #### but I don't think it's worth it.
+                 (gnus-backlog-remove-article group-full-name old-number)
+                 (gnus-backlog-remove-article group-full-name new-number))))
            (setq new-number (1+ new-number)))))
       (if (not compacted)
          ;; No compaction had to be done: