From: yamaoka Date: Sat, 25 Jan 2003 03:04:56 +0000 (+0000) Subject: Synch with Oort Gnus. X-Git-Tag: t-gnus-6_15_16-00-quimby~28 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=0439a20f09d49db0d084de45288be2a0b974bed2;p=elisp%2Fgnus.git- Synch with Oort Gnus. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 04df742..aa854b4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,39 @@ +2003-01-25 Jesper Harder + + * gnus-art.el (gnus-article-setup-buffer): Reset + gnus-button-marker-list. + +2003-01-25 Lars Magne Ingebrigtsen + + * nntp.el (nntp-read-timeout): Default to using a second delay + under Microsoft Windows. + +2003-01-24 Lars Magne Ingebrigtsen + + * nnheader.el (nnheader-directory-separator-character): New + variable. + +2003-01-24 Kai Gro,A_(Bjohann + + * gnus-agent.el (gnus-agent-max-fetch-size) + (gnus-agent-article-alist, gnus-agent-get-undownloaded-list) + (gnus-agent-catchup, gnus-agent-summary-fetch-group) + (gnus-agent-fetch-articles, gnus-agent-backup-overview-buffer) + (gnus-agent-flush-cache, gnus-agent-fetch-headers) + (gnus-agent-braid-nov, gnus-agent-load-alist) + (gnus-agent-article-alist-save-format) + (gnus-agent-read-agentview, gnus-agent-save-alist) + (gnus-agent-fetch-group-1, gnus-agent-expire) + (gnus-agent-uncached-articles, gnus-agent-retrieve-headers) + (gnus-agent-regenerate-group): Reformat to keep under eighty + columns. Reword docstrings so that first line is under eighty + chars and a complete sentence. Still need to work on the rear + end of the file, in particular gnus-agent-expire. + 2003-01-24 Lars Magne Ingebrigtsen + * gnus-agent.el (gnus-agentize): Indent. + * gnus.el (gnus-version-number): Bumped. 2003-01-24 20:32:44 Lars Magne Ingebrigtsen diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 69ac0c1..94b1c3f 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -154,7 +154,9 @@ If this is `ask' the hook will query the user." :group 'gnus-agent) (defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb - "gnus-agent-fetch-session is required to split its article fetches into chunks smaller than this limit." + "Chunk size for `gnus-agent-fetch-session'. +The function will split its article fetches into chunks smaller than +this limit." :group 'gnus-agent :type 'integer) @@ -164,16 +166,15 @@ If this is `ask' the hook will query the user." (defvar gnus-agent-buffer-alist nil) (defvar gnus-agent-article-alist nil "An assoc list identifying the articles whose headers have been fetched. - If successfully fetched, these headers will be stored in the group's overview file. - The key of each assoc pair is the article ID. - The value of each assoc pair is a flag indicating - whether the identified article has been downloaded (gnus-agent-fetch-articles - sets the value to the day of the download). - NOTES: - 1) The last element of this list can not be expired as some - routines (for example, get-agent-fetch-headers) use the last - value to track which articles have had their headers retrieved. - 2) The gnus-agent-regenerate may destructively modify the value. +If successfully fetched, these headers will be stored in the group's overview +file. The key of each assoc pair is the article ID, the value of each assoc +pair is a flag indicating whether the identified article has been downloaded +\(gnus-agent-fetch-articles sets the value to the day of the download). +NOTES: +1) The last element of this list can not be expired as some + routines (for example, get-agent-fetch-headers) use the last + value to track which articles have had their headers retrieved. +2) The gnus-agent-regenerate may destructively modify the value. ") (defvar gnus-agent-group-alist nil) (defvar gnus-category-alist nil) @@ -451,10 +452,11 @@ minor mode in all Gnus buffers." (gnus-open-agent) (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup) (unless gnus-agent-send-mail-function - (setq gnus-agent-send-mail-function (or - message-send-mail-real-function - message-send-mail-function) + (setq gnus-agent-send-mail-function + (or message-send-mail-real-function + message-send-mail-function) message-send-mail-real-function 'gnus-agent-send-mail)) + (unless gnus-agent-covered-methods (mapcar (lambda (server) @@ -772,9 +774,11 @@ article's mark is toggled." (let ((a (caar alist)) (h (mail-header-number (car headers)))) (cond ((< a h) - (pop alist)) ; ignore IDs in the alist that are not being displayed in the summary + ;; Ignore IDs in the alist that are not being + ;; displayed in the summary. + (pop alist)) ((> a h) - ;; headers that are not in the alist should be + ;; Headers that are not in the alist should be ;; fictious (see nnagent-retrieve-headers); they ;; imply that this article isn't in the agent. (gnus-agent-append-to-list tail-undownloaded h) @@ -799,13 +803,19 @@ article's mark is toggled." gnus-newsgroup-unfetched (cdr unfetched)))))) (defun gnus-agent-catchup () - "Mark all articles as read that are neither cached, downloaded, nor downloadable." + "Mark as read all unhandled articles. +An article is unhandled if it is neither cached, nor downloaded, nor +downloadable." (interactive) (save-excursion (let ((articles gnus-newsgroup-undownloaded)) (when (or gnus-newsgroup-downloadable gnus-newsgroup-cached) - (setq articles (gnus-sorted-ndifference (gnus-sorted-ndifference (copy-sequence articles) gnus-newsgroup-downloadable) gnus-newsgroup-cached))) + (setq articles (gnus-sorted-ndifference + (gnus-sorted-ndifference + (copy-sequence articles) + gnus-newsgroup-downloadable) + gnus-newsgroup-cached))) (while articles (gnus-summary-mark-article @@ -817,7 +827,8 @@ article's mark is toggled." (when gnus-newsgroup-processable (setq gnus-newsgroup-downloadable (let* ((dl gnus-newsgroup-downloadable) - (gnus-newsgroup-downloadable (sort (copy-sequence gnus-newsgroup-processable) '<)) + (gnus-newsgroup-downloadable + (sort (copy-sequence gnus-newsgroup-processable) '<)) (fetched-articles (gnus-agent-summary-fetch-group))) ;; The preceeding call to (gnus-agent-summary-fetch-group) ;; updated gnus-newsgroup-downloadable to remove each @@ -849,8 +860,11 @@ Optional arg ALL, if non-nil, means to fetch all articles." (error "No articles to download")) (gnus-agent-with-fetch (setq gnus-newsgroup-undownloaded - (gnus-sorted-ndifference gnus-newsgroup-undownloaded - (setq fetched-articles (gnus-agent-fetch-articles gnus-newsgroup-name articles))))) + (gnus-sorted-ndifference + gnus-newsgroup-undownloaded + (setq fetched-articles + (gnus-agent-fetch-articles + gnus-newsgroup-name articles))))) (save-excursion (dolist (article articles) @@ -1041,9 +1055,11 @@ This can be added to `gnus-select-article-hook' or ;; new one. I do this after adding the article as I want at ;; least one article in each set. (when (< gnus-agent-max-fetch-size - (setq current-set-size (+ current-set-size (if (= header-number article) - (mail-header-chars (car headers)) - 0)))) + (setq current-set-size + (+ current-set-size + (if (= header-number article) + (mail-header-chars (car headers)) + 0)))) (setcar selected-sets (nreverse (car selected-sets))) (setq selected-sets (cons nil selected-sets) current-set-size 0)))) @@ -1081,7 +1097,8 @@ This can be added to `gnus-select-article-hook' or (goto-char (point-max)) (push (cons article (point)) pos) (insert-buffer-substring nntp-server-buffer))) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) + (copy-to-buffer + nntp-server-buffer (point-min) (point-max)) (setq pos (nreverse pos))))) ;; Then save these articles into the Agent. (save-excursion @@ -1100,8 +1117,9 @@ This can be added to `gnus-select-article-hook' or (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *") (push (cons (buffer-substring (match-beginning 1) (match-end 1)) - (string-to-int (buffer-substring (match-beginning 2) - (match-end 2)))) + (string-to-int + (buffer-substring (match-beginning 2) + (match-end 2)))) crosses) (goto-char (match-end 0))) (gnus-agent-crosspost crosses (caar pos) date))) @@ -1109,12 +1127,14 @@ This can be added to `gnus-select-article-hook' or (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t)) (setq id "No-Message-ID-in-article") - (setq id (buffer-substring (match-beginning 1) (match-end 1)))) + (setq id (buffer-substring + (match-beginning 1) (match-end 1)))) (write-region-as-coding-system gnus-agent-file-coding-system (point-min) (point-max) (concat dir (number-to-string (caar pos))) nil 'silent) - (gnus-agent-append-to-list tail-fetched-articles (caar pos))) + (gnus-agent-append-to-list + tail-fetched-articles (caar pos))) (widen) (pop pos)))) @@ -1156,11 +1176,11 @@ This can be added to `gnus-select-article-hook' or (let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name)) (cnt 0) name) - (while (file-exists-p (setq name (concat root "~" (int-to-string (setq cnt (1+ cnt))) "~")))) + (while (file-exists-p + (setq name (concat root "~" + (int-to-string (setq cnt (1+ cnt))) "~")))) (write-region (point-min) (point-max) name nil 'no-msg) - (gnus-message 1 "Created backup copy of overview in %s." name) - ) - ) + (gnus-message 1 "Created backup copy of overview in %s." name))) t) (defun gnus-agent-check-overview-buffer (&optional buffer) @@ -1219,7 +1239,8 @@ and that there are no duplicates." nil 'silent) (pop gnus-agent-buffer-alist)) (while gnus-agent-group-alist - (with-temp-file (gnus-agent-article-name ".agentview" (caar gnus-agent-group-alist)) + (with-temp-file (gnus-agent-article-name + ".agentview" (caar gnus-agent-group-alist)) (princ (cdar gnus-agent-group-alist)) (insert "\n") (princ 1 (current-buffer)) @@ -1261,34 +1282,43 @@ article numbers will be returned." (setq articles (gnus-range-add articles (cdr arts))))) (setq articles (sort (gnus-uncompress-sequence articles) '<))) - ;; At this point, I have the list of articles to consider for fetching. - ;; This is the list that I'll return to my caller. Some of these articles may have already - ;; been fetched. That's OK as the fetch article code will filter those out. - ;; Internally, I'll filter this list to just those articles whose headers need to be fetched. + ;; At this point, I have the list of articles to consider for + ;; fetching. This is the list that I'll return to my caller. Some + ;; of these articles may have already been fetched. That's OK as + ;; the fetch article code will filter those out. Internally, I'll + ;; filter this list to just those articles whose headers need to + ;; be fetched. (let ((articles articles)) ;; Remove known articles. (when (gnus-agent-load-alist group) ;; Remove articles marked as downloaded. (if fetch-all - ;; I want to fetch all headers in the active range. - ;; Therefore, exclude only those headers that are in the article alist. - ;; NOTE: This is probably NOT what I want to do after agent expiration in this group. + ;; I want to fetch all headers in the active range. + ;; Therefore, exclude only those headers that are in the + ;; article alist. + ;; NOTE: This is probably NOT what I want to do after + ;; agent expiration in this group. (setq articles (gnus-agent-uncached-articles articles group)) - ;; I want to only fetch those headers that have never been fetched. - ;; Therefore, exclude all headers that are, or WERE, in the article alist. + ;; I want to only fetch those headers that have never been + ;; fetched. Therefore, exclude all headers that are, or + ;; WERE, in the article alist. (let ((low (1+ (caar (last gnus-agent-article-alist)))) (high (cdr (gnus-active group)))) - ;; Low can be greater than High when the same group is fetched twice - ;; in the same session {The first fetch will fill the article alist - ;; such that (last gnus-agent-article-alist) equals (cdr (gnus-active group))}. - ;; The addition of one(the 1+ above) then forces Low to be greater than High. - ;; When this happens, gnus-list-range-intersection returns nil which indicates - ;; that no headers need to be fetched. -- Kevin + ;; Low can be greater than High when the same group is + ;; fetched twice in the same session {The first fetch will + ;; fill the article alist such that (last + ;; gnus-agent-article-alist) equals (cdr (gnus-active + ;; group))}. The addition of one(the 1+ above) then + ;; forces Low to be greater than High. When this happens, + ;; gnus-list-range-intersection returns nil which + ;; indicates that no headers need to be fetched. -- Kevin (setq articles (gnus-list-range-intersection articles (list (cons low high))))))) - (gnus-message 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" (gnus-compress-sequence articles t)) + (gnus-message + 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" + (gnus-compress-sequence articles t)) (save-excursion (set-buffer nntp-server-buffer) @@ -1304,9 +1334,11 @@ article numbers will be returned." (unless (eq 'nov (gnus-retrieve-headers articles group)) (nnvirtual-convert-headers)) (gnus-agent-check-overview-buffer) - ;; Move these headers to the overview buffer so that gnus-agent-braid-nov can merge them - ;; with the contents of FILE. - (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) + ;; Move these headers to the overview buffer so that + ;; gnus-agent-braid-nov can merge them with the contents + ;; of FILE. + (copy-to-buffer + gnus-agent-overview-buffer (point-min) (point-max)) (when (file-exists-p file) (gnus-agent-braid-nov group articles file)) (gnus-agent-check-overview-buffer) @@ -1337,8 +1369,9 @@ article numbers will be returned." (insert-buffer-substring gnus-agent-overview-buffer b e)))) (defun gnus-agent-braid-nov (group articles file) - "Merges the article headers identified by ARTICLES from gnus-agent-overview-buffer with the contents -of FILE placing the combined headers in nntp-server-buffer." + "Merge agent overview data with given file. +Takes headers for ARTICLES from `gnus-agent-overview-buffer' and the given +FILE and places the combined headers into `nntp-server-buffer'." (let (start last) (set-buffer gnus-agent-overview-buffer) (goto-char (point-min)) @@ -1349,7 +1382,8 @@ of FILE placing the combined headers in nntp-server-buffer." (forward-line -1) (unless (looking-at "[0-9]+\t") ;; Remove corrupted lines - (gnus-message 1 "Overview %s is corrupted. Removing corrupted lines..." file) + (gnus-message + 1 "Overview %s is corrupted. Removing corrupted lines..." file) (goto-char (point-min)) (while (not (eobp)) (if (looking-at "[0-9]+\t") @@ -1372,7 +1406,8 @@ of FILE placing the combined headers in nntp-server-buffer." t) ((= art (car articles)) (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point))) + (delete-region + (point) (progn (forward-line 1) (point))) nil) (t (beginning-of-line) @@ -1394,19 +1429,24 @@ of FILE placing the combined headers in nntp-server-buffer." (set-buffer nntp-server-buffer)) (insert-buffer-substring gnus-agent-overview-buffer start)))) -(eval-when-compile ; Keeps the compiler from warning about the free variable in gnus-agent-read-agentview +;; Keeps the compiler from warning about the free variable in +;; gnus-agent-read-agentview. +(eval-when-compile (defvar gnus-agent-read-agentview)) (defun gnus-agent-load-alist (group) - (let ((gnus-agent-read-agentview group)) ; Binds free variable that's used in gnus-agent-read-agentview - "Load the article-state alist for GROUP." + "Load the article-state alist for GROUP." + ;; Bind free variable that's used in `gnus-agent-read-agentview'. + (let ((gnus-agent-read-agentview group)) (setq gnus-agent-article-alist (gnus-cache-file-contents (gnus-agent-article-name ".agentview" group) 'gnus-agent-file-loading-cache 'gnus-agent-read-agentview)))) -;; Save format may be either 1 or 2. Two is the new, compressed format that is still being tested. Format 1 is uncompressed but known to be reliable. +;; Save format may be either 1 or 2. Two is the new, compressed +;; format that is still being tested. Format 1 is uncompressed but +;; known to be reliable. (defconst gnus-agent-article-alist-save-format 2) (defun gnus-agent-read-agentview (file) @@ -1420,34 +1460,39 @@ of FILE placing the combined headers in nntp-server-buffer." (end-of-file 0))) changed-version) - (cond ((= version 0) - (let ((inhibit-quit t) - entry) - (gnus-agent-open-history) - (set-buffer (gnus-agent-history-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (if (and (looking-at - "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") - (string= (match-string 2) - gnus-agent-read-agentview) - (setq entry (assoc (string-to-number (match-string 3)) alist))) - (setcdr entry (string-to-number (match-string 1)))) - (forward-line 1)) - (gnus-agent-close-history) - (setq changed-version t))) - ((= version 1) - (setq changed-version (not (= 1 gnus-agent-article-alist-save-format)))) - ((= version 2) - (let (uncomp) - (mapcar (lambda (comp-list) - (let ((state (car comp-list)) - (sequence (gnus-uncompress-sequence (cdr comp-list)))) - (mapcar (lambda (article-id) - (setq uncomp (cons (cons article-id state) uncomp))) sequence))) alist) - (setq alist (sort uncomp (lambda (first second) (< (car first) (car second))))) - ) - )) + (cond + ((= version 0) + (let ((inhibit-quit t) + entry) + (gnus-agent-open-history) + (set-buffer (gnus-agent-history-buffer)) + (goto-char (point-min)) + (while (not (eobp)) + (if (and (looking-at + "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") + (string= (match-string 2) + gnus-agent-read-agentview) + (setq entry (assoc (string-to-number (match-string 3)) alist))) + (setcdr entry (string-to-number (match-string 1)))) + (forward-line 1)) + (gnus-agent-close-history) + (setq changed-version t))) + ((= version 1) + (setq changed-version (not (= 1 gnus-agent-article-alist-save-format)))) + ((= version 2) + (let (uncomp) + (mapcar + (lambda (comp-list) + (let ((state (car comp-list)) + (sequence (gnus-uncompress-sequence + (cdr comp-list)))) + (mapcar (lambda (article-id) + (setq uncomp (cons (cons article-id state) uncomp))) + sequence))) + alist) + (setq alist (sort uncomp + (lambda (first second) + (< (car first) (car second)))))))) (when changed-version (let ((gnus-agent-article-alist alist)) (gnus-agent-save-alist gnus-agent-read-agentview))) @@ -1488,14 +1533,18 @@ of FILE placing the combined headers in nntp-server-buffer." (day-of-download (cdr pair)) (comp-list (assq day-of-download compressed))) (if comp-list - (setcdr comp-list (cons article-id (cdr comp-list))) - (setq compressed (cons (list day-of-download article-id) compressed))) + (setcdr comp-list + (cons article-id (cdr comp-list))) + (setq compressed + (cons (list day-of-download article-id) + compressed))) nil)) gnus-agent-article-alist) - (mapcar (lambda (comp-list) (setcdr comp-list (gnus-compress-sequence (nreverse (cdr comp-list))))) compressed) - (princ compressed (current-buffer)) - ) - ) - ) + (mapcar (lambda (comp-list) + (setcdr comp-list + (gnus-compress-sequence + (nreverse (cdr comp-list))))) + compressed) + (princ compressed (current-buffer))))) (insert "\n") (princ gnus-agent-article-alist-save-format (current-buffer)) (insert "\n")))) @@ -1583,11 +1632,10 @@ of FILE placing the combined headers in nntp-server-buffer." (gnus-activate-group group)) (let ((marked-articles gnus-newsgroup-downloadable)) ;; Identify the articles marked for download - (unless gnus-newsgroup-active ;; This needs to be a - ;; gnus-summary local variable - ;; that is NOT bound to any - ;; value above (It's global - ;; value should default to nil). + (unless gnus-newsgroup-active + ;; This needs to be a gnus-summary local variable that is + ;; NOT bound to any value above (its global value should + ;; default to nil). (dolist (mark gnus-agent-download-marks) (let ((arts (cdr (assq mark (gnus-info-marks (setq info (gnus-get-info group))))))) @@ -1667,7 +1715,8 @@ of FILE placing the combined headers in nntp-server-buffer." ;; predicate, add it to the download list (when (or (eq num (car marked-articles)) (let ((gnus-score - (or (cdr (assq num gnus-newsgroup-scored)) + (or (cdr + (assq num gnus-newsgroup-scored)) gnus-summary-default-score))) (funcall predicate))) (gnus-agent-append-to-list arts-tail num)))))) @@ -1675,10 +1724,15 @@ of FILE placing the combined headers in nntp-server-buffer." (let (fetched-articles) ;; Fetch all selected articles (setq gnus-newsgroup-undownloaded - (gnus-sorted-ndifference gnus-newsgroup-undownloaded - (setq fetched-articles (if (cdr arts) (gnus-agent-fetch-articles group (cdr arts)) nil)))) - - (let ((unfetched-articles (gnus-sorted-ndifference (cdr arts) fetched-articles))) + (gnus-sorted-ndifference + gnus-newsgroup-undownloaded + (setq fetched-articles + (if (cdr arts) + (gnus-agent-fetch-articles group (cdr arts)) + nil)))) + + (let ((unfetched-articles + (gnus-sorted-ndifference (cdr arts) fetched-articles))) (if gnus-newsgroup-active ;; Update the summary buffer (progn @@ -1687,11 +1741,13 @@ of FILE placing the combined headers in nntp-server-buffer." (gnus-summary-set-agent-mark article t))) (dolist (article fetched-articles) (if gnus-agent-mark-unread-after-downloaded - (gnus-summary-mark-article article gnus-unread-mark)) + (gnus-summary-mark-article + article gnus-unread-mark)) (when (gnus-summary-goto-subject article nil t) (gnus-summary-update-download-mark article))) (dolist (article unfetched-articles) - (gnus-summary-mark-article article gnus-canceled-mark))) + (gnus-summary-mark-article + article gnus-canceled-mark))) ;; Update the group buffer. @@ -1702,13 +1758,17 @@ of FILE placing the combined headers in nntp-server-buffer." (dolist (mark gnus-agent-download-marks) (when (eq mark 'download) - (let ((marked-arts (assq mark (gnus-info-marks - (setq info (gnus-get-info group)))))) + (let ((marked-arts + (assq mark (gnus-info-marks + (setq info (gnus-get-info group)))))) (when (cdr marked-arts) - (setq marks (delq marked-arts (gnus-info-marks info))) + (setq marks + (delq marked-arts (gnus-info-marks info))) (gnus-info-set-marks info marks))))) - (let ((read (gnus-info-read (or info (setq info (gnus-get-info group)))))) - (gnus-info-set-read info (gnus-add-to-range read unfetched-articles))) + (let ((read (gnus-info-read + (or info (setq info (gnus-get-info group)))))) + (gnus-info-set-read + info (gnus-add-to-range read unfetched-articles))) (gnus-group-update-group group t) (sit-for 0) @@ -2103,17 +2163,20 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (while (setq gnus-command-method (pop methods)) (when (file-exists-p (gnus-agent-lib-file "active")) (with-temp-buffer - (nnheader-insert-file-contents (gnus-agent-lib-file "active")) + (nnheader-insert-file-contents + (gnus-agent-lib-file "active")) (gnus-active-to-gnus-format gnus-command-method (setq orig (gnus-make-hashtable (count-lines (point-min) (point-max)))))) - (dolist (expiring-group (gnus-groups-from-server gnus-command-method)) + (dolist (expiring-group (gnus-groups-from-server + gnus-command-method)) (if (or (not group) (equal group expiring-group)) (let* ((dir (concat (gnus-agent-directory) - (gnus-agent-group-path expiring-group) "/")) + (gnus-agent-group-path expiring-group) + "/")) (active (gnus-gethash-safe expiring-group orig)) (day (if (numberp day) @@ -2121,12 +2184,13 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (let (found (days gnus-agent-expire-days)) (catch 'found - (while (and (not found) - days) + (while (and (not found) days) (when (eq 0 (string-match (caar days) expiring-group)) (throw 'found (- (time-to-days (current-time)) (cadar days)))) (pop days)) - ;; No regexp matched so set a limit that will block expiration in this group + ;; No regexp matched so set + ;; a limit that will block + ;; expiration in this group. 0))))) (when active @@ -2174,16 +2238,29 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." dlist type) - ;; The normal article alist contains elements that look like (article# . fetch_date) - ;; I need to combine other information with this list. For example, a flag indicating that a particular article MUST BE KEPT. - ;; To do this, I'm going to transform the elements to look like (article# fetch_date keep_flag NOV_entry_marker) - ;; Later, I'll reverse the process to generate the expired article alist. - - ;; Convert the alist elements to (article# fetch_date nil nil). + ;; The normal article alist contains + ;; elements that look like (article# . + ;; fetch_date) I need to combine other + ;; information with this list. For + ;; example, a flag indicating that a + ;; particular article MUST BE KEPT. To + ;; do this, I'm going to transform the + ;; elements to look like (article# + ;; fetch_date keep_flag + ;; NOV_entry_marker) Later, I'll reverse + ;; the process to generate the expired + ;; article alist. + + ;; Convert the alist elements to + ;; (article# fetch_date nil nil). (setq dlist (mapcar (lambda (e) (list (car e) (cdr e) nil nil)) alist)) - ;; Convert the keep lists to elements that look like (article# nil keep_flag nil) then append it to the expanded dlist - ;; These statements are sorted by ascending precidence of the keep_flag. + ;; Convert the keep lists to elements + ;; that look like (article# nil + ;; keep_flag nil) then append it to the + ;; expanded dlist These statements are + ;; sorted by ascending precidence of the + ;; keep_flag. (setq dlist (nconc dlist (mapcar (lambda (e) (list e nil 'unread nil)) unreads))) (setq dlist (nconc dlist @@ -2201,18 +2278,30 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (let (p) (while (< (setq p (point)) (point-max)) (condition-case nil - ;; If I successfully read an integer (the plus zero ensures a numeric type), prepend a marker entry to the list + ;; If I successfully read an + ;; integer (the plus zero + ;; ensures a numeric type), + ;; prepend a marker entry to + ;; the list (push (list (+ 0 (read (current-buffer))) nil nil (set-marker (make-marker) p)) dlist) (error (gnus-message 1 "gnus-agent-expire: read error occurred when reading expression at %s in %s. Skipping to next line." (point) nov-file))) - ;; Whether I succeeded, or failed, it doesn't matter. Move to the next line then try again. + ;; Whether I succeeded, or failed, + ;; it doesn't matter. Move to the + ;; next line then try again. (forward-line 1))) (gnus-message 7 "gnus-agent-expire: Loading overview... Done")) (set-buffer-modified-p nil) - ;; At this point, all of the information is in dlist. The only problem is that much of it is spread across multiple entries. Sort then MERGE!! + ;; At this point, all of the information + ;; is in dlist. The only problem is + ;; that much of it is spread across + ;; multiple entries. Sort then MERGE!! (gnus-message 7 "gnus-agent-expire: Sorting entries... ") - (let ((special 0) ; If two entries have the same article-number then sort by ascending keep_flag. + ;; If two entries have the same + ;; article-number then sort by ascending + ;; keep_flag. + (let ((special 0) (marked 1) (unread 2)) (setq dlist @@ -2373,11 +2462,16 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (cdr unread))) (defun gnus-agent-uncached-articles (articles group &optional cached-header) - "Constructs sublist of ARTICLES that excludes those articles ids in GROUP that have already been fetched. - If CACHED-HEADER is nil, articles are only excluded if the article itself has been fetched." + "Restrict ARTICLES to numbers already fetched. +Returns a sublist of ARTICLES that excludes thos article ids in GROUP +that have already been fetched. +If CACHED-HEADER is nil, articles are only excluded if the article itself +has been fetched." -;; Logically equivalent to: (gnus-sorted-difference articles (mapcar 'car gnus-agent-article-alist)) -;; Functionally, I don't need to construct a temp list using mapcar. + ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar + ;; 'car gnus-agent-article-alist)) + + ;; Functionally, I don't need to construct a temp list using mapcar. (if (gnus-agent-load-alist group) (let* ((ref gnus-agent-article-alist) @@ -2430,14 +2524,19 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." uncached-articles group fetch-old))) (nnvirtual-convert-headers)) ((eq 'nntp (car gnus-current-select-method)) - ;; The author of gnus-get-newsgroup-headers-xover reports that the XOVER command - ;; is commonly unreliable. The problem is that recently posted articles may not - ;; be entered into the NOV database in time to respond to my XOVER query. + ;; The author of gnus-get-newsgroup-headers-xover + ;; reports that the XOVER command is commonly + ;; unreliable. The problem is that recently + ;; posted articles may not be entered into the + ;; NOV database in time to respond to my XOVER + ;; query. ;; - ;; I'm going to use his assumption that the NOV database is updated in order - ;; of ascending article ID. Therefore, a response containing article ID N - ;; implies that all articles from 1 to N-1 are up-to-date. Therefore, - ;; missing articles in that range have expired. + ;; I'm going to use his assumption that the NOV + ;; database is updated in order of ascending + ;; article ID. Therefore, a response containing + ;; article ID N implies that all articles from 1 + ;; to N-1 are up-to-date. Therefore, missing + ;; articles in that range have expired. (set-buffer nntp-server-buffer) (let* ((fetched-articles (list nil)) @@ -2458,21 +2557,25 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (gnus-agent-append-to-list tail-fetched-articles (read (current-buffer)))) (forward-line 1))) - ;; Clip this list to the headers that will actually be returned + ;; Clip this list to the headers that will + ;; actually be returned (setq fetched-articles (gnus-list-range-intersection (cdr fetched-articles) (cons min max))) - ;; Clip the uncached articles list to exclude IDs after the last FETCHED header. - ;; The excluded IDs may be fetchable using HEAD. + ;; Clip the uncached articles list to exclude + ;; IDs after the last FETCHED header. The + ;; excluded IDs may be fetchable using HEAD. (if (car tail-fetched-articles) (setq uncached-articles (gnus-list-range-intersection uncached-articles (cons (car uncached-articles) (car tail-fetched-articles))))) - ;; Create the list of articles that were "successfully" fetched. Success, in - ;; this case, means that the ID should not be fetched again. In the case of - ;; an expired article, the header will not be fetched. + ;; Create the list of articles that were + ;; "successfully" fetched. Success, in this + ;; case, means that the ID should not be + ;; fetched again. In the case of an expired + ;; article, the header will not be fetched. (setq uncached-articles (gnus-sorted-nunion fetched-articles uncached-articles)) )))) @@ -2484,7 +2587,8 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (set-buffer nntp-server-buffer) (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - ;; Merge the temp buffer with the known headers (found on disk in FILE) into the nntp-server-buffer + ;; Merge the temp buffer with the known headers (found on + ;; disk in FILE) into the nntp-server-buffer (when (and uncached-articles (file-exists-p file)) (gnus-agent-braid-nov group uncached-articles file)) @@ -2495,7 +2599,8 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." gnus-agent-file-coding-system (point-min) (point-max) file nil 'silent) - ;; Update the group's article alist to include the newly fetched articles. + ;; Update the group's article alist to include the newly + ;; fetched articles. (gnus-agent-load-alist group) (gnus-agent-save-alist group uncached-articles nil) ) @@ -2532,7 +2637,9 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." t))) (defun gnus-agent-regenerate-group (group &optional reread) - "Regenerate GROUP. If REREAD is t, all articles in the .overview are marked as unread. If REREAD is not nil, downloaded articles are marked as unread." + "Regenerate GROUP. +If REREAD is t, all articles in the .overview are marked as unread. +If REREAD is not nil, downloaded articles are marked as unread." (interactive (list (let ((def (or (gnus-group-group-name) gnus-newsgroup-name))) (let ((select (read-string (if def (concat "Group Name (" def "): ") @@ -2564,7 +2671,8 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (nnheader-insert-file-contents file))) (set-buffer-modified-p nil) - ;; Load the article IDs found in the overview file. As a side-effect, validate the file contents. + ;; Load the article IDs found in the overview file. As a + ;; side-effect, validate the file contents. (let ((load t)) (while load (setq load nil) @@ -2579,7 +2687,8 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." nil) ((< l1 l2) (gnus-message 3 "gnus-agent-regenerate-group: NOV entries are NOT in ascending order.") - ;; Don't sort now as I haven't verified that every line begins with a number + ;; Don't sort now as I haven't verified + ;; that every line begins with a number (setq load t)) ((= l1 l2) (forward-line -1) @@ -2596,8 +2705,9 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (setq nov-arts nil))))) (gnus-agent-check-overview-buffer) - ;; Construct a new article alist whose nodes match every header in the .overview file. - ;; As a side-effect, missing headers are reconstructed from the downloaded article file. + ;; Construct a new article alist whose nodes match every header + ;; in the .overview file. As a side-effect, missing headers are + ;; reconstructed from the downloaded article file. (while (or downloaded nov-arts) (cond ((and downloaded (or (not nov-arts) @@ -2628,14 +2738,18 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (push (cons (car nov-arts) nil) alist) (pop nov-arts)))) - ;; When gnus-agent-consider-all-articles is set, gnus-agent-regenerate-group should NOT remove article IDs - ;; from the alist. Those IDs serve as markers to indicate that an attempt has been made to fetch that - ;; article's header. - - ;; When gnus-agent-consider-all-articles is NOT set, gnus-agent-regenerate-group can remove the article - ;; ID of every article (with the exception of the last ID in the list - it's special) that no longer appears in the overview. - ;; In this situtation, the last article ID in the list implies that it, and every article ID preceeding it, - ;; have been fetched from the server. + ;; When gnus-agent-consider-all-articles is set, + ;; gnus-agent-regenerate-group should NOT remove article IDs from + ;; the alist. Those IDs serve as markers to indicate that an + ;; attempt has been made to fetch that article's header. + + ;; When gnus-agent-consider-all-articles is NOT set, + ;; gnus-agent-regenerate-group can remove the article ID of every + ;; article (with the exception of the last ID in the list - it's + ;; special) that no longer appears in the overview. In this + ;; situtation, the last article ID in the list implies that it, + ;; and every article ID preceeding it, have been fetched from the + ;; server. (if gnus-agent-consider-all-articles ;; Restore all article IDs that were not found in the overview file. (let* ((n (cons nil alist)) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 7915f1a..b2380cc 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -3730,6 +3730,8 @@ commands: (set (make-local-variable 'gnus-article-edit-mode) nil) (buffer-disable-undo) (setq buffer-read-only t) + ;; This list just keeps growing if we don't reset it. + (setq gnus-button-marker-list nil) (unless (eq major-mode 'gnus-article-mode) (gnus-article-mode)) (current-buffer)) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 0e3bb51..cf3cc29 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -36,7 +36,7 @@ ;; Requiring `gnus-util' at compile time creates a circular ;; dependency between nnheader.el and gnus-util.el. -;(eval-when-compile (require 'gnus-util)) +;;(eval-when-compile (require 'gnus-util)) (require 'mail-utils) @@ -120,6 +120,14 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") (t nil)) "Coding system of auto save file.") +(defvar nnheader-directory-separator-character + (let ((case-fold-search t)) + (cond + ((string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (symbol-name system-type)) + ?\\) + (t ?/)))) + (eval-and-compile (autoload 'nnmail-message-id "nnmail") (autoload 'mail-position-on-field "sendmail") @@ -1397,7 +1405,7 @@ without formatting." (expand-file-name (file-name-as-directory top)))) (error ""))) - ?/ ?.)) + nnheader-directory-separator-character ?.)) (defun nnheader-message (level &rest args) "Message if the Gnus backends are talkative." diff --git a/lisp/nntp.el b/lisp/nntp.el index 0b822a5..afeca08 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -237,7 +237,10 @@ NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.") "*Hook run just before posting an article. It is supposed to be used to insert Cancel-Lock headers.") -(defvoo nntp-read-timeout 0.1 +(defvoo nntp-read-timeout (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (symbol-name system-type)) + 1.0 + 0.1) "How long nntp should wait between checking for the end of output. Shorter values mean quicker response, but is more CPU intensive.")