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.
\f
* 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
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
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
+2003-02-08 23:23:27 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.15 is released.
+
+2003-02-08 Michael Welsh Duggan <md5i@cs.cmu.edu>
+
+ * 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 <jas@extundo.com>
+
+ * 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 <satyaki@chicory.stanford.edu>.
+
+2003-02-08 Jesper Harder <harder@ifa.au.dk>
+
+ * 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 <tzz@lifelogs.com>
+
+ * 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 <larsi@gnus.org>
+
+ * mail-source.el (mail-source-fetch): Typo fix.
+
+2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * 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 <frank@usenet-rundfahrt.de>
+
+ * gnus-art.el (gnus-article-refer-article): Strip leading "news:"
+ from message-ID
+
+2003-02-07 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-util.el (gnus-run-hooks): Use save-current-buffer.
+
+2003-02-07 John Paul Wallington <jpw@gnu.org>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <deskpot@myrealbox.com>
+
+ * gnus-msg.el (gnus-version-expose-system): New variable.
+
+2003-02-07 Simon Josefsson <jas@extundo.com>
+
+ * 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 <larsi@gnus.org>
+
+ * gnus-art.el (article-display-face): Get the Face header from
+ the current buffer.
+
+2003-02-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-view-part-internally): Bind
+ buffer-read-only to nil.
+
+2003-02-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <tzz@lifelogs.com>
+
+ * 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 <jas@extundo.com>
+
+ * 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 <harder@ifa.au.dk>
+
+ * 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 <yamaoka@jpl.org>
+
+ * gnus-delay.el (gnus-delay-article): Fix binding of the
+ nndraft:delayed group.
+
+2003-02-04 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.el (spam group parameters): change 'other to 'const in
+ the group parameter definitions to soothe XEmacs
+
+2003-02-04 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-delay.el (gnus-delay-article): Really create
+ nndraft:delayed group if it doesn't exist.
+
+2003-02-04 Jesper Harder <harder@ifa.au.dk>
+
+ * 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 <harder@ifa.au.dk>
+
+ * 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 <yamaoka@jpl.org>
+
+ * nnheader.el (nnheader-directory-separator-character): Change the
+ way to compute the dafault value.
+
+2003-02-02 Jesper Harder <harder@ifa.au.dk>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <harder@ifa.au.dk>
+
+ * 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 <harder@ifa.au.dk>
+
+ * 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 <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-article-mode): Use summary tool bar.
+
+2003-01-27 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * 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 <harder@ifa.au.dk>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <harder@ifa.au.dk>
+
+ * 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 <jas@extundo.com>
+
+ * 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 <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-article-setup-buffer): Reset
+ gnus-button-marker-list.
+
+2003-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nntp.el (nntp-read-timeout): Default to using a second delay
+ under Microsoft Windows.
+
+2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnheader.el (nnheader-directory-separator-character): New
+ variable.
+
+2003-01-24 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * 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 <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agentize): Indent.
+
+ * gnus.el (gnus-version-number): Bumped.
+
2003-01-24 20:32:44 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
* gnus.el: Oort Gnus v0.14 is released.
2003-01-24 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
* 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
<swoon@bellatlantic.net>.
2003-01-24 Teodor Zlatanov <tzz@lifelogs.com>
;;; 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 <rscholz@zonix.de>
;; Thomas Steffen (unwrapping algorithm,
;;; 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 <simon@josefsson.org>
;; Keywords: DNS BIND dig
;;; 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 <larsi@gnus.org>
;; Keywords: network
;;; 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 <larsi@gnus.org>
: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.
: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)
(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)
(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)
(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)
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
(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
(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)
;; 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))))
(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
(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)))
(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))))
(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)
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))
(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)
(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
(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))
(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")
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)
(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)
(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)))
(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"))))
(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)))))))
;; 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))))))
(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
(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.
(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)
(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.
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 ()
(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)
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))
(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))
))))
(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))
(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)
)
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 "): ")
(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)
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)
(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)
(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))
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
: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))
"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)
;; 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
(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."
(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)))))
(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.
(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)
(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))
(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)
(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) "<news:" "<" )))
(goto-char point)
(set-buffer gnus-summary-buffer)
(gnus-summary-refer-article message-id))
(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]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 "")))
0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
("\\b\\(C-h\\|<?[Ff]1>?\\)[ \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\\|<?[Ff]1>?\\)[ \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\\|<?[Ff]1>?\\)[ \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...
("<URL: *\\([^<>]*\\)>" 1 t gnus-button-embedded-url 1)
;; Raw URLs.
;;; 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 <larsi@gnus.org>
;; Keywords: news
;;; 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 <steve@miranova.com>
;; Keywords: news, mail, multimedia
;;; 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 <larsi@gnus.org>
"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))
;;; 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 <larsi@gnus.org>
;;; 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
: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
;;; 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 <abraham@dina.kvl.dk>
;; Keywords: news
(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
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
(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") "\
;;; 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 <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Keywords: mail, news, extensions
(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)
;;; 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 <larsi@gnus.org>
(cdr (assq 'unsend
(gnus-info-marks
(gnus-get-info "nndraft:queue"))))))
+ (gnus-posting-styles nil)
(total (length articles))
article)
(while (setq article (pop articles))
;;; 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 <larsi@gnus.org>
;; Keywords: news
(when (file-exists-p file)
(let ((done nil)
(attempt "")
- (step 72)
(quant 16))
(while (and (not done)
(> quant 1))
(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.
(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)
(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)
;;; 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 <larsi@gnus.org>
"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
;;;
(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."
: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
"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)
(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))))
\f
--- /dev/null
+;;; gnus-registry.el --- article registry for Gnus
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <tzz@lifelogs.com>
+;; 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
;;; 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 <amanda@iesd.auc.dk>
(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
"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
;; 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)))
(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
;;; 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 <nagya@inf.elte.hu>,
;; Simon Josefsson <simon@josefsson.org>
;;; 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 <larsi@gnus.org>
(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
(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)))
"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 ()
"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)
;;; 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 <larsi@gnus.org>
(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))
(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)
;; 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))
: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))
(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."
["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)
["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]
(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)))
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))))
(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"))
(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)
(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))
(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)
(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 ()
;; 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)))
;;; 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 <kult@uni-paderborn.de>
(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)
;;; 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 <larsi@gnus.org>
(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
(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)
(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
(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)
(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"
;;; 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 <larsi@gnus.org>
(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
: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)
: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)
(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.
"*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))
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 <tzz@lifelogs.com>
(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.")
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
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
(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.")
: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
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
(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."))
(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)
;;; 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 <larsi@gnus.org>
;; Keywords: news, mail
(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."
(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)))))))))
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...")
;;; 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 <larsi@gnus.org>
(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)
;;; 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 <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
`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)
;;; Internal variables.
-(defvar mm-dissection-list nil)
(defvar mm-last-shell-command "")
(defvar mm-content-id-alist nil)
(defvar mm-postponed-undisplay-list nil)
(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))
;;; 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 <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(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)
;;; 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 <zsh@cs.rochester.edu>
;;; 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 <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(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))
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))
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))
(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)
;;; 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 <simon@josefsson.org>
;; This file is not part of GNU Emacs, but the same permissions apply.
(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."
;;; 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 <larsi@gnus.org>
;; This file is part of GNU Emacs.
;;; 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 <larsi@gnus.org>
;;; 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 <simon@josefsson.org> (adding MARKS)
;;; 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 <umerin@flab.flab.fujitsu.junet>
;; 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)
\(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")
(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."
;;; 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 <jas@pdc.kth.se>
;; Jim Radford <radford@robby.caltech.edu>
(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."
;;; 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 <larsi@gnus.org>
(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
(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.:
: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
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
(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))
(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
;; 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))
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
"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))))
;;; 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 <zsh@cs.rochester.edu>
;; Keywords: RSS
;;; 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 <larsi@gnus.org>
;; Keywords: news
;;; 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 <larsi@gnus.org>
;;; 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 <umerin@flab.flab.fujitsu.junet>
;;; 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 <larsi@gnus.org>
;; Keywords: news
"*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.")
;;; 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 <dmoore@ucsd.edu>
;;; 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 <larsi@gnus.org>
;;; 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 <ueno@unixuser.org>
;; Created: 1999/10/28
(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)
(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))))
;;; 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 <ratinox@peorth.gweep.net>
;;; 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 <simon@josefsson.org>
(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)
;;; 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 <simon@josefsson.org>
;;; 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 <simon@josefsson.org>
(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)
;;; 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 <fx@gnu.org>
;; Keywords: news mail multimedia
;;; 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 <alex@gnu.org>
;; Keywords: network
;;; spam.el --- Identifying spam
-;; Copyright (C) 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network
: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
: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
: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)
: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")
(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)
"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
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)))
\f
(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)
(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?
(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 ()
+2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * 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 <harder@ifa.au.dk>
+
+ * 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 <larsi@gnus.org>
+
+ * gnus.texi (Mail Source Customization): Addition.
+
+2003-02-04 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.texi (Mail Variables): Added index entry for
+ `message-send-mail-partially-limit'
+
+2003-01-30 Jesper Harder <harder@ifa.au.dk>
+
+ * 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 <tzz@lifelogs.com>
+
+ * gnus.texi: replace `H' mark with `$' mark
+ (Blackholes): add spam-blackhole-good-server-regex variable
+
+2003-01-26 Simon Josefsson <jas@extundo.com>
+
+ * sieve.texi (Installation): Extension .sv is also used.
+
+2003-01-26 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.texi (Article Backlog): Update.
+
2003-01-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (NNTP): Addition.
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
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
\makeindex
\begin{document}
-\newcommand{\gnusversionname}{Oort Gnus v0.14}
+\newcommand{\gnusversionname}{Oort Gnus v0.15}
\newcommand{\gnuschaptername}{}
\newcommand{\gnussectionname}{}
\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}{\$}
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
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
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}
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
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
@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
@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
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
@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
@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)
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.
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
@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,
@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
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
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
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.
@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
@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
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
@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.
@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
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.
@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
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
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.
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
@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.
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
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
@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
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
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
@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
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
@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.
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
@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{~/}.
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.
@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.
(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
(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"))
projects / elisp / gnus.git- / commitdiff