From 0a919ac2e96918074f11c8740a5acadbec21a676 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 1 Oct 2004 23:38:53 +0000 Subject: [PATCH] Synch to No Gnus 200410012233. --- lisp/ChangeLog | 33 +++++++++++++++++++++++++++++++++ lisp/gnus-agent.el | 32 +++++++++++++++++++++----------- lisp/mm-partial.el | 3 +-- lisp/nnfolder.el | 6 ++---- lisp/nnmail.el | 6 ++---- lisp/nnml.el | 26 ++++++++++---------------- lisp/nnslashdot.el | 8 +++----- lisp/nnsoup.el | 24 ++++++++++-------------- lisp/nnspool.el | 24 ++++++++---------------- lisp/nntp.el | 7 ++----- lisp/nnvirtual.el | 34 ++++++++++++++-------------------- 11 files changed, 106 insertions(+), 97 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 358ecc8..79402f9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,36 @@ +2004-10-02 Jesper Harder + + * mm-partial.el (mm-partial-find-parts): Use with-current-buffer. + + * nnfolder.el (nnfolder-generate-active-file): Use dolist. + + * nnmail.el (nnmail-split-history): do. + + * nnml.el (nnml-generate-nov-databases-1, nnml-request-rename-group) + (nnml-request-delete-group): do. + + * nnslashdot.el (nnslashdot-read-groups): do. + + * nnsoup.el (nnsoup-delete-unreferenced-message-files): do. + (nnsoup-unpack-packets, nnsoup-make-active): Simplify. + + * nnspool.el (nnspool-find-id): Use with-temp-buffer. + (nnspool-sift-nov-with-sed): Use last + (nnspool-retrieve-headers-with-nov): Use mapc. + (nnspool-request-newgroups): Use dolist. + (nnspool-request-group): Use last. + + * nntp.el (nntp-read-server-type): Use dolist. + + * nnvirtual.el (nnvirtual-create-mapping) + (nnvirtual-update-read-and-marked): Use dolist. + (nnvirtual-convert-headers): Simplify. + +2004-10-01 Kevin Greiner + + * gnus-agent.el (gnus-agent-synchronize-group-flags): Added + support for sync'ing tick marks. + 2004-10-01 Katsumi Yamaoka * gnus-sum.el (gnus-summary-toggle-header): Make it work even if diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 8944bff..eddf402 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1238,17 +1238,27 @@ This can be added to `gnus-select-article-hook' or (let ((range (nth 0 action)) (what (nth 1 action)) (marks (nth 2 action))) - (when (memq 'read marks) - (gnus-info-set-read - info - (funcall (if (eq what 'add) - 'gnus-range-add - 'gnus-remove-from-range) - (gnus-info-read info) - range)) - (gnus-get-unread-articles-in-group - info - (gnus-active (gnus-info-group info))))))) + (dolist (mark marks) + (cond ((eq mark 'read) + (gnus-info-set-read + info + (funcall (if (eq what 'add) + 'gnus-range-add + 'gnus-remove-from-range) + (gnus-info-read info) + range)) + (gnus-get-unread-articles-in-group + info + (gnus-active (gnus-info-group info)))) + ((memq mark '(tick)) + (let ((info-marks (assoc mark (gnus-info-marks info)))) + (unless info-marks + (gnus-info-set-marks info (cons (setq info-marks (list mark)) (gnus-info-marks info)))) + (setcdr info-marks (funcall (if (eq what 'add) + 'gnus-range-add + 'gnus-remove-from-range) + (cdr info-marks) + range))))))))) nil)) (defun gnus-agent-save-active (method) diff --git a/lisp/mm-partial.el b/lisp/mm-partial.el index 7a4cd0b..ab84d4b 100644 --- a/lisp/mm-partial.el +++ b/lisp/mm-partial.el @@ -32,8 +32,7 @@ (require 'mm-decode) (defun mm-partial-find-parts (id &optional art) - (let ((headers (save-excursion - (set-buffer gnus-summary-buffer) + (let ((headers (with-current-buffer gnus-summary-buffer gnus-newsgroup-headers)) phandles header) (while (setq header (pop headers)) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index cad461a..e810732 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -1028,9 +1028,7 @@ This command does not work if you use short group names." (when (not (message-mail-file-mbox-p file)) (ignore-errors (delete-file file))))) - (let ((files (directory-files nnfolder-directory)) - file) - (while (setq file (pop files)) + (dolist (file (directory-files nnfolder-directory)) (when (and (not (backup-file-name-p file)) (message-mail-file-mbox-p (nnheader-concat nnfolder-directory file))) @@ -1045,7 +1043,7 @@ This command does not work if you use short group names." (nnfolder-possibly-change-folder file) (nnfolder-possibly-change-group file) (nnfolder-close-group file)))) - (nnheader-message 5 ""))) + (nnheader-message 5 "")) (defun nnfolder-group-pathname (group) "Make file name for GROUP." diff --git a/lisp/nnmail.el b/lisp/nnmail.el index c3b5304..5a1cd65 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1963,14 +1963,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (with-output-to-temp-buffer "*nnmail split history*" (with-current-buffer standard-output (fundamental-mode)) ; for Emacs 20.4+ - (let ((history nnmail-split-history) - elem) - (while (setq elem (pop history)) + (dolist (elem nnmail-split-history) (princ (mapconcat (lambda (ga) (concat (car ga) ":" (int-to-string (cdr ga)))) elem ", ")) - (princ "\n"))))) + (princ "\n")))) (defun nnmail-purge-split-history (group) "Remove all instances of GROUP from `nnmail-split-history'." diff --git a/lisp/nnml.el b/lisp/nnml.el index 7b6713f..f4dd98c 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -446,10 +446,8 @@ marks file will be regenerated properly by Gnus.") nnml-current-directory t (concat nnheader-numerical-short-files "\\|" (regexp-quote nnml-nov-file-name) "$" - "\\|" (regexp-quote nnml-marks-file-name) "$"))) - article) - (while articles - (setq article (pop articles)) + "\\|" (regexp-quote nnml-marks-file-name) "$")))) + (dolist (article articles) (when (file-writable-p article) (nnheader-message 5 "Deleting article %s in %s..." article group) (funcall nnmail-delete-file-function article)))) @@ -474,12 +472,10 @@ marks file will be regenerated properly by Gnus.") ;; We move the articles file by file instead of renaming ;; the directory -- there may be subgroups in this group. ;; One might be more clever, I guess. - (let ((files (nnheader-article-to-file-alist old-dir))) - (while files - (rename-file - (concat old-dir (cdar files)) - (concat new-dir (cdar files))) - (pop files))) + (dolist (file (nnheader-article-to-file-alist old-dir)) + (rename-file + (concat old-dir (cdr file)) + (concat new-dir (cdr file)))) ;; Move .overview file. (let ((overview (concat old-dir nnml-nov-file-name))) (when (file-exists-p overview) @@ -771,12 +767,10 @@ marks file will be regenerated properly by Gnus.") (unless (member (file-truename dir) seen) (push (file-truename dir) seen) ;; We descend recursively - (let ((dirs (directory-files dir t nil t)) - dir) - (while (setq dir (pop dirs)) - (when (and (not (string-match "^\\." (file-name-nondirectory dir))) - (file-directory-p dir)) - (nnml-generate-nov-databases-1 dir seen)))) + (dolist (dir (directory-files dir t nil t)) + (when (and (not (string-match "^\\." (file-name-nondirectory dir))) + (file-directory-p dir)) + (nnml-generate-nov-databases-1 dir seen))) ;; Do this directory. (let ((files (sort (nnheader-article-to-file-alist dir) 'car-less-than-car))) diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index f871beb..5a14581 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -468,11 +468,9 @@ (insert-file-contents file) (goto-char (point-min)) (setq nnslashdot-groups (read (current-buffer)))) - (if (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5)) - (let ((groups nnslashdot-groups)) - (while groups - (nnslashdot-make-tuple (car groups) 5) - (setq groups (cdr groups)))))))) + (when (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5)) + (dolist (group nnslashdot-groups) + (nnslashdot-make-tuple group 5)))))) (defun nnslashdot-write-groups () (with-temp-file (expand-file-name "groups" nnslashdot-directory) diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index d39c999..ed457ea 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -557,9 +557,8 @@ backend for the messages.") (defun nnsoup-unpack-packets () "Unpack all packets in `nnsoup-packet-directory'." (let ((packets (directory-files - nnsoup-packet-directory t nnsoup-packet-regexp)) - packet) - (while (setq packet (pop packets)) + nnsoup-packet-directory t nnsoup-packet-regexp))) + (dolist (packet packets) (nnheader-message 5 "nnsoup: unpacking %s..." packet) (if (not (gnus-soup-unpack-packet nnsoup-tmp-directory nnsoup-unpacker packet)) @@ -758,20 +757,18 @@ backend for the messages.") (string-to-int (match-string 1 f2))))))) active group lines ident elem min) (set-buffer (get-buffer-create " *nnsoup work*")) - (while files - (nnheader-message 5 "Doing %s..." (car files)) + (dolist (file files) + (nnheader-message 5 "Doing %s..." file) (erase-buffer) - (nnheader-insert-file-contents (car files)) + (nnheader-insert-file-contents file) (goto-char (point-min)) (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t)) (setq group "unknown") (setq group (match-string 2))) (setq lines (count-lines (point-min) (point-max))) (setq ident (progn (string-match - "/\\([0-9]+\\)\\." (car files)) - (substring - (car files) (match-beginning 1) - (match-end 1)))) + "/\\([0-9]+\\)\\." file) + (match-string 1 file))) (if (not (setq elem (assoc group active))) (push (list group (cons 1 lines) (list (cons 1 lines) @@ -782,8 +779,7 @@ backend for the messages.") (list (cons (1+ (setq min (cdadr elem))) (+ min lines)) (vector ident group "ucm" "" lines)))) - (setcdr (cadr elem) (+ min lines))) - (setq files (cdr files))) + (setcdr (cadr elem) (+ min lines)))) (nnheader-message 5 "") (setq nnsoup-group-alist active) (nnsoup-write-active-file t))) @@ -800,9 +796,9 @@ backend for the messages.") nnsoup-group-alist))) (regexp "\\.MSG$\\|\\.IDX$") (files (directory-files nnsoup-directory nil regexp)) - non-files file) + non-files) ;; Find all files that aren't known by nnsoup. - (while (setq file (pop files)) + (dolist (file files) (string-match regexp file) (unless (member (substring file 0 (match-beginning 0)) known) (push file non-files))) diff --git a/lisp/nnspool.el b/lisp/nnspool.el index 94fccc7..c949b40 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -248,8 +248,7 @@ there.") (if dir (nnheader-insert "211 %d %d %d %s\n" (length dir) (car dir) - (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) - group) + (car (last dir)) group) (nnheader-report 'nnspool "Empty group %s" group) (nnheader-insert "211 0 0 0 %s\n" group)))))) @@ -308,9 +307,8 @@ there.") groups) (zerop (forward-line -1)))) (erase-buffer) - (while groups - (insert (car groups) " 0 0 y\n") - (setq groups (cdr groups)))) + (dolist (group groups) + (insert group " 0 0 y\n"))) t) nil)) @@ -397,8 +395,7 @@ there.") (<= last (car arts))) (pop arts)) ;; The articles in `arts' are missing from the buffer. - (while arts - (nnspool-insert-nov-head (pop arts))) + (mapc 'nnspool-insert-nov-head arts) t)))))))))) (defun nnspool-insert-nov-head (article) @@ -418,8 +415,7 @@ there.") (defun nnspool-sift-nov-with-sed (articles file) (let ((first (car articles)) - (last (progn (while (cdr articles) (setq articles (cdr articles))) - (car articles)))) + (last (car (last articles)))) (call-process "awk" nil t nil (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" (1- first) (1+ last)) @@ -428,16 +424,12 @@ there.") ;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). ;; Find out what group an article identified by a Message-ID is in. (defun nnspool-find-id (id) - (save-excursion - (set-buffer (get-buffer-create " *nnspool work*")) - (erase-buffer) + (with-temp-buffer (ignore-errors (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file)) (goto-char (point-min)) - (prog1 - (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") - (cons (match-string 1) (string-to-int (match-string 2)))) - (kill-buffer (current-buffer))))) + (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") + (cons (match-string 1) (string-to-int (match-string 2)))))) (defun nnspool-find-file (file) "Insert FILE in server buffer safely." diff --git a/lisp/nntp.el b/lisp/nntp.el index bdaa7b6..f8bd011 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1317,12 +1317,9 @@ password contained in '~/.nntp-authinfo'." "Find out what the name of the server we have connected to is." ;; Wait for the status string to arrive. (setq nntp-server-type (buffer-string)) - (let ((alist nntp-server-action-alist) - (case-fold-search t) - entry) + (let ((case-fold-search t)) ;; Run server-specific commands. - (while alist - (setq entry (pop alist)) + (dolist (entry nntp-server-action-alist) (when (string-match (car entry) nntp-server-type) (if (and (listp (cadr entry)) (not (eq 'lambda (caadr entry)))) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index adb28ca..8fabe99 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -384,14 +384,11 @@ component group will show up when you enter the virtual group.") (defun nnvirtual-convert-headers () "Convert HEAD headers into NOV headers." - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (let* ((dependencies (make-vector 100 0)) - (headers (gnus-get-newsgroup-headers dependencies)) - header) + (headers (gnus-get-newsgroup-headers dependencies))) (erase-buffer) - (while (setq header (pop headers)) - (nnheader-insert-nov header))))) + (mapc 'nnheader-insert-nov headers)))) (defun nnvirtual-update-xref-header (group article prefix system-name) @@ -465,7 +462,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." (nnvirtual-partition-sequence (cdr ml))))) (gnus-info-marks (gnus-get-info (nnvirtual-current-group)))))) - mark type groups carticles info entry) + type groups info) ;; Ok, atomically move all of the (un)read info, clear any old ;; marks, and move all of the current marks. This way if someone @@ -474,13 +471,12 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." ;; move (un)read ;; bind for workaround guns-update-read-articles (let ((gnus-newsgroup-active nil)) - (while (setq entry (pop unreads)) + (dolist (entry unreads) (gnus-update-read-articles (car entry) (cdr entry)))) ;; clear all existing marks on the component groups - (setq groups nnvirtual-component-groups) - (while groups - (when (and (setq info (gnus-get-info (pop groups))) + (dolist (group nnvirtual-component-groups) + (when (and (setq info (gnus-get-info group)) (gnus-info-marks info)) (gnus-info-set-marks info @@ -491,18 +487,17 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." ;; Ok, currently type-marks is an assq list with keys of a mark type, ;; with data of an assq list with keys of component group names ;; and the articles which correspond to that key/group pair. - (while (setq mark (pop type-marks)) + (dolist (mark type-marks) (setq type (car mark)) (setq groups (cdr mark)) - (while (setq carticles (pop groups)) + (dolist (carticles groups) (gnus-add-marked-articles (car carticles) type (cdr carticles) nil t)))) ;; possibly update the display, it is really slow (when update-p - (setq groups nnvirtual-component-groups) - (while groups - (gnus-group-update-group (pop groups) t)))))) + (dolist (group nnvirtual-component-groups) + (gnus-group-update-group group t)))))) (defun nnvirtual-current-group () @@ -784,10 +779,9 @@ based on the marks on the component groups." ;; Remove any empty marks lists, and store. (setq nnvirtual-mapping-marks nil) - (while marks - (if (cdr (car marks)) - (push (car marks) nnvirtual-mapping-marks)) - (setq marks (cdr marks))) + (dolist (mark marks) + (when (cdr mark) + (push mark nnvirtual-mapping-marks))) ;; We need to convert the unreads to reads. We compress the ;; sequence as we go, otherwise it could be huge. -- 1.7.10.4