From: yamaoka Date: Mon, 10 Feb 2003 11:32:08 +0000 (+0000) Subject: Import Oort Gnus v0.15. X-Git-Tag: ognus-0_15~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=73c6f05af6afc303948a77bc5c94412a480e2164;p=elisp%2Fgnus.git- Import Oort Gnus v0.15. --- diff --git a/GNUS-NEWS b/GNUS-NEWS index 7206c50..dcccac0 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -1,5 +1,5 @@ GNUS NEWS -- history of user-visible changes. -Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. See the end for copying conditions. Please send Gnus bug reports to bugs@gnus.org. @@ -8,6 +8,8 @@ For older news, see Gnus info node "New Features". * Changes in Oort Gnus +** The format spec %C for positioning point has changed to %*. + ** The new variable `gnus-parameters' can be used to set group parameters. Earlier this was done only via `G p' (or `G c'), which stored the diff --git a/etc/Makefile.in b/etc/Makefile.in index a552a89..8ef7da1 100644 --- a/etc/Makefile.in +++ b/etc/Makefile.in @@ -30,7 +30,7 @@ install: done $(SHELL) $(top_srcdir)/mkinstalldirs $(etcdir)/smilies cd $(srcdir) \ - && for p in smilies/*.pbm; do \ + && for p in smilies/*.pbm smilies/*.xpm; do \ echo " $(INSTALL_DATA) $$p $(etcdir)/$$p"; \ $(INSTALL_DATA) $$p $(etcdir)/$$p; \ done @@ -43,7 +43,7 @@ uninstall: done rmdir $(etcdir)/gnus 2> /dev/null || true cd $(srcdir) \ - && for p in smilies/*.pbm; do \ + && for p in smilies/*.pbm smilies/*.xpm; do \ rm -f "$(etcdir)/$$p"; \ done rmdir $(etcdir)/smilies 2> /dev/null || true diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0f3847a..d04dbef 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,351 @@ +2003-02-08 23:23:27 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.15 is released. + +2003-02-08 Michael Welsh Duggan + + * nnmail.el (nnmail-split-it): If a message ends up matching the + same mailbox more than once, it will cause duplicates to appear + in the mailbox. + +2003-02-08 Simon Josefsson + + * gnus-sum.el (gnus-summary-select-article): Remove blink removal + code that only worked under Emacs. + + * pgg-gpg.el (pgg-gpg-process-region): Don't blink. From Satyaki + Das . + +2003-02-08 Jesper Harder + + * gnus-art.el (gnus-article-refer-article): Use + gnus-replace-in-string. + + * gnus-util.el (gnus-map-function): Remove unneeded let-binding. + (gnus-remove-duplicates): do. + +2003-02-07 Teodor Zlatanov + + * gnus-int.el (gnus-internal-registry-spool-current-method): new variable + (gnus-request-scan): set + gnus-internal-registry-spool-current-method to gnus-command-method + before a request-scan operation + + * gnus-registry.el (regtest-nnmail): use + gnus-internal-registry-spool-current-method + + + +2003-02-07 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch): Typo fix. + +2003-02-07 Teodor Zlatanov + + * nnmail.el (nnmail-spool-hook): new hook + (nnmail-cache-insert): call nnmail-spool-hook + + * gnus-registry.el: new file with examples of using the hooks + + * gnus.el (gnus-registry): added registry customization group + (gnus-group-prefixed-name): improve function to return full group + name optionally + (gnus-group-guess-prefixed-name): shortcut to + gnus-group-prefixed-name, using just the group name + (gnus-group-full-name): always get a group's full name + (gnus-group-guess-full-name): shortcut, using just the group name + + * gnus-sum.el (gnus-summary-article-move-hook) + (gnus-summary-article-delete-hook) + (gnus-summary-article-expire-hook): new hooks + (gnus-summary-move-article, gnus-summary-expire-articles) + (gnus-summary-delete-article): invoke the new hooks + +2003-02-07 Frank Weinberg + + * gnus-art.el (gnus-article-refer-article): Strip leading "news:" + from message-ID + +2003-02-07 Jesper Harder + + * gnus-util.el (gnus-run-hooks): Use save-current-buffer. + +2003-02-07 John Paul Wallington + + * mm-util.el (mm-delete-duplicates, mm-append-to-file) + (mm-write-region, mm-detect-coding-region): Doc fixes. + +2003-02-07 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch): Ignore errors. + (mail-source-ignore-errors): New variable. + + * gnus-sum.el (gnus-summary-refer-thread): Don't re-fetch current + articles. + + * gnus-msg.el (gnus-version-expose-system): Change default. + +2003-02-07 Vasily Korytov + + * gnus-msg.el (gnus-version-expose-system): New variable. + +2003-02-07 Simon Josefsson + + * mml-sec.el (mml-unsecure-message): Don't use kill-region. Tiny + patch from deskpot@myrealbox.com (Vasily Korytov). + +2003-02-02 Lars Magne Ingebrigtsen + + * gnus-art.el (article-display-face): Get the Face header from + the current buffer. + +2003-02-06 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-view-part-internally): Bind + buffer-read-only to nil. + +2003-02-05 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-expire-1,2): Pass the dir argument + from g-a-e-1 to g-a-e-2. + +2003-02-05 Teodor Zlatanov + + * spam.el (spam-check-BBDB): no need to regexp-quote the argument + of bbdb-search-simple, use spam-use-BBDB-exclusive + (spam-check-whitelist): use spam-use-whitelist-exclusive + (spam-use-whitelist-exclusive): new variable affecting + spam-use-whitelist + (spam-use-BBDB-exclusive): new variable affecting spam-use-BBDB + +2003-02-05 Simon Josefsson + + * gnus-agent.el (gnus-agent-expire-days): Change default to nil. + (gnus-agent-expire): Don't expire if g-a-e-d is nil. + (gnus-agent-expire): Move most code into gnus-agent-expire-1. + (gnus-agent-expire-1): New. + (gnus-agent-expire-1): Move code into gnus-agent-expire-2. + (gnus-agent-expire-2): New. + +2003-02-05 Jesper Harder + + * gnus-util.el (gnus-delete-if): Rename to gnus-remove-if. + "delete-if" is misleading because it isn't actually destructive. + + * gnus-topic.el (gnus-group-prepare-topics): Use new name. + + * nnmail.el (nnmail-purge-split-history): do. + + * gnus-win.el (gnus-get-buffer-window): do. + + * gnus-sum.el (gnus-simplify-whitespace): Remove unnecessary + let-binding. + (gnus-simplify-all-whitespace): do. + +2003-02-05 Katsumi Yamaoka + + * gnus-delay.el (gnus-delay-article): Fix binding of the + nndraft:delayed group. + +2003-02-04 Teodor Zlatanov + + * gnus.el (spam group parameters): change 'other to 'const in + the group parameter definitions to soothe XEmacs + +2003-02-04 Kai Gro,A_(Bjohann + + * gnus-delay.el (gnus-delay-article): Really create + nndraft:delayed group if it doesn't exist. + +2003-02-04 Jesper Harder + + * gnus-sum.el (gnus-summary-search-article): Speed up by + disabling various visual features while searching. + (gnus-summary-recenter): Test gnus-auto-center-summary first. + +2003-02-03 Jesper Harder + + * spam.el (spam-list-of-checks): Don't quote nil and t in + docstrings. From the elisp manual: + + When a documentation string refers to a Lisp symbol, write + it [..] with single-quotes around it. [..] There are two + exceptions: write t and nil without single-quotes. + + * messcompat.el (message-from-style): do. + + * message.el (message-send-mail): do. + + * gnus-util.el (gnus-use-byte-compile): do. + + * gnus-score.el (gnus-score-lower-thread): do. + + * gnus-int.el (gnus-server-unopen-status): do. + + * gnus.el (gnus-define-group-parameter, gnus-large-newsgroup) + (large-newsgroup-initial, gnus-install-group-spam-parameters): do. + + * gnus-cus.el (gnus-group-customize, gnus-score-parameters) + (gnus-group-parameters): do. + + * gnus-art.el (gnus-article-mime-match-handle-function): do. + + * mm-decode.el (mm-text-html-renderer): do. + +2003-02-02 Katsumi Yamaoka + + * nnheader.el (nnheader-directory-separator-character): Change the + way to compute the dafault value. + +2003-02-02 Jesper Harder + + * gnus-art.el (gnus-button-handle-describe-key): Implement it. + (gnus-button-alist): Fix regexp for describe-key. + (gnus-button-handle-describe-function) + (gnus-button-handle-describe-variable) + (gnus-button-handle-apropos, gnus-button-handle-apropos-command) + (gnus-button-handle-apropos-variable) + (gnus-button-handle-apropos-documentation): Docstring fix. + + * gnus-util.el (gnus-kill-buffer): Use get-buffer. + +2003-02-01 Lars Magne Ingebrigtsen + + * gnus-draft.el (gnus-group-send-queue): Bind gnus-posting-styles + to nil. + + * nnmail.el: Removed gnus-util autoload. + + * gnus.el: Use gnus-prin1-to-string throughout. + + * gnus-util.el (gnus-prin1-to-string): Bind print-length and + print-level. + + * gnus-art.el (article-display-x-face): Removed grey x-face stuff. + (gnus-treat-display-grey-xface): Removed. + + * gnus-fun.el (gnus-grab-cam-face): New. + (gnus-convert-image-to-gray-x-face): Removed. + (gnus-convert-gray-x-face-to-xpm): removed. + (gnus-convert-gray-x-face-region): Removed. + (gnus-grab-gray-x-face): Removed. + + * nnmail.el (nnmail-expiry-wait-function): Doc indent. + +2003-01-31 Jesper Harder + + * gnus-util.el (gnus-kill-buffer): Functions in gnus-util + shouldn't depend on the rest of Gnus, so test if gnus-buffers is + bound. + + * nnmail.el (nnmail-cache-close): Use gnus-kill-buffer. + +2003-01-30 Jesper Harder + + * gnus-cite.el (gnus-cite-reply-regexp, gnus-cite-always-check): + Remove -- these are bogus options which are never used. + +2003-01-29 Jesper Harder + + * gnus-art.el (gnus-article-mode): Use summary tool bar. + +2003-01-27 Teodor Zlatanov + + * spam.el (spam-check-blackholes) + (spam-blackhole-good-server-regex): new variable to skip some IPs + when checking blackholes; use it + (spam-check-bogofilter-headers) + (spam-bogofilter-bogosity-positive-spam-header): new variable, in + case more X-Bogosity is used than just "Yes/No" + (spam-ham-move-routine): semi-fixed, only first article is + properly moved now + +2003-01-27 Jesper Harder + + * gnus-util.el (gnus-kill-buffer): Remove buffer from gnus-buffers + as well. + + * gnus-sum.el (gnus-select-newsgroup): Use gnus-kill-buffer. + + * gnus-score.el (gnus-score-headers, gnus-score-find-bnews): do. + + * gnus-start.el (gnus-save-newsrc-file, gnus-clear-system): do. + + * gnus-bcklg.el (gnus-backlog-shutdown): do. + + * gnus-srvr.el (gnus-server-exit, gnus-browse-exit): do. + +2003-01-26 Lars Magne Ingebrigtsen + + * gnus-fun.el (gnus-face-encode): New function. + (gnus-convert-png-to-face): Use it. + + * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks. + +2003-01-26 Jesper Harder + + * mm-decode.el (mm-dissection-list): Remove. + (mm-dissect-singlepart): Don't push to mm-dissection-list, it's + only used in mm-remove-all-parts. + (mm-remove-all-parts): Remove it, it's never called. + +2003-01-25 Simon Josefsson + + * gnus-group.el (gnus-group-make-group): Report errors. + + * nnimap.el (nnimap-request-create-group): Ditto. + + * sieve-manage.el (sieve-manage-is-okno): Parse literal strings. + + * sieve.el (sieve-upload): Fix error printing. + + * mm-encode.el (mm-qp-or-base64): Always QP iff + mm-use-ultra-safe-encoding and cleartext PGP. + + * gnus-sum.el (gnus-summary-select-article): Inhibit + redisplay (mainly for secured messages). + + * nnmail.el (nnmail-article-group): Copy body too (but don't + process it). + +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 * gnus.el: Oort Gnus v0.14 is released. @@ -5,7 +353,7 @@ 2003-01-24 Kai Gro,A_(Bjohann * gnus-sum.el (gnus-summary-prepare-threads): Reset state for %B - before beginning. Trivial patch from Mark Thomas + before beginning. Tiny patch from Mark Thomas . 2003-01-24 Teodor Zlatanov diff --git a/lisp/deuglify.el b/lisp/deuglify.el index 33635de..a8053da 100644 --- a/lisp/deuglify.el +++ b/lisp/deuglify.el @@ -1,7 +1,7 @@ ;;; deuglify.el --- deuglify broken Outlook (Express) articles -;; Copyright (C) 2002 Free Software Foundation, Inc. -;; Copyright (C) 2001,2002 Raymond Scholz +;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002 Raymond Scholz ;; Author: Raymond Scholz ;; Thomas Steffen (unwrapping algorithm, diff --git a/lisp/dig.el b/lisp/dig.el index ae6a6ef..953dc1d 100644 --- a/lisp/dig.el +++ b/lisp/dig.el @@ -1,5 +1,5 @@ ;;; dig.el --- Domain Name System dig interface -;; Copyright (c) 2000, 2001 Free Software Foundation, Inc. +;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: DNS BIND dig diff --git a/lisp/dns.el b/lisp/dns.el index 5b43e10..7137ef7 100644 --- a/lisp/dns.el +++ b/lisp/dns.el @@ -1,5 +1,5 @@ ;;; dns.el --- Domain Name Service lookups -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: network diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index a40e48a..3ef12c8 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,5 +1,5 @@ ;;; gnus-agent.el --- unplugged support for Gnus -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -59,12 +59,14 @@ :group 'gnus-agent :type 'integer) -(defcustom gnus-agent-expire-days 7 +(defcustom gnus-agent-expire-days nil "Read articles older than this will be expired. -This can also be a list of regexp/day pairs. The regexps will -be matched against group names." +This can also be a list of regexp/day pairs. The regexps will be +matched against group names. If nil, articles in the agent cache are +never expired." :group 'gnus-agent - :type 'integer) + :type '(choice (number :tag "days") + (const :tag "never" nil))) (defcustom gnus-agent-expire-all nil "If non-nil, also expire unread, ticked and dormant articles. @@ -142,7 +144,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) @@ -152,16 +156,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) @@ -438,10 +441,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) @@ -757,9 +761,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) @@ -784,13 +790,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 @@ -802,7 +814,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 @@ -834,8 +847,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) @@ -1024,9 +1040,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)))) @@ -1064,7 +1082,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 @@ -1083,8 +1102,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))) @@ -1092,14 +1112,16 @@ 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)))) (let ((coding-system-for-write gnus-agent-file-coding-system)) (write-region (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)))) @@ -1141,11 +1163,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) @@ -1204,7 +1226,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)) @@ -1240,34 +1263,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) @@ -1283,9 +1315,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)) (let ((coding-system-for-write @@ -1316,8 +1350,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)) @@ -1328,7 +1363,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") @@ -1351,7 +1387,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) @@ -1373,19 +1410,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) @@ -1399,34 +1441,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))) @@ -1466,14 +1513,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")))) @@ -1561,11 +1612,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))))))) @@ -1645,7 +1695,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)))))) @@ -1653,10 +1704,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 @@ -1665,11 +1721,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. @@ -1680,13 +1738,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) @@ -2051,8 +2113,330 @@ return only unread articles." (or (gnus-gethash group gnus-category-group-cache) (assq 'default gnus-category-alist))) +(defun gnus-agent-expire-2 (expiring-group active articles overview day force + dir) + (gnus-agent-load-alist expiring-group) + (gnus-message 5 "Expiring articles in %s" expiring-group) + (let* ((info (gnus-get-info expiring-group)) + (alist gnus-agent-article-alist) + (specials (if alist + (list (caar (last alist))))) + (unreads ;; Articles that are excluded from the expiration process + (cond (gnus-agent-expire-all + ;; All articles are marked read by global decree + nil) + ((eq articles t) + ;; All articles are marked read by function parameter + nil) + ((not articles) + ;; Unread articles are marked protected from + ;; expiration Don't call gnus-list-of-unread-articles + ;; as it returns articles that have not been fetched + ;; into the agent. + (ignore-errors (gnus-agent-unread-articles expiring-group))) + (t + ;; All articles EXCEPT those named by the caller are + ;; protected from expiration + (gnus-sorted-difference + (gnus-uncompress-range + (cons (caar alist) (caar (last alist)))) + (sort articles '<))))) + (marked ;; More articles that are exluded from the expiration process + (cond (gnus-agent-expire-all + ;; All articles are unmarked by global decree + nil) + ((eq articles t) + ;; All articles are unmarked by function parameter + nil) + (articles + ;; All articles may as well be unmarked as the + ;; unreads list already names the articles we are + ;; going to keep + nil) + (t + ;; Ticked and/or dormant articles are excluded from expiration + (nconc + (gnus-uncompress-range + (cdr (assq 'tick (gnus-info-marks info)))) + (gnus-uncompress-range + (cdr (assq 'dormant + (gnus-info-marks info)))))))) + (nov-file (concat dir ".overview")) + (cnt 0) + (completed -1) + 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). + (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. + (setq dlist (nconc dlist (mapcar (lambda (e) + (list e nil 'unread nil)) unreads))) + (setq dlist (nconc dlist (mapcar (lambda (e) + (list e nil 'marked nil)) marked))) + (setq dlist (nconc dlist (mapcar (lambda (e) + (list e nil 'special nil)) specials))) + + (set-buffer overview) + (erase-buffer) + (when (file-exists-p nov-file) + (gnus-message 7 "gnus-agent-expire: Loading overview...") + (nnheader-insert-file-contents nov-file) + (goto-char (point-min)) + + (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 + (push (list (+ 0 (read (current-buffer))) nil nil + (set-marker (make-marker) p)) dlist) + (error + (gnus-message 1 (concat "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. + (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!! + (gnus-message 7 "gnus-agent-expire: Sorting entries... ") + ;; If two entries have the same + ;; article-number then sort by ascending + ;; keep_flag. + (let ((special 0) + (marked 1) + (unread 2)) + (setq dlist + (sort dlist + (lambda (a b) + (cond ((< (nth 0 a) (nth 0 b)) + t) + ((> (nth 0 a) (nth 0 b)) + nil) + (t + (let ((a (or (symbol-value (nth 2 a)) 3)) + (b (or (symbol-value (nth 2 b)) 3))) + (<= a b)))))))) + (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") + (gnus-message 7 "gnus-agent-expire: Merging entries... ") + (let ((dlist dlist)) + (while (cdr dlist) ; I'm not at the end-of-list + (if (eq (caar dlist) (caadr dlist)) + (let ((first (cdr (car dlist))) + (secnd (cdr (cadr dlist)))) + (setcar first (or (car first) (car secnd))) ; fetch_date + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) (car secnd))) ; Keep_flag + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) (car secnd))) ; NOV_entry_marker + + (setcdr dlist (cddr dlist))) + (setq dlist (cdr dlist))))) + (gnus-message 7 "gnus-agent-expire: Merging entries... Done") + + (let* ((len (float (length dlist))) + (alist (list nil)) + (tail-alist alist)) + (while dlist + (let ((new-completed (truncate (* 100.0 (/ (setq cnt (1+ cnt)) len))))) + (when (> new-completed completed) + (setq completed new-completed) + (gnus-message 9 "%3d%% completed..." completed))) + (let* ((entry (car dlist)) + (article-number (nth 0 entry)) + (fetch-date (nth 1 entry)) + (keep (nth 2 entry)) + (marker (nth 3 entry))) + + (cond + ;; Kept articles are unread, marked, or special. + (keep + (when fetch-date + (unless (file-exists-p (concat dir (number-to-string + article-number))) + (setf (nth 1 entry) nil) + (gnus-message 3 (concat "gnus-agent-expire cleared download " + "flag on article %d as the cached " + "article file is missing.") + (caar dlist))) + (unless marker + (gnus-message 1 (concat "gnus-agent-expire detected a " + "missing NOV entry. Run " + "gnus-agent-regenerate-group to " + "restore it.")))) + (gnus-agent-append-to-list tail-alist (cons article-number fetch-date))) + + ;; The following articles are READ, UNMARKED, and ORDINARY. + ;; See if they can be EXPIRED!!! + ((setq type + (cond + ((not (integerp fetch-date)) + 'read) ;; never fetched article (may expire right now) + ((not (file-exists-p (concat dir (number-to-string + article-number)))) + (setf (nth 1 entry) nil) + 'externally-expired) ;; Can't find the cached + ;; article. Handle case as + ;; though this article was + ;; never fetched. + + ;; We now have the arrival day, so we see + ;; whether it's old enough to be expired. + ((< fetch-date day) + 'expired) + (force + 'forced))) + + ;; I found some reason to expire this entry. + + (let ((actions nil)) + (when (memq type '(forced expired)) + (ignore-errors ; Just being paranoid. + (delete-file (concat dir (number-to-string article-number))) + (push "expired cached article" actions)) + (setf (nth 1 entry) nil)) + + (when marker + (push "NOV entry removed" actions) + (goto-char marker) + (gnus-delete-line)) + + ;; If considering all articles is set, I can only expire + ;; article IDs that are no longer in the active range. + (if (and gnus-agent-consider-all-articles + (>= article-number (car active))) + ;; I have to keep this ID in the alist + (gnus-agent-append-to-list tail-alist + (cons article-number fetch-date)) + (push (format "Removed %s article number from article alist" + type) actions)) + + (gnus-message 7 "gnus-agent-expire: Article %d: %s" + article-number (mapconcat 'identity + actions ", ")))) + (t + (gnus-agent-append-to-list tail-alist (cons article-number fetch-date))) + ) + + ;; Clean up markers as I want to recycle this buffer over + ;; several groups. + (when marker + (set-marker marker nil)) + + (setq dlist (cdr dlist)))) + + (setq alist (cdr alist)) + + (let ((inhibit-quit t)) + (unless (equal alist gnus-agent-article-alist) + (setq gnus-agent-article-alist alist) + (gnus-agent-save-alist expiring-group)) + + (when (buffer-modified-p) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (gnus-make-directory dir) + (write-region (point-min) (point-max) nov-file nil 'silent) + ;; clear the modified flag as that I'm not confused by its + ;; status on the next pass through this routine. + (set-buffer-modified-p nil))) + + (when (eq articles t) + (gnus-summary-update-info)))))) + +(defun gnus-agent-expire-1 (&optional articles group force) + "Expire all old agent cached articles unconditionally. +See `gnus-agent-expire'." + (let ((methods (if group + (list (gnus-find-method-for-group group)) + gnus-agent-covered-methods)) + (day (if (numberp gnus-agent-expire-days) + (- (time-to-days (current-time)) gnus-agent-expire-days) + nil)) + gnus-command-method sym arts pos + history overview file histories elem art nov-file low info + unreads marked article orig lowest highest found days) + (save-excursion + (setq overview (gnus-get-buffer-create " *expire overview*")) + (unwind-protect + (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")) + (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)) + (if (or (not group) + (equal group expiring-group)) + (let* ((dir (concat + (gnus-agent-directory) + (gnus-agent-group-path expiring-group) + "/")) + (active + (gnus-gethash-safe expiring-group orig)) + (day (if (numberp day) + day + (let (found + (days gnus-agent-expire-days)) + (catch 'found + (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. + 0))))) + + (when active + (gnus-agent-expire-2 expiring-group active + articles overview day force + dir))))))) + (kill-buffer overview))))) + (defun gnus-agent-expire (&optional articles group force) - "Expire all old articles. + "Expire all old agent cached articles. If you want to force expiring of certain articles, this function can take ARTICLES, GROUP and FORCE parameters as well. @@ -2063,260 +2447,14 @@ The articles on which the expiration process runs are selected as follows: Setting GROUP will limit expiration to that group. FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (interactive) - - (if (or (not (eq articles t)) - (yes-or-no-p (concat "Are you sure that you want to expire all articles in " (if group group "every agentized group") "."))) - (let ((methods (if group - (list (gnus-find-method-for-group group)) - gnus-agent-covered-methods)) - (day (if (numberp gnus-agent-expire-days) - (- (time-to-days (current-time)) gnus-agent-expire-days) - nil)) - gnus-command-method sym arts pos - history overview file histories elem art nov-file low info - unreads marked article orig lowest highest found days) - (save-excursion - (setq overview (gnus-get-buffer-create " *expire overview*")) - (unwind-protect - (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")) - (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)) - (if (or (not group) - (equal group expiring-group)) - (let* ((dir (concat - (gnus-agent-directory) - (gnus-agent-group-path expiring-group) "/")) - (active - (gnus-gethash-safe expiring-group orig)) - (day (if (numberp day) - day - (let (found - (days gnus-agent-expire-days)) - (catch 'found - (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 - 0))))) - - (when active - (gnus-agent-load-alist expiring-group) - (gnus-message 5 "Expiring articles in %s" expiring-group) - (let* ((info (gnus-get-info expiring-group)) - (alist gnus-agent-article-alist) - (specials (if alist - (list (caar (last alist))))) - (unreads ;; Articles that are excluded from the expiration process - (cond (gnus-agent-expire-all - ;; All articles are marked read by global decree - nil) - ((eq articles t) - ;; All articles are marked read by function parameter - nil) - ((not articles) - ;; Unread articles are marked protected from expiration - ;; Don't call gnus-list-of-unread-articles as it returns articles that have not been fetched into the agent. - (ignore-errors (gnus-agent-unread-articles expiring-group))) - (t - ;; All articles EXCEPT those named by the caller are protected from expiration - (gnus-sorted-difference (gnus-uncompress-range (cons (caar alist) (caar (last alist)))) (sort articles '<))))) - (marked ;; More articles that are exluded from the expiration process - (cond (gnus-agent-expire-all - ;; All articles are unmarked by global decree - nil) - ((eq articles t) - ;; All articles are unmarked by function parameter - nil) - (articles - ;; All articles may as well be unmarked as the unreads list already names the articles we are going to keep - nil) - (t - ;; Ticked and/or dormant articles are excluded from expiration - (nconc - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant - (gnus-info-marks info)))))))) - (nov-file (concat dir ".overview")) - (cnt 0) - (completed -1) - 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). - (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. - (setq dlist (nconc dlist - (mapcar (lambda (e) (list e nil 'unread nil)) unreads))) - (setq dlist (nconc dlist - (mapcar (lambda (e) (list e nil 'marked nil)) marked))) - (setq dlist (nconc dlist - (mapcar (lambda (e) (list e nil 'special nil)) specials))) - - (set-buffer overview) - (erase-buffer) - (when (file-exists-p nov-file) - (gnus-message 7 "gnus-agent-expire: Loading overview...") - (nnheader-insert-file-contents nov-file) - (goto-char (point-min)) - - (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 - (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. - (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!! - (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. - (marked 1) - (unread 2)) - (setq dlist - (sort dlist - (lambda (a b) - (cond ((< (nth 0 a) (nth 0 b)) - t) - ((> (nth 0 a) (nth 0 b)) - nil) - (t - (let ((a (or (symbol-value (nth 2 a)) 3)) - (b (or (symbol-value (nth 2 b)) 3))) - (<= a b)))))))) - (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") - (gnus-message 7 "gnus-agent-expire: Merging entries... ") - (let ((dlist dlist)) - (while (cdr dlist) ; I'm not at the end-of-list - (if (eq (caar dlist) (caadr dlist)) - (let ((first (cdr (car dlist))) - (secnd (cdr (cadr dlist)))) - (setcar first (or (car first) (car secnd))) ; fetch_date - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) (car secnd))) ; Keep_flag - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) (car secnd))) ; NOV_entry_marker - - (setcdr dlist (cddr dlist))) - (setq dlist (cdr dlist))))) - (gnus-message 7 "gnus-agent-expire: Merging entries... Done") - - (let* ((len (float (length dlist))) - (alist (list nil)) - (tail-alist alist)) - (while dlist - (let ((new-completed (truncate (* 100.0 (/ (setq cnt (1+ cnt)) len))))) - (when (> new-completed completed) - (setq completed new-completed) - (gnus-message 9 "%3d%% completed..." completed))) - (let* ((entry (car dlist)) - (article-number (nth 0 entry)) - (fetch-date (nth 1 entry)) - (keep (nth 2 entry)) - (marker (nth 3 entry))) - - (cond - ;; Kept articles are unread, marked, or special. - (keep - (when fetch-date - (unless (file-exists-p (concat dir (number-to-string article-number))) - (setf (nth 1 entry) nil) - (gnus-message 3 "gnus-agent-expire cleared download flag on article %d as the cached article file is missing." (caar dlist))) - (unless marker - (gnus-message 1 "gnus-agent-expire detected a missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) - (gnus-agent-append-to-list tail-alist (cons article-number fetch-date))) - - ;; The following articles are READ, UNMARKED, and ORDINARY. - ;; See if they can be EXPIRED!!! - ((setq type - (cond - ((not (integerp fetch-date)) - 'read) ;; never fetched article (may expire right now) - ((not (file-exists-p (concat dir (number-to-string article-number)))) - (setf (nth 1 entry) nil) - 'externally-expired) ;; Can't find the cached article. Handle case as though this article was never fetched. - - ;; We now have the arrival day, so we see - ;; whether it's old enough to be expired. - ((< fetch-date day) - 'expired) - (force - 'forced))) - - ;; I found some reason to expire this entry. - - (let ((actions nil)) - (when (memq type '(forced expired)) - (ignore-errors ; Just being paranoid. - (delete-file (concat dir (number-to-string article-number))) - (push "expired cached article" actions)) - (setf (nth 1 entry) nil) - ) - - (when marker - (push "NOV entry removed" actions) - (goto-char marker) - (gnus-delete-line)) - - ;; If considering all articles is set, I can only expire article IDs that are no longer in the active range. - (if (and gnus-agent-consider-all-articles - (>= article-number (car active))) - ;; I have to keep this ID in the alist - (gnus-agent-append-to-list tail-alist (cons article-number fetch-date)) - (push (format "Removed %s article number from article alist" type) actions)) - - (gnus-message 7 "gnus-agent-expire: Article %d: %s" article-number (mapconcat 'identity actions ", ")))) - (t - (gnus-agent-append-to-list tail-alist (cons article-number fetch-date))) - ) - - ;; Clean up markers as I want to recycle this buffer over several groups. - (when marker - (set-marker marker nil)) - - (setq dlist (cdr dlist)))) - - (setq alist (cdr alist)) - - (let ((inhibit-quit t)) - (unless (equal alist gnus-agent-article-alist) - (setq gnus-agent-article-alist alist) - (gnus-agent-save-alist expiring-group)) - - (when (buffer-modified-p) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-make-directory dir) - (write-region (point-min) (point-max) nov-file nil 'silent) - ;; clear the modified flag as that I'm not confused by its status on the next pass through this routine. - (set-buffer-modified-p nil))) - - (when (eq articles t) - (gnus-summary-update-info))))))))))) - (kill-buffer overview))))) - (gnus-message 4 "Expiry...done")) + (if (and (not gnus-agent-expire-days) + (or (not (eq articles t)) + (yes-or-no-p (concat "Are you sure that you want to expire all " + "articles in " (if group group + "every agentized group") + ".")))) + (gnus-agent-expire-1 articles group force) + (gnus-message 4 "Expiry...done"))) ;;;###autoload (defun gnus-agent-batch () @@ -2350,11 +2488,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)) -;; 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. + ;; Functionally, I don't need to construct a temp list using mapcar. (if (gnus-agent-load-alist group) (let* ((ref gnus-agent-article-alist) @@ -2407,14 +2550,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)) @@ -2435,21 +2583,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)) )))) @@ -2461,7 +2613,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)) @@ -2472,7 +2625,8 @@ FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." (gnus-agent-check-overview-buffer) (write-region (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) ) @@ -2510,7 +2664,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 "): ") @@ -2542,7 +2698,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) @@ -2557,7 +2714,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) @@ -2574,8 +2732,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) @@ -2606,14 +2765,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 f65665e..a06d41e 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -791,7 +791,7 @@ This is meant for people who want to view first matched part. For `undisplayed-alternative' (default), the first undisplayed part or alternative part is used. For `undisplayed', the first undisplayed part is used. For a function, the first part which -the function return `t' is used. For `nil', the first part is +the function return t is used. For nil, the first part is used." :version "21.1" :group 'gnus-article-mime @@ -1164,17 +1164,6 @@ See Info node `(gnus)Customizing Articles' and Info node :type gnus-article-treat-head-custom) (put 'gnus-treat-display-xface 'highlight t) -(defcustom gnus-treat-display-grey-xface - (and (not noninteractive) - (string-match "^0x" (shell-command-to-string "uncompface")) - t) - "Display grey X-Face headers. -Valid values are nil, t." - :group 'gnus-article-treat - :version "21.3" - :type 'boolean) -(put 'gnus-treat-display-grey-xface 'highlight t) - (defcustom gnus-treat-display-smileys (if (or (and (featurep 'xemacs) (featurep 'xpm)) @@ -1928,11 +1917,7 @@ unfolded." "Display any Face headers in the header." (interactive) (gnus-with-article-headers - (let ((face nil)) - (save-excursion - (when (gnus-buffer-live-p gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (setq face (message-fetch-field "face")))) + (let ((face (message-fetch-field "face"))) (when face (let ((png (gnus-convert-face-to-png face)) image) @@ -1959,7 +1944,7 @@ unfolded." ;; instead. (gnus-delete-images 'xface) ;; Display X-Faces. - (let (x-faces from face grey) + (let (x-faces from face) (save-excursion (when (and wash-face-p (progn @@ -1973,67 +1958,39 @@ unfolded." (set-buffer gnus-original-article-buffer)) (save-restriction (mail-narrow-to-head) - (if gnus-treat-display-grey-xface - (progn - (while (gnus-article-goto-header "X-Face\\(-[0-9]+\\)?") - (if (match-beginning 2) - (progn - (setq grey t) - (push (cons (- (string-to-number (match-string 2))) - (mail-header-field-value)) - x-faces)) - (push (cons 0 (mail-header-field-value)) x-faces))) - (dolist (x-face (prog1 - (if grey - (sort x-faces 'car-less-than-car) - (nreverse x-faces)) - (setq x-faces nil))) - (push (cdr x-face) x-faces))) - (while (gnus-article-goto-header "X-Face") - (push (mail-header-field-value) x-faces))) + (while (gnus-article-goto-header "X-Face") + (push (mail-header-field-value) x-faces)) (setq from (message-fetch-field "from")))) - (if grey - (let ((xpm (gnus-convert-gray-x-face-to-xpm x-faces)) - image) - (when xpm - (setq image (gnus-create-image xpm 'xpm t)) - (gnus-article-goto-header "from") - (when (bobp) - (insert "From: [no `from' set]\n") - (forward-char -17)) - (gnus-add-wash-type 'xface) - (gnus-add-image 'xface image) - (gnus-put-image image))) - ;; Sending multiple EOFs to xv doesn't work, so we only do a - ;; single external face. - (when (stringp gnus-article-x-face-command) - (setq x-faces (list (car x-faces)))) - (while (and (setq face (pop x-faces)) - gnus-article-x-face-command - (or force - ;; Check whether this face is censored. - (not gnus-article-x-face-too-ugly) - (and gnus-article-x-face-too-ugly from - (not (string-match gnus-article-x-face-too-ugly - from))))) - ;; We display the face. - (if (symbolp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (if (gnus-functionp gnus-article-x-face-command) - (funcall gnus-article-x-face-command face) - (error "%s is not a function" gnus-article-x-face-command)) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (process-kill-without-query - (start-process - "article-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (with-temp-buffer - (insert face) - (process-send-region "article-x-face" - (point-min) (point-max))) - (process-send-eof "article-x-face")))))))))) + ;; Sending multiple EOFs to xv doesn't work, so we only do a + ;; single external face. + (when (stringp gnus-article-x-face-command) + (setq x-faces (list (car x-faces)))) + (while (and (setq face (pop x-faces)) + gnus-article-x-face-command + (or force + ;; Check whether this face is censored. + (not gnus-article-x-face-too-ugly) + (and gnus-article-x-face-too-ugly from + (not (string-match gnus-article-x-face-too-ugly + from))))) + ;; We display the face. + (if (symbolp gnus-article-x-face-command) + ;; The command is a lisp function, so we call it. + (if (gnus-functionp gnus-article-x-face-command) + (funcall gnus-article-x-face-command face) + (error "%s is not a function" gnus-article-x-face-command)) + ;; The command is a string, so we interpret the command + ;; as a, well, command, and fork it off. + (let ((process-connection-type nil)) + (process-kill-without-query + (start-process + "article-x-face" nil shell-file-name shell-command-switch + gnus-article-x-face-command)) + (with-temp-buffer + (insert face) + (process-send-region "article-x-face" + (point-min) (point-max))) + (process-send-eof "article-x-face"))))))))) (defun article-decode-mime-words () "Decode all MIME-encoded words in the article." @@ -3090,6 +3047,7 @@ Directory to save to is default to `gnus-article-save-directory'." (save-restriction (widen) (if (and (file-readable-p filename) + (file-regular-p filename) (mail-file-babyl-p filename)) (rmail-output-to-rmail-file filename t) (gnus-output-to-mail filename))))) @@ -3453,9 +3411,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is (gnus-run-hooks 'gnus-article-menu-hook))) -;; Fixme: do something for the Emacs tool bar in Article mode a la -;; Summary. - (defun gnus-article-mode () "Major mode for displaying an article. @@ -3478,7 +3433,9 @@ commands: (make-local-variable 'minor-mode-alist) (use-local-map gnus-article-mode-map) (when (gnus-visual-p 'article-menu 'menu) - (gnus-article-make-menu-bar)) + (gnus-article-make-menu-bar) + (when gnus-summary-tool-bar-map + (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) (gnus-update-format-specifications nil 'article-mode) (set (make-local-variable 'page-delimiter) gnus-page-delimiter) (make-local-variable 'gnus-page-broken) @@ -3539,6 +3496,8 @@ commands: (setq gnus-article-mime-handle-alist 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)) @@ -4074,7 +4033,8 @@ If no internal viewer is available, use an external viewer." (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + gnus-newsgroup-ignored-charsets)) + buffer-read-only) (when handle (if (mm-handle-undisplayer handle) (mm-remove-part handle) @@ -4781,7 +4741,7 @@ Argument LINES specifies lines to be scrolled down." (let ((point (point))) (search-forward ">" nil t) ;Move point to end of "<....>". (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) - (let ((message-id (match-string 1))) + (let ((message-id (gnus-replace-in-string (match-string 1) "?\\)") (defun gnus-button-handle-describe-function (url) - "Call describe-function when pushing the corresponding URL button." + "Call `describe-function' when pushing the corresponding URL button." (describe-function (intern (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) (defun gnus-button-handle-describe-variable (url) - "Call describe-variable when pushing the corresponding URL button." + "Call `describe-variable' when pushing the corresponding URL button." (describe-variable (intern (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) -;; FIXME: Is is possible to implement this? Else it should be removed here -;; and in `gnus-button-alist'. (defun gnus-button-handle-describe-key (url) - "Call describe-key when pushing the corresponding URL button." - (error "not implemented")) + "Call `describe-key' when pushing the corresponding URL button." + (let* ((key-string + (gnus-replace-in-string url gnus-button-handle-describe-prefix "")) + (keys (ignore-errors (eval `(kbd ,key-string))))) + (if keys + (describe-key keys) + (gnus-message 3 "Invalid key sequence in button: %s" key-string)))) (defun gnus-button-handle-apropos (url) - "Call apropos when pushing the corresponding URL button." + "Call `apropos' when pushing the corresponding URL button." (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) (defun gnus-button-handle-apropos-command (url) - "Call apropos when pushing the corresponding URL button." + "Call `apropos' when pushing the corresponding URL button." (apropos-command (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) (defun gnus-button-handle-apropos-variable (url) - "Call apropos when pushing the corresponding URL button." + "Call `apropos' when pushing the corresponding URL button." (funcall (if (fboundp 'apropos-variable) 'apropos-variable 'apropos) (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) (defun gnus-button-handle-apropos-documentation (url) - "Call apropos when pushing the corresponding URL button." + "Call `apropos' when pushing the corresponding URL button." (funcall (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos) (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) @@ -5631,9 +5594,10 @@ positives are possible." 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2) ("\\b\\(C-h\\|?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2) - ("\\b\\(C-h\\|?\\)[ \t\n]+k[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+" 0 - ;; this regexp needs to be fixed! - (>= gnus-button-emacs-level 9) gnus-button-handle-describe-key 2) + ("`\\(\\b\\(C-h\\|?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'" 1 + ;; Unlike the other regexps we really have to require quoting + ;; here to determine where it ends. + (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 1 t gnus-button-embedded-url 1) ;; Raw URLs. diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el index 5dac280..0a8a798 100644 --- a/lisp/gnus-async.el +++ b/lisp/gnus-async.el @@ -1,5 +1,6 @@ ;;; gnus-async.el --- asynchronous support for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-audio.el b/lisp/gnus-audio.el index af10d58..12366ab 100644 --- a/lisp/gnus-audio.el +++ b/lisp/gnus-audio.el @@ -1,5 +1,5 @@ ;;; gnus-audio.el --- Sound effects for Gnus -;; Copyright (C) 1996, 2000 Free Software Foundation +;; Copyright (C) 1996, 2000, 2003 Free Software Foundation ;; Author: Steven L. Baur ;; Keywords: news, mail, multimedia diff --git a/lisp/gnus-bcklg.el b/lisp/gnus-bcklg.el index 400dbd5..458bd2d 100644 --- a/lisp/gnus-bcklg.el +++ b/lisp/gnus-bcklg.el @@ -1,5 +1,5 @@ ;;; gnus-bcklg.el --- backlog functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -58,7 +58,7 @@ "Clear all backlog variables and buffers." (interactive) (when (get-buffer gnus-backlog-buffer) - (kill-buffer gnus-backlog-buffer)) + (gnus-kill-buffer gnus-backlog-buffer)) (setq gnus-backlog-hashtb nil gnus-backlog-articles nil)) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index a0763f3..e293a80 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -1,5 +1,5 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 529535c..f3e53a2 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,6 +1,6 @@ ;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Per Abhiddenware @@ -41,19 +41,6 @@ :link '(custom-manual "(gnus)Article Highlighting") :group 'gnus-article) -(defcustom gnus-cite-reply-regexp - "^\\(Subject: Re\\|In-Reply-To\\|References\\):" - "*If headers match this regexp it is reasonable to believe that -article has citations." - :group 'gnus-cite - :type 'string) - -(defcustom gnus-cite-always-check nil - "Check article always for citations. Set it t to check all articles." - :group 'gnus-cite - :type '(choice (const :tag "no" nil) - (const :tag "yes" t))) - (defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n" "Format of opened cited text buttons." :group 'gnus-cite diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 79f8dd1..2f80b47 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -1,6 +1,7 @@ ;;; gnus-cus.el --- customization commands for Gnus ;; -;; Copyright (C) 1996, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Keywords: news @@ -130,7 +131,7 @@ All posts will be sent to the specified group.") (string :format "%v" :hide-front-space t)) "\ Specify default value for GCC header. -If this symbol is present in the group parameter list and set to `t', +If this symbol is present in the group parameter list and set to t, new composed messages will be `Gcc''d to the current group. If it is present and set to `none', no `Gcc:' header will be generated, if it is present and a string, this string will be inserted literally as a @@ -338,7 +339,7 @@ Set variables local to the group you are entering. If you want to turn threading off in `news.answers', you could put `(gnus-show-threads nil)' in the group parameters of that group. `gnus-show-threads' will be made into a local variable in the summary -buffer you enter, and the form `nil' will be `eval'ed there. +buffer you enter, and the form nil will be `eval'ed there. This can also be used as a group-specific hook function, if you'd like. If you want to hear a beep when you enter a group, you could @@ -451,15 +452,15 @@ by ordinary scoring rules.") (sexp :format "%v" :hide-front-space t)) "\ This entry controls the adaptive scoring. -If it is `t', the default adaptive scoring rules will be used. If it +If it is t, the default adaptive scoring rules will be used. If it is `ignore', no adaptive scoring will be performed on this group. If it is a list, this list will be used as the adaptive scoring rules. -If it isn't present, or is something other than `t' or `ignore', the +If it isn't present, or is something other than t or `ignore', the default adaptive scoring rules will be used. If you want to use adaptive scoring on most groups, you'd set `gnus-use-adaptive-scoring' -to `t', and insert an `(adapt ignore)' in the groups where you do not +to t, and insert an `(adapt ignore)' in the groups where you do not want adaptive scoring. If you only want adaptive scoring in a few -groups, you'd set `gnus-use-adaptive-scoring' to `nil', and insert +groups, you'd set `gnus-use-adaptive-scoring' to nil, and insert `(adapt t)' in the score files of the groups where you want it.") (adapt-file (file :tag "Adapt-file") "\ diff --git a/lisp/gnus-delay.el b/lisp/gnus-delay.el index cb4fc91..4024a00 100644 --- a/lisp/gnus-delay.el +++ b/lisp/gnus-delay.el @@ -1,6 +1,6 @@ ;;; gnus-delay.el --- Delayed posting of articles -;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Kai Großjohann ;; Keywords: mail, news, extensions @@ -132,7 +132,12 @@ DELAY is a string, giving the length of the time. Possible values are: (t (error "Malformed delay `%s'" delay))) (message-add-header (format "%s: %s" gnus-delay-header deadline))) (set-buffer-modified-p t) - (nndraft-request-create-group gnus-delay-group) + ;; If group does not exist, create it. + (let ((group (format "nndraft:%s" gnus-delay-group))) + (unless (gnus-gethash group gnus-newsrc-hashtb) + (nndraft-request-create-group gnus-delay-group) + ;; Make it active. + (gnus-set-active group (cons 1 0)))) (message-disassociate-draft) (nndraft-request-associate-buffer gnus-delay-group) (save-buffer 0) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index b619f8b..6c9c13c 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -1,5 +1,5 @@ ;;; gnus-draft.el --- draft message support for Gnus -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -186,6 +186,7 @@ (cdr (assq 'unsend (gnus-info-marks (gnus-get-info "nndraft:queue")))))) + (gnus-posting-styles nil) (total (length articles)) article) (while (setq article (pop articles)) diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el index b2cf411..9fcb839 100644 --- a/lisp/gnus-fun.el +++ b/lisp/gnus-fun.el @@ -1,5 +1,5 @@ ;;; gnus-fun.el --- various frivoluos extension functions to Gnus -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -103,7 +103,6 @@ Output to the current buffer, replace text, and don't mingle error." (when (file-exists-p file) (let ((done nil) (attempt "") - (step 72) (quant 16)) (while (and (not done) (> quant 1)) @@ -121,125 +120,44 @@ Output to the current buffer, replace text, and don't mingle error." (if done (mm-with-unibyte-buffer (insert attempt) - (base64-encode-region (point-min) (point-max)) - (goto-char (point-min)) - (while (search-forward "\n" nil t) - (replace-match "")) - (goto-char (point-min)) - (while (> (- (point-max) (point)) - step) - (forward-char step) - (insert "\n ") - (setq step 76)) - (buffer-string)) + (gnus-face-encode)) nil)))) +(defun gnus-face-encode () + (let ((step 72)) + (base64-encode-region (point-min) (point-max)) + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (> (- (point-max) (point)) + step) + (forward-char step) + (insert "\n ") + (setq step 76)) + (buffer-string))) + ;;;###autoload (defun gnus-convert-face-to-png (face) + "Convert FACE (which is base64-encoded) to a PNG. +The PNG is returned as a string." (mm-with-unibyte-buffer (insert face) (ignore-errors (base64-decode-region (point-min) (point-max))) (buffer-string))) -(defun gnus-convert-image-to-gray-x-face (file depth) - (let* ((mapfile (mm-make-temp-file (expand-file-name "gnus." - mm-tmp-directory))) - (levels (expt 2 depth)) - (step (/ 255 (1- levels))) - color-alist bits bits-list mask pixel x-faces) - (with-temp-file mapfile - (insert "P3\n") - (insert (format "%d 1\n" levels)) - (insert "255\n") - (dotimes (i levels) - (insert (format "%d %d %d\n" - (* step i) (* step i) (* step i))) - (push (cons (* step i) i) color-alist))) - (when (file-exists-p file) - (with-temp-buffer - (insert (gnus-shell-command-to-string - (format "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant -fs -map %s | ppmtopgm | pnmnoraw" - (shell-quote-argument file) - mapfile))) - (goto-char (point-min)) - (forward-line 3) - (while (setq pixel (ignore-errors (read (current-buffer)))) - (push (cdr (assq pixel color-alist)) bits-list)) - (setq bits-list (nreverse bits-list)) - (dotimes (bit-number depth) - (setq mask (expt 2 bit-number)) - (with-temp-buffer - (insert "P1\n48 48\n") - (dolist (bits bits-list) - (insert (if (zerop (logand bits mask)) "0 " "1 "))) - (gnus-shell-command-on-region - (point-min) (point-max) - ;; the following is taken from xbmtoikon: - "pbmtoicon | sed '/^[ ]*[*\\\\/]/d; s/[ ]//g; s/,$//' | tr , '\\012' | sed 's/^0x//; s/^/0x/' | pr -l1 -t -w22 -3 -s, | sed 's/,*$/,/' | compface") - (push (buffer-string) x-faces)))) - (dotimes (i (length x-faces)) - (insert (if (zerop i) "X-Face:" (format "X-Face-%s:" i)) - (nth i x-faces)))) - (delete-file mapfile))) - -;;;###autoload -(defun gnus-convert-gray-x-face-to-xpm (faces) - (let* ((depth (length faces)) - (scale (/ 255 (1- (expt 2 depth)))) - (ok-p t) - (coding-system-for-read 'binary) - (coding-system-for-write 'binary) - default-enable-multibyte-characters - start bit-array bit-arrays pixel) - (with-temp-buffer - (dolist (face faces) - (erase-buffer) - (insert (uncompface face)) - (gnus-shell-command-on-region - (point-min) (point-max) - "pnmnoraw") - (goto-char (point-min)) - (forward-line 2) - (setq start (point)) - (insert "[") - (while (not (eobp)) - (forward-char 1) - (insert " ")) - (insert "]") - (goto-char start) - (setq bit-array (read (current-buffer))) - (unless (= (length bit-array) (* 48 48)) - (setq ok-p nil)) - (push bit-array bit-arrays)) - (when ok-p - (erase-buffer) - (insert "P2\n48 48\n255\n") - (dotimes (i (* 48 48)) - (setq pixel 0) - (dotimes (plane depth) - (setq pixel (+ (* pixel 2) (aref (nth plane bit-arrays) i)))) - (insert (number-to-string (* scale pixel)) " ")) - (gnus-shell-command-on-region - (point-min) (point-max) - "ppmtoxpm") - (buffer-string))))) - -;;;###autoload -(defun gnus-convert-gray-x-face-region (beg end) - "Convert the X-Faces in region to a PPM file." - (interactive "r") - (let ((input (buffer-substring beg end)) - faces) - (with-temp-buffer - (insert input) - (goto-char (point-min)) - (while (not (eobp)) - (save-restriction - (mail-header-narrow-to-field) - (push (mail-header-field-value) faces) - (goto-char (point-max))))) - (gnus-convert-gray-x-face-to-xpm faces))) +;;;#autoload +(defun gnus-convert-png-to-face (file) + "Convert FILE to a Face. +FILE should be a PNG file that's 48x48 and smaller than or equal to +740 bytes." + (mm-with-unibyte-buffer + (insert-file-contents file) + (when (> (buffer-size) 740) + (error "The file is %d bytes long, which is too long" + (buffer-size))) + (gnus-face-encode))) (defface gnus-x-face '((t (:foreground "black" :background "white"))) "Face to show X-Face. @@ -290,23 +208,25 @@ colors of the displayed X-Faces." (delete-file file) (buffer-string)))) -(defun gnus-grab-gray-x-face () +(defun gnus-grab-cam-face () "Grab a picture off the camera and make it into an X-Face." (interactive) (shell-command "xawtv-remote snap ppm") - (let ((file nil)) + (let ((file nil) + result) (while (null (setq file (directory-files "/tftpboot/sparky/tmp" t "snap.*ppm"))) (sleep-for 1)) (setq file (car file)) - (with-temp-buffer - (shell-command - (format "pnmcut -left 70 -top 100 -width 144 -height 144 '%s' | ppmquant 256 2>/dev/null | ppmtogif > '%s.gif'" - file file) - (current-buffer)) - (delete-file file)) - (gnus-convert-image-to-gray-x-face (concat file ".gif") 3) - (delete-file (concat file ".gif")))) + (shell-command + (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>/dev/null | ppmnorm | ppmtopgm | pnmscale -width 48 -height 48 > /tmp/gnus.face.ppm" + file)) + (let ((gnus-convert-image-to-face-command + "cat '%s' | ppmquant %d | pnmtopng")) + (setq result (gnus-face-from-file "/tmp/gnus.face.ppm"))) + (delete-file file) + ;;(delete-file "/tmp/gnus.face.ppm") + result)) (provide 'gnus-fun) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 2cca870..3c0b6cd 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -2221,7 +2221,9 @@ ADDRESS." (require backend)) (gnus-check-server meth) (when (gnus-check-backend-function 'request-create-group nname) - (gnus-request-create-group nname nil args)) + (unless (gnus-request-create-group nname nil args) + (error "Could not create group on server: %s" + (nnheader-get-report backend)))) t)) (defun gnus-group-delete-groups (&optional arg) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 3536822..ca5539b 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -1,5 +1,5 @@ ;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -44,13 +44,16 @@ "The default status if the server is not able to open. If the server is covered by Gnus agent, the possible values are `denied', set the server denied; `offline', set the server offline; -`nil', ask user. If the server is not covered by Gnus agent, set the +nil, ask user. If the server is not covered by Gnus agent, set the server denied." :group 'gnus-start :type '(choice (const :tag "Ask" nil) (const :tag "Deny server" denied) (const :tag "Unplugg Agent" offline))) +(defvar gnus-internal-registry-spool-current-method nil + "The current method, for the registry.") + ;;; ;;; Server Communication ;;; @@ -487,9 +490,11 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (gnus-inhibit-demon t) (mail-source-plugged gnus-plugged)) (if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-scan) - (and group (gnus-group-real-name group)) - (nth 1 gnus-command-method))))) + (progn + (setq gnus-internal-registry-spool-current-method gnus-command-method) + (funcall (gnus-get-function gnus-command-method 'request-scan) + (and group (gnus-group-real-name group)) + (nth 1 gnus-command-method)))))) (defsubst gnus-request-update-info (info gnus-command-method) "Request that GNUS-COMMAND-METHOD update INFO." diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index d219a9d..b22d3ef 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -283,6 +283,11 @@ If nil, the address field will always be empty after invoking :group 'gnus-message :type 'boolean) +(defcustom gnus-version-expose-system nil + "If non-nil, `system-configuration' is exposed in `gnus-extended-version'." + :group 'gnus-message + :type 'boolean) + ;;; Internal variables. (defvar gnus-inhibit-posting-styles nil @@ -1022,13 +1027,15 @@ If SILENT, don't prompt the user." "Stringified Gnus version and Emacs version." (interactive) (concat - "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t) + "Gnus/" (gnus-prin1-to-string (gnus-continuum-version gnus-version)) " (" gnus-version ")" " " (cond ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) (concat "Emacs/" (match-string 1 emacs-version) - " (" system-configuration ")")) + (if gnus-version-expose-system + " (" system-configuration ")" + ""))) ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" emacs-version) (concat (match-string 1 emacs-version) @@ -1037,8 +1044,10 @@ If SILENT, don't prompt the user." (match-string 3 emacs-version) "") (if (boundp 'xemacs-codename) + (if gnus-version-expose-system (concat " (" xemacs-codename ", " system-configuration ")") - ""))) + (concat " (" xemacs-codename ")")) + ""))) (t emacs-version)))) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el new file mode 100644 index 0000000..79b4ad5 --- /dev/null +++ b/lisp/gnus-registry.el @@ -0,0 +1,62 @@ +;;; gnus-registry.el --- article registry for Gnus +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. + +;; Author: Ted Zlatanov +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(eval-when-compile (require 'cl)) + +(require 'gnus) +(require 'gnus-int) +(require 'gnus-sum) +(require 'nnmail) + +;; (defcustom gnus-summary-article-spool-hook nil +;; "*A hook called after an article is spooled." +;; :group 'gnus-summary +;; :type 'hook) + +(defun regtest (action id from &optional to method) + (message "Registry: article %s %s from %s to %s" + id + (if method "respooling" "going") + (gnus-group-guess-full-name from) + (if to (gnus-group-guess-full-name to) "the Bit Bucket in the sky"))) + +(defun regtest-nnmail (id group) + (message "Registry: article %s spooled to %s" + id + (gnus-group-prefixed-name group gnus-internal-registry-spool-current-method t))) + +;;(add-hook 'gnus-summary-article-move-hook 'regtest) ; also does copy, respool, and crosspost +;;(add-hook 'gnus-summary-article-delete-hook 'regtest) +;;(add-hook 'gnus-summary-article-expire-hook 'regtest) +(add-hook 'nnmail-spool-hook 'regtest-nnmail) + +;; TODO: + +(provide 'gnus-registry) + +;;; gnus-registry.el ends here diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index e1a6120..7733f9d 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1,5 +1,5 @@ ;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen @@ -1484,7 +1484,7 @@ EXTRA is the possible non-standard header." (with-current-buffer gnus-summary-buffer (setq gnus-newsgroup-scored scored)))) ;; Remove the buffer. - (kill-buffer (current-buffer))) + (gnus-kill-buffer (current-buffer))) ;; Add articles to `gnus-newsgroup-scored'. (while gnus-scores-articles @@ -1509,7 +1509,7 @@ EXTRA is the possible non-standard header." "Lower the score on THREAD with SCORE-ADJUST. THREAD is expected to contain a list of the form `(PARENT [CHILD1 CHILD2 ...])' where PARENT is a header array and each CHILD is a list -of the same form as THREAD. The empty list `nil' is valid. For each +of the same form as THREAD. The empty list nil is valid. For each article in the tree, the score of the corresponding entry in `gnus-newsgroup-scored' is adjusted by SCORE-ADJUST." (while thread @@ -1916,7 +1916,7 @@ score in `gnus-newsgroup-scored' by SCORE." ;; with working on them as a group. What a hassle. ;; Just wait 'til you see what horrors we commit against `match'... (if (= gnus-score-index 9) - (setq this (prin1-to-string this))) ; ick. + (setq this (gnus-prin1-to-string this))) ; ick. (if simplify (setq this (gnus-map-function gnus-simplify-subject-functions this))) @@ -2633,7 +2633,7 @@ GROUP using BNews sys file syntax." (ignore-errors (string-match regexp group-trans)))) (push (car sfiles) ofiles))) (setq sfiles (cdr sfiles))) - (kill-buffer (current-buffer)) + (gnus-kill-buffer (current-buffer)) ;; Slight kludge here - the last score file returned should be ;; the local score file, whether it exists or not. This is so ;; that any score commands the user enters will go to the right diff --git a/lisp/gnus-sieve.el b/lisp/gnus-sieve.el index 106160c..d4e557c 100644 --- a/lisp/gnus-sieve.el +++ b/lisp/gnus-sieve.el @@ -1,5 +1,5 @@ ;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2003 Free Software Foundation, Inc. ;; Author: NAGY Andras , ;; Simon Josefsson diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 3f2ec2f..ce3fcb5 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -1,5 +1,5 @@ ;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 6fb9c43..77596ea 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -359,7 +359,7 @@ The following commands are available: (when entry (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string (cdr entry)) ")\n"))) + (gnus-prin1-to-string (cdr entry)) ")\n"))) (when (or entry oentry) ;; Buffer may be narrowed. (save-restriction @@ -378,7 +378,7 @@ The following commands are available: (when (and server info) (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string info) ")")) + (gnus-prin1-to-string info) ")")) (let* ((server (nth 1 info)) (entry (assoc server gnus-server-alist)) (cached (assoc server gnus-server-method-cache))) @@ -445,7 +445,7 @@ The following commands are available: "Return to the group buffer." (interactive) (gnus-run-hooks 'gnus-server-exit-hook) - (kill-buffer (current-buffer)) + (gnus-kill-buffer (current-buffer)) (gnus-configure-windows 'group t)) (defun gnus-server-list-servers () @@ -926,7 +926,7 @@ buffer. "Quit browsing and return to the group buffer." (interactive) (when (eq major-mode 'gnus-browse-mode) - (kill-buffer (current-buffer))) + (gnus-kill-buffer (current-buffer))) ;; Insert the newly subscribed groups in the group buffer. (save-excursion (set-buffer gnus-group-buffer) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 124ac58..0d3e7b0 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,5 +1,5 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -654,9 +654,8 @@ the first newsgroup." (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) (gnus-kill-buffer nntp-server-buffer) ;; Kill Gnus buffers. - (let ((buffers (gnus-buffers))) - (when buffers - (mapcar 'kill-buffer buffers))) + (dolist (buffer (gnus-buffers)) + (gnus-kill-buffer buffer)) ;; Remove Gnus frames. (gnus-kill-gnus-frames)) @@ -2552,7 +2551,7 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-run-hooks 'gnus-save-quick-newsrc-hook) (let ((coding-system-for-write gnus-ding-file-coding-system)) (save-buffer)) - (kill-buffer (current-buffer)) + (gnus-kill-buffer (current-buffer)) (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)) (gnus-dribble-delete-file) @@ -2569,7 +2568,7 @@ If FORCE is non-nil, the .newsrc file is read." ;; Never delete this file -- if you want to force Gnus to read the ;; .newsrc file (if you have one), touch .newsrc instead.\n") (insert "(setq gnus-newsrc-file-version " - (prin1-to-string gnus-version) ")\n") + (gnus-prin1-to-string gnus-version) ")\n") (let* ((gnus-killed-list (if (and gnus-save-killed-list (stringp gnus-save-killed-list)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 0ff298e..a1caf01 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -847,6 +847,21 @@ automatically when it is selected." :group 'gnus-summary :type 'hook) +(defcustom gnus-summary-article-move-hook nil + "*A hook called after an article is moved, copied, respooled, or crossposted." + :group 'gnus-summary + :type 'hook) + +(defcustom gnus-summary-article-delete-hook nil + "*A hook called after an article is deleted." + :group 'gnus-summary + :type 'hook) + +(defcustom gnus-summary-article-expire-hook nil + "*A hook called after an article is expired." + :group 'gnus-summary + :type 'hook) + (defcustom gnus-summary-display-arrow (and (fboundp 'display-graphic-p) (display-graphic-p)) @@ -1392,26 +1407,24 @@ For example: (defun gnus-simplify-whitespace (str) "Remove excessive whitespace from STR." - (let ((mystr str)) - ;; Multiple spaces. - (while (string-match "[ \t][ \t]+" mystr) - (setq mystr (concat (substring mystr 0 (match-beginning 0)) - " " - (substring mystr (match-end 0))))) - ;; Leading spaces. - (when (string-match "^[ \t]+" mystr) - (setq mystr (substring mystr (match-end 0)))) - ;; Trailing spaces. - (when (string-match "[ \t]+$" mystr) - (setq mystr (substring mystr 0 (match-beginning 0)))) - mystr)) + ;; Multiple spaces. + (while (string-match "[ \t][ \t]+" str) + (setq str (concat (substring str 0 (match-beginning 0)) + " " + (substring str (match-end 0))))) + ;; Leading spaces. + (when (string-match "^[ \t]+" str) + (setq str (substring str (match-end 0)))) + ;; Trailing spaces. + (when (string-match "[ \t]+$" str) + (setq str (substring str 0 (match-beginning 0)))) + str) (defun gnus-simplify-all-whitespace (str) "Remove all whitespace from STR." - (let ((mystr str)) - (while (string-match "[ \t\n]+" mystr) - (setq mystr (replace-match "" nil nil mystr))) - mystr)) + (while (string-match "[ \t\n]+" str) + (setq str (replace-match "" nil nil str))) + str) (defsubst gnus-simplify-subject-re (subject) "Remove \"Re:\" from subject lines." @@ -2344,7 +2357,8 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Kill" gnus-summary-kill-process-mark t] ["Yank" gnus-summary-yank-process-mark gnus-newsgroup-process-stack] - ["Save" gnus-summary-save-process-mark t])) + ["Save" gnus-summary-save-process-mark t] + ["Run command on marked..." gnus-summary-universal-argument t])) ("Scroll article" ["Page forward" gnus-summary-next-page ,@(if (featurep 'xemacs) '(t) @@ -2399,7 +2413,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["See old articles" gnus-summary-insert-old-articles t] ["See new articles" gnus-summary-insert-new-articles t] ["Filter articles..." gnus-summary-execute-command t] - ["Run command on subjects..." gnus-summary-universal-argument t] + ["Run command on articles..." gnus-summary-universal-argument t] ["Search articles forward..." gnus-summary-search-article-forward t] ["Search articles backward..." gnus-summary-search-article-backward t] ["Toggle line truncation" gnus-summary-toggle-truncation t] @@ -4927,13 +4941,13 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-activate-group group) ; Or we can activate it... (progn ; Or we bug out. (when (equal major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))) + (gnus-kill-buffer (current-buffer))) (error "Couldn't activate group %s: %s" group (gnus-status-message group)))) (unless (gnus-request-group group t) (when (equal major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))) + (gnus-kill-buffer (current-buffer))) (error "Couldn't request group %s: %s" group (gnus-status-message group))) @@ -6094,23 +6108,23 @@ Also do horizontal recentering." If `gnus-auto-center-summary' is nil, or the article buffer isn't displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). -;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. + ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. (interactive) - (let* ((top (cond ((< (window-height) 4) 0) - ((< (window-height) 7) 1) - (t (if (numberp gnus-auto-center-summary) - gnus-auto-center-summary - 2)))) - (height (1- (window-height))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point))) - (window (get-buffer-window (current-buffer)))) - ;; The user has to want it. - (when gnus-auto-center-summary + ;; The user has to want it. + (when gnus-auto-center-summary + (let* ((top (cond ((< (window-height) 4) 0) + ((< (window-height) 7) 1) + (t (if (numberp gnus-auto-center-summary) + gnus-auto-center-summary + 2)))) + (height (1- (window-height))) + (bottom (save-excursion (goto-char (point-max)) + (forward-line (- height)) + (point))) + (window (get-buffer-window (current-buffer)))) (when (get-buffer-window gnus-article-buffer) ;; Only do recentering when the article buffer is displayed, - ;; Set the window start to either `bottom', which is the biggest + ;; Set the window start to either `bottom', which is the biggest ;; possible valid number, or the second line from the top, ;; whichever is the least. (let ((top-pos (save-excursion (forward-line (- top)) (point)))) @@ -7940,16 +7954,16 @@ of what's specified by the `gnus-refer-thread-limit' variable." (let ((id (mail-header-id (gnus-summary-article-header))) (limit (if limit (prefix-numeric-value limit) gnus-refer-thread-limit))) - ;; We want to fetch LIMIT *old* headers, but we also have to - ;; re-fetch all the headers in the current buffer, because many of - ;; them may be undisplayed. So we adjust LIMIT. - (when (numberp limit) - (incf limit (- gnus-newsgroup-end gnus-newsgroup-begin))) (unless (eq gnus-fetch-old-headers 'invisible) (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) ;; Retrieve the headers and read them in. (if (eq (gnus-retrieve-headers - (list gnus-newsgroup-end) gnus-newsgroup-name limit) + (list (min + (+ (mail-header-number + (gnus-summary-article-header)) + limit) + gnus-newsgroup-end)) + gnus-newsgroup-name (* limit 2)) 'nov) (gnus-build-all-threads) (error "Can't fetch thread from backends that don't support NOV")) @@ -8199,6 +8213,12 @@ Optional argument BACKWARD means do search for backward. (gnus-use-article-prefetch nil) (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. (gnus-use-trees nil) ;Inhibit updating tree buffer. + (gnus-visual nil) + (gnus-keep-backlog nil) + (gnus-break-pages nil) + (gnus-summary-display-arrow nil) + (gnus-updated-mode-lines nil) + (gnus-auto-center-summary nil) (sum (current-buffer)) (gnus-display-mime-function nil) (found nil) @@ -8753,8 +8773,14 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (nnheader-get-report (car to-method)))) ((eq art-group 'junk) (when (eq action 'move) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article))) + (let ((id (mail-header-id (gnus-data-header + (assoc article (gnus-data-list nil)))))) + (gnus-summary-mark-article article gnus-canceled-mark) + (gnus-message 4 "Deleted article %s" article) + ;; run the move/copy/crosspost/respool hook + (run-hook-with-args 'gnus-summary-article-delete-hook + action id gnus-newsgroup-name nil + select-method)))) (t (let* ((pto-group (gnus-group-prefixed-name (car art-group) to-method)) @@ -8832,7 +8858,14 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-request-article-this-buffer article gnus-newsgroup-name) (nnheader-replace-header "Xref" new-xref) (gnus-request-replace-article - article gnus-newsgroup-name (current-buffer))))) + article gnus-newsgroup-name (current-buffer)))) + + ;; run the move/copy/crosspost/respool hook + (let ((id (mail-header-id (gnus-data-header + (assoc article (gnus-data-list nil)))))) + (run-hook-with-args 'gnus-summary-article-move-hook + action id gnus-newsgroup-name to-newsgroup + select-method))) ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) @@ -9053,7 +9086,13 @@ This will be the case if the article has both been mailed and posted." (dolist (article expirable) (when (and (not (memq article es)) (gnus-data-find article)) - (gnus-summary-mark-article article gnus-canceled-mark)))))) + (gnus-summary-mark-article article gnus-canceled-mark) + (let ((id (mail-header-id (gnus-data-header + (assoc article + (gnus-data-list nil)))))) + (run-hook-with-args 'gnus-summary-article-expire-hook + 'delete id gnus-newsgroup-name nil + nil))))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -9102,6 +9141,12 @@ delete these instead." ;; after all. (unless (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) + (let* ((article (car articles)) + (id (mail-header-id (gnus-data-header + (assoc article (gnus-data-list nil)))))) + (run-hook-with-args 'gnus-summary-article-delete-hook + 'delete id gnus-newsgroup-name nil + nil)) (setq articles (cdr articles))) (when not-deleted (gnus-message 4 "Couldn't delete articles %s" not-deleted))) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 338afb5..9d656b8 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -1,5 +1,5 @@ ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Ilja Weis @@ -461,7 +461,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (unless gnus-killed-hashtb (gnus-make-hashtable-from-killed)) (gnus-group-prepare-flat-list-dead - (gnus-delete-if (lambda (group) + (gnus-remove-if (lambda (group) (or (gnus-gethash group gnus-newsrc-hashtb) (gnus-gethash group gnus-killed-hashtb))) not-in-list) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 5bb2744..e844fa7 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1,5 +1,5 @@ ;;; gnus-util.el --- utility functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -127,6 +127,8 @@ (defmacro gnus-kill-buffer (buffer) `(let ((buf ,buffer)) (when (gnus-buffer-exists-p buf) + (when (boundp 'gnus-buffers) + (setq gnus-buffers (delete (get-buffer buf) gnus-buffers))) (kill-buffer buf)))) (defalias 'gnus-point-at-bol @@ -627,9 +629,13 @@ Bind `print-quoted' and `print-readably' to t while printing." (prin1 form (current-buffer)))) (defun gnus-prin1-to-string (form) - "The same as `prin1', but bind `print-quoted' and `print-readably' to t." + "The same as `prin1'. +Bind `print-quoted' and `print-readably' to t, and `print-length' +and `print-level' to nil." (let ((print-quoted t) - (print-readably t)) + (print-readably t) + (print-length nil) + (print-level nil)) (prin1-to-string form))) (defun gnus-make-directory (directory) @@ -901,17 +907,14 @@ with potentially long computations." (defun gnus-map-function (funs arg) "Applies the result of the first function in FUNS to the second, and so on. ARG is passed to the first function." - (let ((myfuns funs)) - (while myfuns - (setq arg (funcall (pop myfuns) arg))) - arg)) + (while funs + (setq arg (funcall (pop funs) arg))) + arg) (defun gnus-run-hooks (&rest funcs) - "Does the same as `run-hooks', but saves excursion." - (let ((buf (current-buffer))) - (unwind-protect - (apply 'run-hooks funcs) - (set-buffer buf)))) + "Does the same as `run-hooks', but saves the current buffer." + (save-current-buffer + (apply 'run-hooks funcs))) ;;; Various @@ -925,20 +928,20 @@ ARG is passed to the first function." (eq major-mode 'gnus-group-mode)))) (defun gnus-remove-duplicates (list) - (let (new (tail list)) - (while tail - (or (member (car tail) new) - (setq new (cons (car tail) new))) - (setq tail (cdr tail))) + (let (new) + (while list + (or (member (car list) new) + (setq new (cons (car list) new))) + (setq list (cdr list))) (nreverse new))) -(defun gnus-delete-if (predicate list) - "Delete elements from LIST that satisfy PREDICATE." +(defun gnus-remove-if (predicate list) + "Return a copy of LIST with all items satisfying PREDICATE removed." (let (out) (while list (unless (funcall predicate (car list)) (push (car list) out)) - (pop list)) + (setq list (cdr list))) (nreverse out))) (if (fboundp 'assq-delete-all) @@ -1059,7 +1062,7 @@ Return the modified alist." (defcustom gnus-use-byte-compile t "If non-nil, byte-compile crucial run-time codes. -Setting it to `nil' has no effect after first time running +Setting it to nil has no effect after first time running `gnus-byte-compile'." :type 'boolean :version "21.1" diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el index cd9ef74..71d3dba 100644 --- a/lisp/gnus-win.el +++ b/lisp/gnus-win.el @@ -1,5 +1,5 @@ ;;; gnus-win.el --- window configuration functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -571,7 +571,7 @@ should have point." (memq frame '(t 0 visible))) (car (let ((frames (gnus-frames-on-display-list))) - (gnus-delete-if (lambda (win) (not (memq (window-frame win) + (gnus-remove-if (lambda (win) (not (memq (window-frame win) frames))) (get-buffer-window-list buffer nil frame))))) (t diff --git a/lisp/gnus.el b/lisp/gnus.el index 67379cb..d8743c8 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -59,6 +59,10 @@ :link '(custom-manual "(gnus)Article Caching") :group 'gnus) +(defgroup gnus-registry nil + "Article Registry." + :group 'gnus) + (defgroup gnus-start nil "Starting your favorite newsreader." :group 'gnus) @@ -282,7 +286,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.14" +(defconst gnus-version-number "0.15" "Version number for this version of Gnus.") (defconst gnus-version (format "Oort Gnus v%s" gnus-version-number) @@ -961,7 +965,7 @@ For example: (defmacro gnus-define-group-parameter (param &rest rest) "Define a group parameter PARAM. REST is a plist of following: -:type One of `bool', `list' or `nil'. +:type One of `bool', `list' or nil. :function The name of the function. :function-document The documentation of the function. :parameter-type The type for customizing the parameter. @@ -1336,7 +1340,7 @@ newsgroups." "*The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, confirmation is required for selecting the newsgroup. -If it is `nil', no confirmation is required." +If it is nil, no confirmation is required." :group 'gnus-group-select :type '(choice (const :tag "No limit" nil) integer)) @@ -1741,7 +1745,7 @@ posting an article." This number will be prompted as the initial value of the number of articles to list when the group is a large newsgroup (see -`gnus-large-newsgroup'). If it is `nil', the default value is the +`gnus-large-newsgroup'). If it is nil, the default value is the total number of articles in the group.") ;; group parameters for spam processing added by Ted Zlatanov @@ -1787,13 +1791,13 @@ This only makes sense for mail groups." (choice (variable-item gnus-group-spam-classification-spam) (variable-item gnus-group-spam-classification-ham) - (other :tag "Unclassified" nil)))) + (const :tag "Unclassified" nil)))) :parameter-type '(list :tag "Group contents spam/ham classification" (choice :tag "Group contents classification for spam sorting" (variable-item gnus-group-spam-classification-spam) (variable-item gnus-group-spam-classification-ham) - (other :tag "Unclassified" nil))) + (const :tag "Unclassified" nil))) :parameter-document "The spam classification (spam, ham, or neither) of this group. When a spam group is entered, all unread articles are marked as spam.") @@ -1881,7 +1885,7 @@ for mail groups." spam-process-destination :parameter-type '(choice :tag "Destination for spam-processed articles at summary exit" (string :tag "Move to a group") - (other :tag "Expire" nil)) + (const :tag "Expire" nil)) :function-document "Where spam-processed articles will go at summary exit." :variable gnus-spam-process-destinations @@ -1891,7 +1895,7 @@ for mail groups." another group, or expire them (the default). If non-nil, this should be a list of group name regexps that should match all groups in which to do spam-processed article moving, associated with the destination -group or `nil' for explicit expiration. This only makes sense for +group or nil for explicit expiration. This only makes sense for mail groups." :variable-group spam :variable-type '(repeat @@ -1901,7 +1905,7 @@ mail groups." (choice :tag "Destination for spam-processed articles at summary exit" (string :tag "Move to a group") - (other :tag "Expire" nil)))) + (const :tag "Expire" nil)))) :parameter-document "Where spam-processed articles will go at summary exit.") @@ -1910,7 +1914,7 @@ mail groups." :parameter-type '(choice :tag "Destination for ham articles at summary exit from a spam group" (string :tag "Move to a group") - (other :tag "Do nothing" nil)) + (const :tag "Do nothing" nil)) :function-document "Where ham articles will go at summary exit from a spam group." :variable gnus-ham-process-destinations @@ -1920,7 +1924,7 @@ mail groups." another group, or do nothing (the default). If non-nil, this should be a list of group name regexps that should match all groups in which to do ham article moving, associated with the destination -group or `nil' for explicit ignoring. This only makes sense for +group or nil for explicit ignoring. This only makes sense for mail groups, and only works in spam groups." :variable-group spam :variable-type '(repeat @@ -1930,7 +1934,7 @@ mail groups, and only works in spam groups." (choice :tag "Destination for ham articles at summary exit from spam group" (string :tag "Move to a group") - (other :tag "Expire" nil)))) + (const :tag "Expire" nil)))) :parameter-document "Where ham articles will go at summary exit from a spam group.")) @@ -3111,15 +3115,30 @@ that that variable is buffer-local to the summary buffers." (defsubst gnus-method-to-full-server-name (method) (format "%s+%s" (car method) (nth 1 method))) -(defun gnus-group-prefixed-name (group method) - "Return the whole name from GROUP and METHOD." +(defun gnus-group-prefixed-name (group method &optional full) + "Return the whole name from GROUP and METHOD. Call with full set to +get the fully qualified group name (even if the server is native)." (and (stringp method) (setq method (gnus-server-to-method method))) (if (or (not method) - (gnus-server-equal method "native") + (and (not full) (gnus-server-equal method "native")) (string-match ":" group)) group (concat (gnus-method-to-server-name method) ":" group))) +(defun gnus-group-guess-prefixed-name (group) + "Guess the whole name from GROUP and METHOD." + (gnus-group-prefixed-name group (gnus-find-method-for-group + group))) + +(defun gnus-group-full-name (group method) + "Return the full name from GROUP and METHOD, even if the method is +native." + (gnus-group-prefixed-name group method t)) + +(defun gnus-group-guess-full-name (group) + "Guess the full name from GROUP, even if the method is native." + (gnus-group-full-name group (gnus-find-method-for-group group))) + (defun gnus-group-real-prefix (group) "Return the prefix of the current group name." (if (string-match "^[^:]+:" group) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index e841449..824bb5a 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -1,5 +1,5 @@ ;;; mail-source.el --- functions for fetching mail -;; Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -231,6 +231,11 @@ See Info node `(gnus)Mail Source Specifiers'." (const :format "" :value :plugged) (boolean :tag "Plugged"))))))) +(defcustom mail-source-ignore-errors nil + "*Ignore errors when querying mail sources. +If nil, the user will be prompted when an error occurs. If non-nil, +the error will be ignored.") + (defcustom mail-source-primary-source nil "*Primary source for incoming mail. If non-nil, this maildrop will be checked periodically for new mail." @@ -476,15 +481,16 @@ Return the number of files that were found." (condition-case err (funcall function source callback) (error - (unless (yes-or-no-p - (format "Mail source %s error (%s). Continue? " - (if (memq ':password source) - (let ((s (copy-sequence source))) - (setcar (cdr (memq ':password s)) - "********") - s) - source) - (cadr err))) + (if (and (not mail-source-ignore-errors) + (yes-or-no-p + (format "Mail source %s error (%s). Continue? " + (if (memq ':password source) + (let ((s (copy-sequence source))) + (setcar (cdr (memq ':password s)) + "********") + s) + source) + (cadr err)))) (error "Cannot get new mail")) 0))))))))) diff --git a/lisp/message.el b/lisp/message.el index 8e9882d..16b127e 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -3467,7 +3467,7 @@ sent in one piece. The size limit is controlled by `message-send-mail-partially-limit'. If you always want Gnus to send messages in one piece, set -`message-send-mail-partially-limit' to `nil'. +`message-send-mail-partially-limit' to nil. "))) (mm-with-unibyte-current-buffer (message "Sending via mail...") diff --git a/lisp/messcompat.el b/lisp/messcompat.el index fc3d52c..ff7520f 100644 --- a/lisp/messcompat.el +++ b/lisp/messcompat.el @@ -1,6 +1,6 @@ ;;; messcompat.el --- making message mode compatible with mail mode -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -40,7 +40,7 @@ (defvar message-from-style mail-from-style "*Specifies how \"From\" headers look. -If `nil', they contain just the return address like: +If nil, they contain just the return address like: king@grassland.com If `parens', they look like: king@grassland.com (Elvis Parsley) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 41da384..f347a5c 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1,5 +1,6 @@ ;;; mm-decode.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, +;; 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -110,7 +111,7 @@ The defined renderer types are: `links': using links; `lynx' : using lynx; `html2text' : using html2text; -`nil' : using external viewer." +nil : using external viewer." :type '(choice (const w3) (const w3m) (const links) @@ -355,7 +356,6 @@ If not set, `default-directory' will be used." ;;; Internal variables. -(defvar mm-dissection-list nil) (defvar mm-last-shell-command "") (defvar mm-content-id-alist nil) (defvar mm-postponed-undisplay-list nil) @@ -552,16 +552,8 @@ for types in mm-keep-viewer-alive-types." (if (equal "text/plain" (car ctl)) (assoc 'format ctl) t)) - (let ((res (mm-make-handle - (mm-copy-to-buffer) ctl cte nil cdl description nil id))) - (push (car res) mm-dissection-list) - res))) - -(defun mm-remove-all-parts () - "Remove all MIME handles." - (interactive) - (mapcar 'mm-remove-part mm-dissection-list) - (setq mm-dissection-list nil)) + (mm-make-handle + (mm-copy-to-buffer) ctl cte nil cdl description nil id))) (defun mm-dissect-multipart (ctl) (goto-char (point-min)) diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index c315c61..622e63f 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -1,5 +1,6 @@ ;;; mm-encode.el --- Functions for encoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -164,21 +165,24 @@ The encoding used is returned." (pop rules))))) (defun mm-qp-or-base64 () - (save-excursion - (let ((limit (min (point-max) (+ 2000 (point-min)))) - (n8bit 0)) - (goto-char (point-min)) - (skip-chars-forward "\x20-\x7f\r\n\t" limit) - (while (< (point) limit) - (incf n8bit) - (forward-char 1) - (skip-chars-forward "\x20-\x7f\r\n\t" limit)) - (if (or (< (* 6 n8bit) (- limit (point-min))) - ;; Don't base64, say, a short line with a single - ;; non-ASCII char when splitting parts by charset. - (= n8bit 1)) - 'quoted-printable - 'base64)))) + (if (equal mm-use-ultra-safe-encoding '(sign . "pgp")) + ;; perhaps not always accurate? + 'quoted-printable + (save-excursion + (let ((limit (min (point-max) (+ 2000 (point-min)))) + (n8bit 0)) + (goto-char (point-min)) + (skip-chars-forward "\x20-\x7f\r\n\t" limit) + (while (< (point) limit) + (incf n8bit) + (forward-char 1) + (skip-chars-forward "\x20-\x7f\r\n\t" limit)) + (if (or (< (* 6 n8bit) (- limit (point-min))) + ;; Don't base64, say, a short line with a single + ;; non-ASCII char when splitting parts by charset. + (= n8bit 1)) + 'quoted-printable + 'base64))))) (provide 'mm-encode) diff --git a/lisp/mm-url.el b/lisp/mm-url.el index 1eeff06..0f5af82 100644 --- a/lisp/mm-url.el +++ b/lisp/mm-url.el @@ -1,5 +1,5 @@ ;;; mm-url.el --- a wrapper of url functions/commands for Gnus -;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 3ee2493..8a204c7 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,5 +1,6 @@ ;;; mm-util.el --- Utility functions for Mule and low level things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -460,7 +461,7 @@ If the charset is `composition', return the actual one." (mm-mule-charset-to-mime-charset charset))) (defun mm-delete-duplicates (list) - "Simple substitute for CL `delete-duplicates', testing with `equal'." + "Simple substitute for CL `delete-duplicates', testing with `equal'." (let (result head) (while list (setq head (car list)) @@ -692,7 +693,7 @@ START, END and FILENAME. START and END are buffer positions saying what text to write. Optional fourth argument specifies the coding system to use when encoding the file. -If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." +If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (let ((coding-system-for-write (or codesys mm-text-coding-system-for-write mm-text-coding-system)) @@ -710,7 +711,7 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." coding-system inhibit) "Like `write-region'. -If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." +If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (let ((coding-system-for-write (or coding-system mm-text-coding-system-for-write mm-text-coding-system)) @@ -736,7 +737,7 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." (if (fboundp 'detect-coding-region) (defun mm-detect-coding-region (start end) - "Like 'detect-coding-region' except returning the best one." + "Like `detect-coding-region' except returning the best one." (let ((coding-systems (detect-coding-region (point) (point-max)))) (or (car-safe coding-systems) diff --git a/lisp/mml-sec.el b/lisp/mml-sec.el index 0b1be32..a55e170 100644 --- a/lisp/mml-sec.el +++ b/lisp/mml-sec.el @@ -1,5 +1,5 @@ ;;; mml-sec.el --- A package with security functions for MML documents -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; This file is not part of GNU Emacs, but the same permissions apply. @@ -219,7 +219,7 @@ You can also customize or set `mml-signencrypt-style-alist' instead." (save-excursion (goto-char (point-max)) (when (re-search-backward "^<#secure.*>\n" nil t) - (kill-region (match-beginning 0) (match-end 0))))) + (delete-region (match-beginning 0) (match-end 0))))) (defun mml-secure-message-sign-smime () "Add MML tag to encrypt/sign the entire message." diff --git a/lisp/mml.el b/lisp/mml.el index 5c5d885..9729e6e 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -1,5 +1,6 @@ ;;; mml.el --- A package for parsing and validating MML documents -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 4f2d648..85d23f8 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -1,6 +1,6 @@ ;;; nndraft.el --- draft article access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index e6cd305..9db8739 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -1,5 +1,5 @@ ;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Simon Josefsson (adding MARKS) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index c13b522..61f4ce9 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,7 +1,7 @@ ;;; nnheader.el --- header access macros for Gnus and its backends ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000, 2001, 2002 +;; 1997, 1998, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA @@ -33,7 +33,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) (require 'mm-util) @@ -88,6 +88,10 @@ on your system, you could say something like: \(setq nnheader-file-name-translation-alist '((?: . ?_)))") +(defvar nnheader-directory-separator-character + (string-to-char (substring (file-name-as-directory ".") -1)) + "*A character used to a directory separator.") + (eval-and-compile (autoload 'nnmail-message-id "nnmail") (autoload 'mail-position-on-field "sendmail") @@ -809,7 +813,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/nnimap.el b/lisp/nnimap.el index f6c3705..5488c36 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -1,5 +1,6 @@ ;;; nnimap.el --- imap backend for Gnus -;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Jim Radford @@ -1327,7 +1328,9 @@ function is generally only called when Gnus is shutting down." (deffoo nnimap-request-create-group (group &optional server args) (when (nnimap-possibly-change-server server) (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer) - (imap-mailbox-create group nnimap-server-buffer)))) + (imap-mailbox-create group nnimap-server-buffer) + (nnheader-report 'nnimap "%S" + (imap-error-text nnimap-server-buffer))))) (defun nnimap-time-substract (time1 time2) "Return TIME for TIME1 - TIME2." diff --git a/lisp/nnmail.el b/lisp/nnmail.el index cb1fb79..fd2fccf 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,5 +1,5 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -36,8 +36,6 @@ (require 'mm-util) (eval-and-compile - (autoload 'gnus-error "gnus-util") - (autoload 'gnus-buffer-live-p "gnus-util") (autoload 'gnus-add-buffer "gnus")) (defgroup nnmail nil @@ -167,10 +165,10 @@ can also be `immediate' and `never'." (defcustom nnmail-expiry-wait-function nil "Variable that holds function to specify how old articles should be before they are expired. - The function will be called with the name of the group that the -expiry is to be performed in, and it should return an integer that -says how many days an article can be stored before it is considered -\"old\". It can also return the values `never' and `immediate'. +The function will be called with the name of the group that the expiry +is to be performed in, and it should return an integer that says how +many days an article can be stored before it is considered \"old\". +It can also return the values `never' and `immediate'. Eg.: @@ -350,6 +348,11 @@ discarded after running the split process." :group 'nnmail-split :type 'hook) +(defcustom nnmail-spool-hook nil + "*A hook called when a new article is spooled." + :group 'nnmail + :type 'hook) + (defcustom nnmail-large-newsgroup 50 "*The number of the articles which indicates a large newsgroup or nil. If the number of the articles is greater than the value, verbose @@ -998,8 +1001,7 @@ FUNC will be called with the buffer narrowed to each mail." FUNC will be called with the group name to determine the article number." (let ((methods (or nnmail-split-methods '(("bogus" "")))) (obuf (current-buffer)) - (beg (point-min)) - end group-art method grp) + group-art method grp) (if (and (sequencep methods) (= (length methods) 1)) ;; If there is only just one group to put everything in, we @@ -1008,13 +1010,17 @@ FUNC will be called with the group name to determine the article number." (list (cons (caar methods) (funcall func (caar methods))))) ;; We do actual comparison. (save-excursion - ;; Find headers. - (goto-char beg) - (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) + ;; Copy the article into the work buffer. (set-buffer nntp-server-buffer) (erase-buffer) - ;; Copy the headers into the work buffer. - (insert-buffer-substring obuf beg end) + (insert-buffer-substring obuf) + ;; Narrow to headers. + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (point) + (point-max))) + (goto-char (point-min)) ;; Decode MIME headers and charsets. (when nnmail-mail-splitting-decodes (let ((mail-parse-charset nnmail-mail-splitting-charset)) @@ -1106,6 +1112,7 @@ FUNC will be called with the group name to determine the article number." (goto-char (point-min)) (gnus-configure-windows 'split-trace) (set-buffer restore))) + (widen) ;; See whether the split methods returned `junk'. (if (equal group-art '(junk)) nil @@ -1324,7 +1331,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." ;; correct match positions. (re-search-backward value start-of-value)) (dolist (sp (nnmail-split-it (car split-rest))) - (unless (memq sp split-result) + (unless (member sp split-result) (push sp split-result)))))) split-result)) @@ -1469,13 +1476,15 @@ See the documentation for the variable `nnmail-split-fancy' for details." nnmail-message-id-cache-file nil 'silent) (set-buffer-modified-p nil) (setq nnmail-cache-buffer nil) - (kill-buffer (current-buffer))))) + (gnus-kill-buffer (current-buffer))))) ;; Compiler directives. (defvar group) (defvar group-art-list) (defvar group-art) (defun nnmail-cache-insert (id grp) + (run-hook-with-args 'nnmail-spool-hook + id grp) (when nnmail-treat-duplicates ;; Store some information about the group this message is written ;; to. This is passed in as the grp argument -- all locations this @@ -1878,7 +1887,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." "Remove all instances of GROUP from `nnmail-split-history'." (let ((history nnmail-split-history)) (while history - (setcar history (gnus-delete-if (lambda (e) (string= (car e) group)) + (setcar history (gnus-remove-if (lambda (e) (string= (car e) group)) (car history))) (pop history)) (setq nnmail-split-history (delq nil nnmail-split-history)))) diff --git a/lisp/nnrss.el b/lisp/nnrss.el index 117db74..2b3dd27 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -1,5 +1,5 @@ ;;; nnrss.el --- interfacing with RSS -;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: RSS diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index 63b39c9..5fe81fb 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -1,5 +1,5 @@ ;;; nnslashdot.el --- interfacing with Slashdot -;; Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index 4d9d884..009a1d3 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -1,6 +1,6 @@ ;;; nnsoup.el --- SOUP access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/nnspool.el b/lisp/nnspool.el index 4efdeae..080c5e7 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -1,7 +1,7 @@ ;;; nnspool.el --- spool access for GNU Emacs ;; Copyright (C) 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2002 +;; 2000, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA diff --git a/lisp/nntp.el b/lisp/nntp.el index ae0cfdb..7f50446 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,7 +1,7 @@ ;;; nntp.el --- nntp access for Gnus ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc. +;; 1997, 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -207,7 +207,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.") diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index 58244cb..1157eeb 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -1,5 +1,5 @@ ;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: David Moore diff --git a/lisp/nnweb.el b/lisp/nnweb.el index e3a9625..402d865 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -1,5 +1,5 @@ ;;; nnweb.el --- retrieving articles via web search engines -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/pgg-gpg.el b/lisp/pgg-gpg.el index a9f6494..79e6aab 100644 --- a/lisp/pgg-gpg.el +++ b/lisp/pgg-gpg.el @@ -1,6 +1,6 @@ ;;; pgg-gpg.el --- GnuPG support for PGG. -;; Copyright (C) 1999,2000 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; Created: 1999/10/28 @@ -59,27 +59,22 @@ (errors-buffer pgg-errors-buffer) (orig-mode (default-file-modes)) (process-connection-type nil) - process status exit-status) + exit-status) (with-current-buffer (get-buffer-create errors-buffer) (buffer-disable-undo) (erase-buffer)) (unwind-protect (progn (set-default-file-modes 448) - (let ((coding-system-for-write 'binary)) - (setq process - (apply #'start-process "*GnuPG*" errors-buffer - program args))) - (set-process-sentinel process #'ignore) - (when passphrase - (process-send-string process (concat passphrase "\n"))) - (process-send-region process start end) - (process-send-eof process) - (while (eq 'run (process-status process)) - (accept-process-output process 5)) - (setq status (process-status process) - exit-status (process-exit-status process)) - (delete-process process) + (let* ((coding-system-for-write 'binary) + (input (buffer-substring-no-properties start end))) + (with-temp-buffer + (when passphrase + (insert passphrase "\n")) + (insert input) + (setq exit-status + (apply #'call-process-region (point-min) (point-max) program + nil errors-buffer nil args)))) (with-current-buffer (get-buffer-create output-buffer) (buffer-disable-undo) (erase-buffer) @@ -87,12 +82,8 @@ (let ((coding-system-for-read 'raw-text-dos)) (insert-file-contents output-file-name))) (set-buffer errors-buffer) - (if (memq status '(stop signal)) - (error "%s exited abnormally: '%s'" program exit-status)) - (if (= 127 exit-status) - (error "%s could not be found" program)))) - (if (and process (eq 'run (process-status process))) - (interrupt-process process)) + (if (not (equal exit-status 0)) + (error "%s exited abnormally: '%s'" program exit-status)))) (if (file-exists-p output-file-name) (delete-file output-file-name)) (set-default-file-modes orig-mode)))) diff --git a/lisp/pop3.el b/lisp/pop3.el index 9f78bcb..43cf916 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -1,6 +1,6 @@ ;;; pop3.el --- Post Office Protocol (RFC 1460) interface -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Richard L. Pieri diff --git a/lisp/sieve-manage.el b/lisp/sieve-manage.el index 967c721..9193577 100644 --- a/lisp/sieve-manage.el +++ b/lisp/sieve-manage.el @@ -1,5 +1,5 @@ ;;; sieve-manage.el --- Implementation of the managesive protocol in elisp -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2003 Free Software Foundation, Inc. ;; Author: Simon Josefsson @@ -535,7 +535,13 @@ password is remembered in the buffer." (when (looking-at (concat "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" sieve-manage-server-eol)) - (list (match-string 1) (match-string 3) (match-string 5)))) + (let ((status (match-string 1)) + (resp-code (match-string 3)) + (response (match-string 5))) + (when response + (goto-char (match-beginning 5)) + (setq response (sieve-manage-is-string))) + (list status resp-code response)))) (defun sieve-manage-parse-okno () (let (rsp) diff --git a/lisp/sieve-mode.el b/lisp/sieve-mode.el index 944b189..f47b5d0 100644 --- a/lisp/sieve-mode.el +++ b/lisp/sieve-mode.el @@ -1,5 +1,5 @@ ;;; sieve-mode.el --- Sieve code editing commands for Emacs -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2003 Free Software Foundation, Inc. ;; Author: Simon Josefsson diff --git a/lisp/sieve.el b/lisp/sieve.el index edfd385..ad62856 100644 --- a/lisp/sieve.el +++ b/lisp/sieve.el @@ -1,5 +1,5 @@ ;;; sieve.el --- Utilities to manage sieve scripts -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2003 Free Software Foundation, Inc. ;; Author: Simon Josefsson @@ -368,8 +368,10 @@ Server : " server ":" (or port "2000") " (with-current-buffer (get-buffer sieve-buffer) (setq err (sieve-manage-putscript name script sieve-manage-buffer)) (if (sieve-manage-ok-p err) - (message (concat "Sieve upload done. Use `C-c RET' to manage scripts.")) - (message "Sieve upload failed: %s" (nth 2 err))))))) + (message (concat + "Sieve upload done. Use `C-c RET' to manage scripts.")) + (message "Sieve upload failed: %s" + (replace-regexp-in-string "[\n\r\t]+" " " (nth 2 err)))))))) ;;;###autoload (defun sieve-upload-and-bury (&optional name) diff --git a/lisp/smiley.el b/lisp/smiley.el index 5edb176..c2841cb 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -1,6 +1,6 @@ ;;; smiley.el --- displaying smiley faces -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Dave Love ;; Keywords: news mail multimedia diff --git a/lisp/spam-stat.el b/lisp/spam-stat.el index fc134f9..f4c5ec9 100644 --- a/lisp/spam-stat.el +++ b/lisp/spam-stat.el @@ -1,6 +1,6 @@ ;;; spam-stat.el --- detecting spam based on statistics -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. ;; Author: Alex Schroeder ;; Keywords: network diff --git a/lisp/spam.el b/lisp/spam.el index 067425a..ffecadf 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -1,5 +1,5 @@ ;;; spam.el --- Identifying spam -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: network @@ -100,6 +100,13 @@ The regular expression is matched against the address." :type 'boolean :group 'spam) +(defcustom spam-use-whitelist-exclusive nil + "Whether whitelist-exclusive should be used by spam-split. +Exclusive whitelisting means that all messages from senders not in the whitelist +are considered spam." + :type 'boolean + :group 'spam) + (defcustom spam-use-blackholes nil "Whether blackholes should be used by spam-split." :type 'boolean @@ -128,6 +135,13 @@ Enable this if you want Gnus to invoke Bogofilter on new messages." :type 'boolean :group 'spam) +(defcustom spam-use-BBDB-exclusive nil + "Whether BBDB-exclusive should be used by spam-split. +Exclusive BBDB means that all messages from senders not in the BBDB are +considered spam." + :type 'boolean + :group 'spam) + (defcustom spam-use-ifile nil "Whether ifile should be used by spam-split." :type 'boolean @@ -155,6 +169,11 @@ All unmarked article in such group receive the spam mark on group entry." :type '(repeat (string :tag "Server")) :group 'spam) +(defcustom spam-blackhole-good-server-regex nil + "String matching IP addresses that should not be checked in the blackholes" + :type 'regexp + :group 'spam) + (defcustom spam-ham-marks (list 'gnus-del-mark 'gnus-read-mark 'gnus-killed-mark 'gnus-kill-file-mark 'gnus-low-score-mark) @@ -243,6 +262,11 @@ your main source of newsgroup names." :type 'string :group 'spam-bogofilter) +(defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)" + "The regex on `spam-bogofilter-header' for positive spam identification." + :type 'regexp + :group 'spam-bogofilter) + (defcustom spam-bogofilter-database-directory nil "Directory path of the Bogofilter databases." :type '(choice (directory :tag "Location of the Bogofilter database directory") @@ -403,15 +427,15 @@ your main source of newsgroup names." (defun spam-ham-move-routine (&optional group) (let ((articles gnus-newsgroup-articles) article ham-mark-values mark) + (dolist (mark spam-ham-marks) (push (symbol-value mark) ham-mark-values)) - - (while articles - (setq article (pop articles)) - (when (and (memq mark ham-mark-values) + + (dolist (article articles) + (when (and (memq (gnus-summary-article-mark article) ham-mark-values) (stringp group)) - (let ((gnus-current-article article)) - (gnus-summary-move-article nil group)))))) + (let ((gnus-current-article article)) + (gnus-summary-move-article nil group)))))) (defun spam-generic-register-routine (spam-func ham-func) (let ((articles gnus-newsgroup-articles) @@ -504,9 +528,9 @@ your main source of newsgroup names." "The spam-list-of-checks list contains pairs associating a parameter variable with a spam checking function. If the parameter variable is true, then the checking function is called, and its value decides what -happens. Each individual check may return `nil', `t', or a mailgroup -name. The value `nil' means that the check does not yield a decision, -and so, that further checks are needed. The value `t' means that the +happens. Each individual check may return nil, t, or a mailgroup +name. The value nil means that the check does not yield a decision, +and so, that further checks are needed. The value t means that the message is definitely not spam, and that further spam checks should be inhibited. Otherwise, a mailgroup name is returned where the mail should go, and further checks are also inhibited. The usual mailgroup @@ -575,18 +599,20 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ips))) (dolist (server spam-blackhole-servers) (dolist (ip ips) - (let ((query-string (concat ip "." server))) - (if spam-use-dig - (let ((query-result (query-dig query-string))) - (when query-result - (gnus-message 5 "(DIG): positive blackhole check '%s'" query-result) - (push (list ip server query-result) - matches))) - ;; else, if not using dig.el - (when (query-dns query-string) - (gnus-message 5 "positive blackhole check") - (push (list ip server (query-dns query-string 'TXT)) - matches))))))) + (unless (and spam-blackhole-good-server-regex + (string-match spam-blackhole-good-server-regex ip)) + (let ((query-string (concat ip "." server))) + (if spam-use-dig + (let ((query-result (query-dig query-string))) + (when query-result + (gnus-message 5 "(DIG): positive blackhole check '%s'" query-result) + (push (list ip server query-result) + matches))) + ;; else, if not using dig.el + (when (query-dns query-string) + (gnus-message 5 "positive blackhole check") + (push (list ip server (query-dns query-string 'TXT)) + matches)))))))) (when matches spam-split-group))) @@ -623,13 +649,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (spam-enter-ham-BBDB (spam-fetch-field-from-fast article))))) (defun spam-check-BBDB () - "Mail from people in the BBDB is never considered spam" + "Mail from people in the BBDB is classified as ham or non-spam" (let ((who (message-fetch-field "from"))) (when who - (setq who (regexp-quote (cadr - (gnus-extract-address-components who)))) + (setq who (cadr (gnus-extract-address-components who))) (if (bbdb-search-simple nil who) - nil spam-split-group))))) + t + (if spam-use-BBDB-exclusive + spam-split-group + nil)))))) (file-error (progn (defalias 'bbdb-search-simple 'ignore) @@ -783,12 +811,16 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (insert address "\n") (save-buffer))) -;;; returns nil if the sender is in the whitelist, spam-split-group otherwise +;;; returns t if the sender is in the whitelist, nil or spam-split-group otherwise (defun spam-check-whitelist () ;; FIXME! Should it detect when file timestamps change? (unless spam-whitelist-cache (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) - (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group)) + (if (spam-from-listed-p spam-whitelist-cache) + t + (if spam-use-whitelist-exclusive + spam-split-group + nil))) (defun spam-check-blacklist () ;; FIXME! Should it detect when file timestamps change? @@ -846,12 +878,12 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (defun spam-check-bogofilter-headers (&optional score) (let ((header (message-fetch-field spam-bogofilter-header))) (when (and header - (string-match "^Yes" header)) + (string-match spam-bogofilter-bogosity-positive-spam-header + header)) (if score (when (string-match "spamicity=\\([0-9.]+\\)" header) (match-string 1 header)) spam-split-group)))) - ;; return something sensible if the score can't be determined (defun spam-bogofilter-score () diff --git a/texi/ChangeLog b/texi/ChangeLog index efeb708..477cd97 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,55 @@ +2003-02-07 Teodor Zlatanov + + * gnus.texi (BBDB Whitelists, Blacklists and Whitelists): + corrected existing docs, added spam-use-whitelist-exclusive and + spam-use-BBDB-exclusive to list of variables + +2003-02-07 Jesper Harder + + * gnus.texi (The problem of spam): Don't use @email for examples + -- it creates a mailto-link in HTML and PDF. + +2003-02-07 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Source Customization): Addition. + +2003-02-04 Reiner Steib + + * message.texi (Mail Variables): Added index entry for + `message-send-mail-partially-limit' + +2003-01-30 Jesper Harder + + * gnus.texi (Batching Agents): Index. + (Agent Commands): do. + (Delayed Articles): do. + (Drafts): do. + (Web Archive): do. + (Article Washing): do. + (Slave Gnusae): do. + (Agent Basics): do. + (Exiting Gnus): do. + (Article Date): do. + (X-Face): do. + (Exiting the Summary Buffer): do. + (Charsets): do. + (Mail Group Commands): do. + + * gnus.texi: Mark-up fixes. + +2003-01-27 Teodor Zlatanov + + * gnus.texi: replace `H' mark with `$' mark + (Blackholes): add spam-blackhole-good-server-regex variable + +2003-01-26 Simon Josefsson + + * sieve.texi (Installation): Extension .sv is also used. + +2003-01-26 Jesper Harder + + * gnus.texi (Article Backlog): Update. + 2003-01-23 Lars Magne Ingebrigtsen * gnus.texi (NNTP): Addition. diff --git a/texi/Makefile.in b/texi/Makefile.in index dc6a5fc..4258414 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -137,10 +137,10 @@ gnus.latexi gnus-faq.latexi message.latexi emacs-mime.latexi sieve.latexi pgg.la TEXINPUTS=$(srcdir):$$TEXINPUTS $(PDFLATEX) gnus.tmplatexi mv gnus.pdf $@ -latexps: latex gnus.dvi-x +latexps: gnus.dvi-x TEXPICTS=$(srcdir) $(DVIPS) -t a4 -f $< > gnus.ps -latexpdf: latex gnus.pdf-x +latexpdf: gnus.pdf-x mv gnus.pdf-x gnus.pdf gnus-manual-a4.latexi: gnus.latexi @@ -168,8 +168,7 @@ psout: latexboth out latexboth: gnus-manual-a4.ps.gz gnus-manual-standard.ps.gz out: - scp gnus-manual-*.ps.gz gnus-manual-*.pdf - www@quimby:html/gnus/documents + scp gnus-manual-*.ps.gz gnus-manual-*.pdf www@quimby:html/gnus/documents veryclean: clean rm -f gnus.dvi gnus.ps texi2latex.elc diff --git a/texi/gnus.texi b/texi/gnus.texi index 45627ce..cb6e5c1 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -33,7 +33,7 @@ \makeindex \begin{document} -\newcommand{\gnusversionname}{Oort Gnus v0.14} +\newcommand{\gnusversionname}{Oort Gnus v0.15} \newcommand{\gnuschaptername}{} \newcommand{\gnussectionname}{} @@ -68,6 +68,8 @@ \newcommand{\gnusversion}[1]{{\small\textit{#1}}} \newcommand{\gnusauthor}[1]{{\large\textbf{#1}}} \newcommand{\gnusresult}[1]{\gnustt{=> #1}} +\newcommand{\gnusacronym}[1]{\textit{#1}} +\newcommand{\gnusemail}[1]{\textit{#1}} \newcommand{\gnusbullet}{{${\bullet}$}} \newcommand{\gnusdollar}{\$} @@ -385,7 +387,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Oort Gnus v0.14. +This manual corresponds to Oort Gnus v0.15. @end ifinfo @@ -1109,7 +1111,7 @@ are using the two different Gnusae to read from two different servers), that is no problem whatsoever. You just do it. The problem appears when you want to run two Gnusae that use the same -@code{.newsrc} file. +@file{.newsrc} file. To work around that problem some, we here at the Think-Tank at the Gnus Towers have come up with a new concept: @dfn{Masters} and @@ -1119,6 +1121,7 @@ conjunction with each other, you have to send $1 per usage instance to me. Usage of the patent (@dfn{Master/Slave Relationships In Computer Applications}) will be much more expensive, of course.) +@findex gnus-slave Anyway, you start one Gnus up the normal way with @kbd{M-x gnus} (or however you do it). Each subsequent slave Gnusae should be started with @kbd{M-x gnus-slave}. These slaves won't save normal @file{.newsrc} @@ -1129,9 +1132,9 @@ information from them. (The slave files will be read in the sequence they were created, so the latest changes will have precedence.) Information from the slave files has, of course, precedence over the -information in the normal (i.e., master) @code{.newsrc} file. +information in the normal (i.e., master) @file{.newsrc} file. -If the @code{.newsrc*} files have not been saved in the master when the +If the @file{.newsrc*} files have not been saved in the master when the slave starts, you may be prompted as to whether to read an auto-save file. If you answer "yes", the unsaved changes to the master will be incorporated into the slave. If you answer "no", the slave may see some @@ -1503,7 +1506,7 @@ Gnus will put the dribble file(s) in @code{gnus-dribble-directory}. If this variable is @code{nil}, which it is by default, Gnus will dribble into the directory where the @file{.newsrc} file is located. (This is normally the user's home directory.) The dribble file will get the same -file permissions as the @code{.newsrc} file. +file permissions as the @file{.newsrc} file. @vindex gnus-always-read-dribble-file If @code{gnus-always-read-dribble-file} is non-@code{nil}, Gnus will @@ -3417,6 +3420,7 @@ The dribble file will be saved, though (@pxref{Auto Save}). @vindex gnus-exit-gnus-hook @vindex gnus-suspend-gnus-hook +@vindex gnus-after-exiting-gnus-hook @code{gnus-suspend-gnus-hook} is called when you suspend Gnus and @code{gnus-exit-gnus-hook} is called when you quit Gnus, while @code{gnus-after-exiting-gnus-hook} is called as the final item when @@ -5532,6 +5536,7 @@ calculates the deadline of the message and stores it in the @code{X-Gnus-Delayed} header and puts the message in the @code{nndraft:delayed} group. +@findex gnus-delay-send-queue And whenever you get new news, Gnus looks through the group for articles which are due and sends them. It uses the @code{gnus-delay-send-queue} function for this. By default, this function is added to the hook @@ -7162,7 +7167,7 @@ variable is non-@code{nil} and is not a number, Gnus will store bound before exploding and taking your machine down with you. I put that in there just to keep y'all on your toes. -This variable is @code{nil} by default. +The default value is 20. @node Saving Articles @@ -8282,7 +8287,6 @@ is rumored to have employed this form of, uh, somewhat weak encryption. @item W m @kindex W m (Summary) @findex gnus-summary-morse-message -@c @icon{gnus-summary-morse-message} Morse decode the article buffer (@code{gnus-summary-morse-message}). @item W t @@ -8333,12 +8337,14 @@ unwrap lines, repair attribution and rearrange citation. @item W Y u @kindex W Y u (Summary) @findex gnus-article-outlook-unwrap-lines +@vindex gnus-outlook-deuglify-unwrap-min +@vindex gnus-outlook-deuglify-unwrap-max Unwrap lines that appear to be wrapped citation lines. You can control what lines will be unwrapped by frobbing @code{gnus-outlook-deuglify-unwrap-min} and @code{gnus-outlook-deuglify-unwrap-max}, indicating the miminum and maximum length of an unwrapped citation line. -(@code{gnus-outlook-deuglify-article}). +(@code{gnus-article-outlook-unwrap-lines}). @item W Y a @kindex W Y a (Summary) @@ -8712,6 +8718,7 @@ Say how much time has elapsed between the article was posted and now X-Sent: 6 weeks, 4 days, 1 hour, 3 minutes, 8 seconds ago @end example +@vindex gnus-article-date-lapsed-new-header The value of @code{gnus-article-date-lapsed-new-header} determines whether this header will just be added below the old Date one, or will replace it. @@ -9119,6 +9126,7 @@ This knowledge is encoded in the @code{gnus-group-charset-alist} variable, which is an alist of regexps (use the first item to match full group names) and default charsets to be used when reading these groups. +@vindex gnus-newsgroup-ignored-charsets In addition, some people do use soi-disant @sc{mime}-aware agents that aren't. These blithely mark messages as being in @code{iso-8859-1} even if they really are in @code{koi-8}. To help here, the @@ -9713,6 +9721,7 @@ Create an empty article in the current mail newsgroups @item B r @kindex B r (Summary) @findex gnus-summary-respool-article +@vindex gnus-summary-respool-default-method Respool the mail article (@code{gnus-summary-respool-article}). @code{gnus-summary-respool-default-method} will be used as the default select method when respooling. This variable is @code{nil} by default, @@ -10048,6 +10057,7 @@ group and return you to the group buffer. @findex gnus-summary-exit @vindex gnus-summary-exit-hook @vindex gnus-summary-prepare-exit-hook +@vindex gnus-group-no-more-groups-hook @c @icon{gnus-summary-exit} Exit the current group and update all information on the group (@code{gnus-summary-exit}). @code{gnus-summary-prepare-exit-hook} is @@ -11145,6 +11155,14 @@ really are mailing lists. Then, at least, followups to the mailing lists will work most of the time. Posting to these groups (@kbd{a}) is still a pain, though. +@item gnus-version-expose-system +@vindex gnus-version-expose-system + +Your system type (@code{system-configuration} variable, such as +@samp{i686-pc-linux}) is exposed in the auto-generated by default +User-Agent header. Sometimes, it may be desireable (mostly because of +aesthetic reasons) to turn it off. In this case, set it to @code{nil}. + @end table You may want to do spell-checking on messages that you send out. Or, if @@ -11513,7 +11531,9 @@ Rejected articles will also be put in this draft group (@pxref{Rejected Articles}). @findex gnus-draft-send-all-messages +@kindex D s (Draft) @findex gnus-draft-send-message +@kindex D S (Draft) If you have lots of rejected messages you want to post (or mail) without doing further editing, you can use the @kbd{D s} command (@code{gnus-draft-send-message}). This command understands the @@ -11521,6 +11541,8 @@ process/prefix convention (@pxref{Process/Prefix}). The @kbd{D S} command (@code{gnus-draft-send-all-messages}) will ship off all messages in the buffer. +@findex gnus-draft-toggle-sending +@kindex D t (Draft) If you have some messages that you wish not to send, you can use the @kbd{D t} (@code{gnus-draft-toggle-sending}) command to mark the message as unsendable. This is a toggling command. @@ -13289,6 +13311,10 @@ File where mail will be stored while processing it. The default is @vindex mail-source-delete-incoming If non-@code{nil}, delete incoming files after handling them. +@item mail-source-ignore-errors +@vindex mail-source-ignore-errors +If non-@code{nil}, ignore errors when reading mail from a mail source. + @item mail-source-directory @vindex mail-source-directory Directory where files (if any) will be stored. The default is @@ -13373,7 +13399,7 @@ use this hook to notify any mail watch programs, if you want to. @vindex nnmail-split-hook @item nnmail-split-hook -@findex article-decode-encoded-words +@findex gnus-article-decode-encoded-words @findex RFC 1522 decoding @findex RFC 2047 decoding Hook run in the buffer where the mail headers of each message is kept @@ -15007,6 +15033,7 @@ Some mailing lists only have archives on Web servers, such as interface, and it's possible to get the information Gnus needs to keep groups updated. +@findex gnus-group-make-warchive-group The easiest way to get started with @code{nnwarchive} is to say something like the following in the group buffer: @kbd{M-x gnus-group-make-warchive-group RET an_egroup RET egroups RET @@ -16641,6 +16668,7 @@ Let's take a typical Gnus session using the Agent. @itemize @bullet @item +@findex gnus-unplugged You start Gnus with @code{gnus-unplugged}. This brings up the Gnus Agent in a disconnected state. You can read all the news that you have already fetched while in this mode. @@ -17089,6 +17117,8 @@ Articles that have a score higher than this have a high score. Default @node Agent Commands @subsection Agent Commands +@findex gnus-agent-toggle-plugged +@kindex J j (Agent) All the Gnus Agent commands are on the @kbd{J} submap. The @kbd{J j} (@code{gnus-agent-toggle-plugged}) command works in all modes, and @@ -17328,7 +17358,7 @@ since there are some conceptual differences between @sc{nntp} and make Gnus Agent work smoother as a @sc{imap} Disconnected Mode client. The first thing to keep in mind is that all flags (read, ticked, etc) -are kept on the @sc{imap} server, rather than in @code{.newsrc} as is the +are kept on the @sc{imap} server, rather than in @file{.newsrc} as is the case for nntp. Thus Gnus need to remember flag changes when disconnected, and synchronize these flags when you plug back in. @@ -17514,6 +17544,7 @@ find out which of the other gazillion things you want to customize. @node Batching Agents @subsection Batching Agents +@findex gnus-agent-batch Having the Gnus Agent fetch articles (and post whatever messages you've written) is quite easy once you've gotten things set up properly. The @@ -20892,6 +20923,8 @@ Gnus provides a few convenience functions and variables to allow easier insertion of X-Face headers in outgoing messages. @findex gnus-random-x-face +@vindex gnus-convert-pbm-to-x-face-command +@vindex gnus-x-face-directory @code{gnus-random-x-face} goes through all the @samp{pbm} files in @code{gnus-x-face-directory} and picks one at random, and then converts it to the X-Face format by using the @@ -20905,6 +20938,7 @@ header data as a string. randomly generated data. @findex gnus-x-face-from-file +@vindex gnus-convert-image-to-x-face-command @code{gnus-x-face-from-file} takes a GIF file as the parameter, and then converts the file to X-Face format by using the @code{gnus-convert-image-to-x-face-command} shell command. @@ -21073,7 +21107,7 @@ requires its users to have a basic understanding of e-mail delivery and processing. The simplest approach to filtering spam is filtering. If you get 200 -spam messages per day from @email{random-address@@vmadmin.com}, you +spam messages per day from @samp{random-address@@vmadmin.com}, you block @samp{vmadmin.com}. If you get 200 messages about @samp{VIAGRA}, you discard all messages with @samp{VIAGRA} in the message. This, unfortunately, is a great way to discard legitimate @@ -21358,7 +21392,7 @@ the following keyboard commands: @findex gnus-summary-mark-as-spam @code{gnus-summary-mark-as-spam}. -Mark current article as spam, showing it with the @samp{H} mark. +Mark current article as spam, showing it with the @samp{$} mark. Whenever you see a spam article, make sure to mark its summary line with @kbd{M-d} before leaving the group. This is done automatically for unread articles in @emph{spam} groups. @@ -21405,12 +21439,12 @@ considered @emph{unclassified}. All groups are unclassified by default. In spam groups, all messages are considered to be spam by default: -they get the @samp{H} mark when you enter the group. You must review -these messages from time to time and remove the @samp{H} mark for -every message that is not spam after all. To remove the @samp{H} +they get the @samp{$} mark when you enter the group. You must review +these messages from time to time and remove the @samp{$} mark for +every message that is not spam after all. To remove the @samp{$} mark, you can use @kbd{M-u} to "unread" the article, or @kbd{d} for declaring it read the non-spam way. When you leave a group, all -spam-marked (@samp{H}) articles are sent to a spam processor which +spam-marked (@samp{$}) articles are sent to a spam processor which will study them as spam samples. Messages may also be deleted in various other ways, and unless @@ -21438,7 +21472,7 @@ When you leave @emph{any} group, regardless of its to a spam processor, which will study these as spam samples. If you explicit kill a lot, you might sometimes end up with articles marked @samp{K} which you never saw, and which might accidentally contain -spam. Best is to make sure that real spam is marked with @samp{H}, +spam. Best is to make sure that real spam is marked with @samp{$}, and nothing else. When you leave a @emph{spam} group, all spam-marked articles are @@ -21525,30 +21559,45 @@ The following are the methods you can use to control the behavior of @cindex spam @defvar spam-use-blacklist + Set this variable to @code{t} if you want to use blacklists when splitting incoming mail. Messages whose senders are in the blacklist will be sent to the @code{spam-split-group}. This is an explicit filter, meaning that it acts only on mail senders @emph{declared} to be spammers. + @end defvar @defvar spam-use-whitelist + Set this variable to @code{t} if you want to use whitelists when splitting incoming mail. Messages whose senders are not in the -whitelist will be sent to the @code{spam-split-group}. This is an -implicit filter, meaning it believes everyone to be a spammer unless -told otherwise. Use with care. +whitelist will be sent to the next spam-split rule. This is an +explicit filter, meaning that unless someone is in the whitelist, their +messages are not assumed to be spam or ham. + +@end defvar + +@defvar spam-use-whitelist-exclusive + +Set this variable to @code{t} if you want to use whitelists as an +implicit filter, meaning that every message will be considered spam +unless the sender is in the whitelist. Use with care. + @end defvar @defvar gnus-group-spam-exit-processor-blacklist + Add this symbol to a group's @code{spam-process} parameter by customizing the group parameters or the @code{gnus-spam-process-newsgroups} variable. When this symbol is added to a group's @code{spam-process} parameter, the senders of spam-marked articles will be added to the blacklist. + @end defvar @defvar gnus-group-ham-exit-processor-whitelist + Add this symbol to a group's @code{spam-process} parameter by customizing the group parameters or the @code{gnus-spam-process-newsgroups} variable. When this symbol is @@ -21556,6 +21605,7 @@ added to a group's @code{spam-process} parameter, the senders of ham-marked articles in @emph{ham} groups will be added to the whitelist. Note that this ham processor has no effect in @emph{spam} or @emph{unclassified} groups. + @end defvar Blacklists are lists of regular expressions matching addresses you @@ -21565,11 +21615,9 @@ blacklist. You start out with an empty blacklist. Blacklist entries use the Emacs regular expression syntax. Conversely, whitelists tell Gnus what addresses are considered -legitimate. All non-whitelisted addresses are considered spammers. -This option is probably not useful for most Gnus users unless the -whitelists is very comprehensive or permissive. Also see @ref{BBDB -Whitelists}. Whitelist entries use the Emacs regular expression -syntax. +legitimate. All messages from whitelisted addresses are considered +non-spam. Also see @ref{BBDB Whitelists}. Whitelist entries use the +Emacs regular expression syntax. The blacklist and whitelist file locations can be customized with the @code{spam-directory} variable (@file{~/News/spam} by default), or @@ -21588,14 +21636,27 @@ directly. The whitelist and blacklist files will by default be in the @defvar spam-use-BBDB Analogous to @code{spam-use-whitelist} (@pxref{Blacklists and -Whitelists}), but uses the BBDB as the source of whitelisted addresses, -without regular expressions. You must have the BBDB loaded for -@code{spam-use-BBDB} to work properly. Only addresses in the BBDB -will be allowed through; all others will be classified as spam. +Whitelists}), but uses the BBDB as the source of whitelisted +addresses, without regular expressions. You must have the BBDB loaded +for @code{spam-use-BBDB} to work properly. Messages whose senders are +not in the BBDB will be sent to the next spam-split rule. This is an +explicit filter, meaning that unless someone is in the BBDB, their +messages are not assumed to be spam or ham. + +@end defvar + +@defvar spam-use-BBDB-exclusive + +Set this variable to @code{t} if you want to use the BBDB as an +implicit filter, meaning that every message will be considered spam +unless the sender is in the BBDB. Use with care. Only sender +addresses in the BBDB will be allowed through; all others will be +classified as spammers. @end defvar @defvar gnus-group-ham-exit-processor-BBDB + Add this symbol to a group's @code{spam-process} parameter by customizing the group parameters or the @code{gnus-spam-process-newsgroups} variable. When this symbol is @@ -21603,6 +21664,7 @@ added to a group's @code{spam-process} parameter, the senders of ham-marked articles in @emph{ham} groups will be added to the BBDB. Note that this ham processor has no effect in @emph{spam} or @emph{unclassified} groups. + @end defvar @node Blackholes @@ -21635,6 +21697,13 @@ The list of servers to consult for blackhole checks. @end defvar +@defvar spam-blackhole-good-server-regex + +A regular expression for IPs that should not be checked against the +blackhole server list. When set to nil, it has no effect. + +@end defvar + @defvar spam-use-dig Use the @code{dig.el} package instead of the @code{dns.el} package. @@ -21690,7 +21759,7 @@ There is no specific spam or ham processor for regular expressions. Set this variable if you want @code{spam-split} to use Eric Raymond's speedy Bogofilter. -With a minimum of care for associating the @samp{H} mark for spam +With a minimum of care for associating the @samp{$} mark for spam articles only, Bogofilter training all gets fairly automatic. You should do this until you get a few hundreds of articles in each category, spam or not. The command @kbd{S t} in summary mode, either @@ -22205,6 +22274,7 @@ Save table: (spam-stat-save) @table @code @item gnus-home-directory +@vindex gnus-home-directory All Gnus file and directory variables will be initialized from this variable, which defaults to @file{~/}. @@ -24804,21 +24874,21 @@ There should be no result data from this function. Set/remove/add marks on articles. Normally Gnus handles the article marks (such as read, ticked, expired etc) internally, and store them in -@code{~/.newsrc.eld}. Some back ends (such as @sc{imap}) however carry +@file{~/.newsrc.eld}. Some back ends (such as @sc{imap}) however carry all information about the articles on the server, so Gnus need to propagate the mark information to the server. -ACTION is a list of mark setting requests, having this format: +@var{action} is a list of mark setting requests, having this format: @example (RANGE ACTION MARK) @end example -RANGE is a range of articles you wish to update marks on. ACTION is -@code{add} or @code{del}, used to add marks or remove marks -(preserving all marks not mentioned). MARK is a list of marks; where -each mark is a symbol. Currently used marks are @code{read}, -@code{tick}, @code{reply}, @code{expire}, @code{killed}, +@var{range} is a range of articles you wish to update marks on. +@var{action} is @code{add} or @code{del}, used to add marks or remove +marks (preserving all marks not mentioned). @var{mark} is a list of +marks; where each mark is a symbol. Currently used marks are +@code{read}, @code{tick}, @code{reply}, @code{expire}, @code{killed}, @code{dormant}, @code{save}, @code{download}, @code{unsend}, @code{forward} and @code{recent}, but your back end should, if possible, not limit itself to these. diff --git a/texi/message.texi b/texi/message.texi index c63ad62..c8ca154 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1413,6 +1413,7 @@ the problem will actually occur. @item message-send-mail-partially-limit @vindex message-send-mail-partially-limit +@cindex split large message The limitation of messages sent as message/partial. The lower bound of message size in characters, beyond which the message should be sent in several parts. If it is @code{nil}, the size is unlimited. diff --git a/texi/sieve.texi b/texi/sieve.texi index 99be2da..e4403b9 100644 --- a/texi/sieve.texi +++ b/texi/sieve.texi @@ -111,7 +111,7 @@ commands in your @code{~/.emacs}: (autoload 'sieve-mode "sieve-mode") @end lisp @lisp -(setq auto-mode-alist (cons '("\\.si\\(v\\|eve\\)\\'" . sieve-mode) +(setq auto-mode-alist (cons '("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode) auto-mode-alist)) @end lisp diff --git a/texi/texi2latex.el b/texi/texi2latex.el index e60d58a..52eb353 100644 --- a/texi/texi2latex.el +++ b/texi/texi2latex.el @@ -263,7 +263,7 @@ (latexi-exchange-command (concat "gnus" command) arg)) ((member command '("sc" "file" "dfn" "emph" "kbd" "key" "uref" "code" "samp" "var" "strong" "i" - "result")) + "result" "acronym" "email")) (goto-char (match-beginning 0)) (delete-char 1) (insert "\\gnus"))