From: yamaoka Date: Wed, 26 Oct 2005 21:58:51 +0000 (+0000) Subject: Synch to No Gnus 200510261453. X-Git-Tag: t-gnus-6_17_4-quimby-~276 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=f7c938116d29a27091f29e2fe021a46927e11a63;p=elisp%2Fgnus.git- Synch to No Gnus 200510261453. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 75682c0..0ca767f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2005-10-26 Didier Verna + + * 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 * 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 --- 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 --- 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 --- 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: