summaryrefslogtreecommitdiff
path: root/lisp/gnus
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/gnus')
-rw-r--r--lisp/gnus/ChangeLog201
-rw-r--r--lisp/gnus/gnus-agent.el123
-rw-r--r--lisp/gnus/gnus-art.el3
-rw-r--r--lisp/gnus/gnus-cache.el25
-rw-r--r--lisp/gnus/gnus-start.el1
-rw-r--r--lisp/gnus/imap.el7
-rw-r--r--lisp/gnus/mm-decode.el74
-rw-r--r--lisp/gnus/mm-view.el26
-rw-r--r--lisp/gnus/nnmail.el10
-rw-r--r--lisp/gnus/nntp.el22
-rw-r--r--lisp/gnus/rfc2231.el12
11 files changed, 410 insertions, 94 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 01babcddc86..708d232e994 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,204 @@
+2005-12-08 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mm-decode.el (mm-discouraged-alternatives): Fix custom type.
+ Suggest image/.* in the doc string.
+
+2005-12-07 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-display-external): Use nametemplate (defined in
+ RFC1524) if it is in mailcap or add a suffix according to
+ mailcap-mime-extensions when generating a temp filename; postpone
+ deleting a temp file for 2 seconds for some wrappers, shell
+ scripts, and so on, which might exit right after having started a
+ viewer command as a background job.
+
+2005-12-06 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-default-article-saver): Add user-defined
+ `function' to custom type.
+
+2005-12-02 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
+
+ * mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced
+ parens.
+
+2005-11-29 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-cache.el (gnus-cache-rename-group): Wrap doc strings and
+ long lines.
+ (gnus-cache-delete-group): Wrap doc strings.
+
+ * gnus-agent.el (gnus-agent-rename-group)
+ (gnus-agent-delete-group): Wrap doc strings.
+
+2005-11-24 Pascal Rigaux <pixel@mandriva.com> (tiny change)
+
+ * rfc2231.el (rfc2231-parse-string): Support non-ascii chars.
+
+2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnmail.el (nnmail-fancy-expiry-target): Use current-time instead
+ of current-time-string.
+
+2005-11-20 Stefan Schimanski <schimmi@debian.org> (tiny change)
+
+ * nnmail.el (nnmail-fancy-expiry-target): Protect against invalid
+ date header.
+
+2005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny patch)
+
+ * imap.el (imap-kerberos4-open): Ignore SSL stuff.
+
+2005-11-14 Kevin Greiner <kevin.greiner@compsol.cc>
+
+ * gnus-agent.el (gnus-agent-article-alist-save-format): Changed
+ internal variable to a custom variable. Changed default value
+ from compressed(2) to uncompressed(1).
+ (gnus-agent-read-agentview): Reversed revision 7.8 to restore
+ support for uncompressed agentview files. Taken together, reading
+ the agentview file should now be 6-7 times faster.
+ (gnus-agent-long-article,
+ gnus-agent-short-article, gnus-agent-score): Renamed category
+ keywords to match gnus-cus.
+ (gnus-agent-summary-fetch-series): Modified to protect against
+ gnus-agent-summary-fetch-group clearing processable flags.
+ (gnus-agent-synchronize-group-flags): Update live group buffer as
+ synchronization may occur due to the user toggling the plugged
+ status.
+ (gnus-agent-braid-nov): Now tests new nov entries
+ for duplicates which are removed. The invalid sort check then
+ triggers a rescan after the sort as sorting may have moved
+ duplicate entries such that they can be cheaply detected.
+ (gnus-agent-read-local): Trivial fix to format of
+ error message to display actual error condition.
+ (gnus-agent-save-local): Avoid saving symbols that are bound to
+ nil as they simply result in a warning message in
+ gnus-agent-read-local.
+ (gnus-agent-fetch-group-1): Clear downloadable flag when article
+ successfully downloaded.
+ (gnus-agent-regenerate-group): Use
+ gnus-agent-synchronize-group-flags to reset read status in both
+ gnus and server.
+
+ * nntp.el (nntp-end-of-line): Doc fix.
+ (nntp-authinfo-rejected): New error condition.
+ (nntp-wait-for): Use new error condition to signal authentication
+ error.
+ (nntp-retrieve-data): Rethrow new error condition to break out of
+ recursive call to nntp-send-authinfo.
+
+2005-11-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-dribble-read-file): Use make-local-variable
+ rather than make-variable-buffer-local for file-precious-flag.
+
+2005-11-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag.
+
+2005-11-11 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * gnus-start.el (gnus-dribble-read-file): Set file-precious-flag,
+ as a buffer-local variable. This avoids creating truncated
+ dribble files as a result of a hang up, eg.
+
+2005-11-04 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region)
+ (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric)
+ (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt)
+ (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase'
+ argument to all these routines, so the passphrase can be managed
+ externally and passed in to the system.
+ (pgg-pgp-decrypt-region, pgg-pgp-sign-region): Use new name for
+ pgg-add-passphrase-to-cache function.
+
+ * pgg-pgp5.el (pgg-pgp5-encrypt-region, pgg-pgp5-decrypt-region)
+ (pgg-pgp5-encrypt-symmetric-region, pgg-pgp5-encrypt-symmetric)
+ (pgg-pgp5-encrypt, pgg-pgp5-decrypt-region, pgg-pgp5-decrypt)
+ (pgg-pgp5-sign-region, pgg-pgp5-sign): Add optional 'passphrase'
+ argument to all these routines, so the passphrase can be managed
+ externally and passed in to the system.
+ (pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache
+ function.
+
+2005-10-30 Chong Yidong <cyd@stupidchicken.com>
+
+ * imap.el (imap-open): Handle case where buffer is a buffer
+ object.
+
+2005-10-29 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * pgg-gpg.el (pgg-gpg-select-matching-key): Fix: look at the right
+ part of the decoded armor to find the key-identifier.
+ (pgg-gpg-lookup-key-owner): New function to return the
+ human-readable identifier of a key owner.
+ (pgg-gpg-lookup-id-from-key-owner): Make it easy to identify the
+ key itself.
+ (pgg-gpg-decrypt-region): Prompt with the key owner (rather than
+ the key value) if we have a key and can match it against a secret
+ key. Also, added a note pointing out fact that the prompt only
+ indicates the first matching key.
+
+ * pgg.el (pgg-decrypt): Passing along 'passphrase' in call to
+ pgg-decrypt-region.
+ (pgg-pending-timers): A new hash for tracking the passphrase cache
+ timers, so that new ones supercede old ones.
+ (pgg-add-passphrase-to-cache): Rename from
+ `pgg-add-passphrase-cache' to reduce confusion (all callers
+ changed). Modified to cancel old timers when new ones are added.
+ (pgg-remove-passphrase-from-cache): Rename from
+ `pgg-remove-passphrase-cache' to reduce confusion (all callers
+ changed). Modified to cancel old timers when their keys are
+ removed from the cache.
+ (pgg-cancel-timer): In Emacs, an alias for cancel-timer; in
+ XEmacs, an indirection to delete-itimer.
+ (pgg-read-passphrase-from-cache, pgg-read-passphrase):
+ Extract pgg-read-passphrase-from-cache from pgg-read-passphrase so
+ users can only check cache without risk of prompting. Correct bug in
+ notruncate behavior.
+ (pgg-read-passphrase-from-cache, pgg-read-passphrase)
+ (pgg-add-passphrase-cache, pgg-remove-passphrase-cache):
+ Add informative docstrings.
+ (pgg-decrypt): Convey provided passphrase in subordinate call to
+ pgg-decrypt-region.
+
+2005-10-20 Ken Manheimer <ken.manheimer+emacs@gmail.com>
+
+ * pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region)
+ (pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region)
+ (pgg-decrypt, pgg-sign-region, pgg-sign): Add optional
+ 'passphrase' argument, so the passphrase can be managed externally
+ and then passed in to the system.
+
+ * pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache)
+ (pgg-remove-passphrase-cache): Add optional 'notruncate' argument,
+ so the passphrase cache can be used reliably with identifiers
+ besides a pgp packet's key id.
+
+ * pgg-gpg.el (pgg-pgp-encrypt-region)
+ (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric)
+ (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt)
+ (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase'
+ argument to all these routines, so the passphrase can be managed
+ externally and passed in to the system.
+
+ * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Add optional
+ 'notruncate' argument, so the passphrase cache can be used
+ reliably with identifiers besides a pgp packet's key id.
+
+2005-10-29 Sascha Wilde <swilde@sha-bang.de>
+
+ * pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for
+ symmetric encryption.
+ (pgg-gpg-symmetric-key-p): New function to check for an symmetric
+ encrypted session key.
+ (pgg-gpg-decrypt-region): When decrypting a symmetric encrypted
+ message ask for the passphrase in a proper way.
+
+ * pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region):
+ New user commands for symmetric encryption.
+
2005-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
* gnus-delay.el (gnus-delay-group): Don't autoload.
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 0357ddd18cb..2139c485720 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -213,6 +213,17 @@ unplugged."
:group 'gnus-agent
:type 'boolean)
+(defcustom gnus-agent-article-alist-save-format 1
+ "Indicates whether to use compression(2), verses no
+ compression(1), when writing agentview files. The compressed
+ files do save space but load times are 6-7 times higher. A
+ group must be opened then closed for the agentview to be
+ updated using the new format."
+ :version "22.1"
+ :group 'gnus-agent
+ :type '(radio (const :format "Compressed" 2)
+ (const :format "Uncompressed" 1)))
+
;;; Internal variables
(defvar gnus-agent-history-buffers nil)
@@ -357,17 +368,17 @@ manipulated as follows:
(gnus-agent-cat-defaccessor
gnus-agent-cat-high-score agent-high-score)
(gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-long agent-length-when-long)
+ gnus-agent-cat-length-when-long agent-long-article)
(gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-short agent-length-when-short)
+ gnus-agent-cat-length-when-short agent-short-article)
(gnus-agent-cat-defaccessor
gnus-agent-cat-low-score agent-low-score)
(gnus-agent-cat-defaccessor
gnus-agent-cat-predicate agent-predicate)
(gnus-agent-cat-defaccessor
- gnus-agent-cat-score-file agent-score-file)
+ gnus-agent-cat-score-file agent-score)
(gnus-agent-cat-defaccessor
- gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
+ gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
;; This form is equivalent to defsetf except that it calls make-symbol
@@ -858,9 +869,11 @@ be a select method."
;;;###autoload
(defun gnus-agent-rename-group (old-group new-group)
- "Rename fully-qualified OLD-GROUP as NEW-GROUP. Always updates the agent, even when
-disabled, as the old agent files would corrupt gnus when the agent was
-next enabled. Depends upon the caller to determine whether group renaming is supported."
+ "Rename fully-qualified OLD-GROUP as NEW-GROUP.
+Always updates the agent, even when disabled, as the old agent
+files would corrupt gnus when the agent was next enabled.
+Depends upon the caller to determine whether group renaming is
+supported."
(let* ((old-command-method (gnus-find-method-for-group old-group))
(old-path (directory-file-name
(let (gnus-command-method old-command-method)
@@ -888,9 +901,11 @@ next enabled. Depends upon the caller to determine whether group renaming is sup
;;;###autoload
(defun gnus-agent-delete-group (group)
- "Delete fully-qualified GROUP. Always updates the agent, even when
-disabled, as the old agent files would corrupt gnus when the agent was
-next enabled. Depends upon the caller to determine whether group deletion is supported."
+ "Delete fully-qualified GROUP.
+Always updates the agent, even when disabled, as the old agent
+files would corrupt gnus when the agent was next enabled.
+Depends upon the caller to determine whether group deletion is
+supported."
(let* ((command-method (gnus-find-method-for-group group))
(path (directory-file-name
(let (gnus-command-method command-method)
@@ -1134,20 +1149,22 @@ downloadable."
(when gnus-newsgroup-processable
(setq gnus-newsgroup-downloadable
(let* ((dl gnus-newsgroup-downloadable)
- (gnus-newsgroup-downloadable
- (sort (gnus-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
- ;; article successfully fetched.
+ (processable (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
+ (gnus-newsgroup-downloadable processable))
+ (gnus-agent-summary-fetch-group)
- ;; For each article that I processed, remove its
- ;; processable mark IF the article is no longer
- ;; downloadable (i.e. it's already downloaded)
- (dolist (article gnus-newsgroup-processable)
- (unless (memq article gnus-newsgroup-downloadable)
- (gnus-summary-remove-process-mark article)))
- (gnus-sorted-ndifference dl fetched-articles)))))
+ ;; For each article that I processed that is no longer
+ ;; undownloaded, remove its processable mark.
+
+ (mapc #'gnus-summary-remove-process-mark
+ (gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded))
+
+ ;; The preceeding call to (gnus-agent-summary-fetch-group)
+ ;; updated the temporary gnus-newsgroup-downloadable to
+ ;; remove each article successfully fetched. Now, I
+ ;; update the real gnus-newsgroup-downloadable to only
+ ;; include undownloaded articles.
+ (gnus-sorted-ndifference dl (gnus-sorted-ndifference processable gnus-newsgroup-undownloaded))))))
(defun gnus-agent-summary-fetch-group (&optional all)
"Fetch the downloadable articles in the group.
@@ -1240,7 +1257,13 @@ This can be added to `gnus-select-article-hook' or
'gnus-range-add
'gnus-remove-from-range)
(cdr info-marks)
- range)))))))))
+ range))))))))
+
+ ;;Marks can be synchronized at any time by simply toggling from
+ ;;unplugged to plugged. If that is what is happening right now, make
+ ;;sure that the group buffer is up to date.
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (gnus-group-update-group group t)))
nil))
(defun gnus-agent-save-active (method)
@@ -1330,7 +1353,7 @@ downloaded into the agent."
(when (re-search-forward
(concat "^" (regexp-quote group) " ") nil t)
(save-excursion
- (setq oactive-max (read (current-buffer)) ;; max
+ (setq oactive-max (read (current-buffer)) ;; max
oactive-min (read (current-buffer)))) ;; min
(gnus-delete-line)))
(when active
@@ -1824,7 +1847,7 @@ article numbers will be returned."
(defsubst gnus-agent-read-article-number ()
"Reads the article number at point. Returns nil when a valid article number can not be read."
- ;; It is unfortunite but the read function quietly overflows
+ ;; It is unfortunate but the read function quietly overflows
;; integer. As a result, I have to use string operations to test
;; for overflow BEFORE calling read.
(when (looking-at "[0-9]+\t")
@@ -1913,6 +1936,7 @@ doesn't exist, to valid the overview buffer."
(goto-char p))
(setq last (or last -134217728))
+ (while (catch 'problems
(let (sort art)
(while (not (eobp))
(setq art (gnus-agent-read-article-number))
@@ -1924,12 +1948,27 @@ doesn't exist, to valid the overview buffer."
;; Art num out of order - enable sort
(setq sort t)
(forward-line 1))
+ ((= art last)
+ ;; Bad repeat of art number - delete this line
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point))))
(t
;; Good art num
(setq last art)
(forward-line 1))))
(when sort
- (sort-numeric-fields 1 (point-min) (point-max)))))))
+ ;; something is seriously wrong as we simply shouldn't see out-of-order data.
+ ;; First, we'll fix the sort.
+ (sort-numeric-fields 1 (point-min) (point-max))
+
+ ;; but now we have to consider that we may have duplicate rows...
+ ;; so reset to beginning of file
+ (goto-char (point-min))
+ (setq last -134217728)
+
+ ;; and throw a code that restarts this scan
+ (throw 'problems t))
+ nil))))))
;; Keeps the compiler from warning about the free variable in
;; gnus-agent-read-agentview.
@@ -1946,11 +1985,6 @@ doesn't exist, to valid the overview buffer."
'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.
-(defconst gnus-agent-article-alist-save-format 2)
-
(defun gnus-agent-read-agentview (file)
"Load FILE and do a `read' there."
(with-temp-buffer
@@ -1964,8 +1998,6 @@ doesn't exist, to valid the overview buffer."
changed-version)
(cond
- ((< version 2)
- (error "gnus-agent-read-agentview no longer supports version %d. Stop gnus, manually evaluate gnus-agent-convert-to-compressed-agentview, then restart gnus." version))
((= version 0)
(let ((inhibit-quit t)
entry)
@@ -1996,7 +2028,8 @@ doesn't exist, to valid the overview buffer."
(setq uncomp (cons (cons article-id state) uncomp)))
sequence)))
alist)
- (setq alist (sort uncomp 'car-less-than-car)))))
+ (setq alist (sort uncomp 'car-less-than-car)))
+ (setq changed-version (not (= 2 gnus-agent-article-alist-save-format)))))
(when changed-version
(let ((gnus-agent-article-alist alist))
(gnus-agent-save-alist gnus-agent-read-agentview)))
@@ -2110,7 +2143,7 @@ modified) original contents, they are first saved to their own file."
;; NOTE: The '+ 0' ensure that min and max are both numerics.
(set group (cons (+ 0 min) (+ 0 max))))
(error
- (gnus-message 3 "Warning - invalid agent local: %s on line %d: "
+ (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s"
file line (error-message-string err))))
(forward-line 1)
(setq line (1+ line))))
@@ -2141,13 +2174,14 @@ modified) original contents, they are first saved to their own file."
((member (symbol-name symbol) '("+dirty" "+method"))
nil)
(t
- (prin1 symbol)
(let ((range (symbol-value symbol)))
+ (when range
+ (prin1 symbol)
(princ " ")
(princ (car range))
(princ " ")
(princ (cdr range))
- (princ "\n")))))
+ (princ "\n"))))))
my-obarray))))))))
(defun gnus-agent-get-local (group &optional gmane method)
@@ -2402,7 +2436,9 @@ modified) original contents, they are first saved to their own file."
(dolist (article marked-articles)
(gnus-summary-set-agent-mark article t))
(dolist (article fetched-articles)
- (if gnus-agent-mark-unread-after-downloaded
+ (when gnus-agent-mark-unread-after-downloaded
+ (setq gnus-newsgroup-downloadable
+ (delq article gnus-newsgroup-downloadable))
(gnus-summary-mark-article
article gnus-unread-mark))
(when (gnus-summary-goto-subject article nil t)
@@ -3191,7 +3227,7 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
((setq type
(cond
((not (integerp fetch-date))
- 'read) ;; never fetched article (may expire
+ 'read) ;; never fetched article (may expire
;; right now)
((not (file-exists-p
(concat dir (number-to-string
@@ -3871,8 +3907,9 @@ If REREAD is not nil, downloaded articles are marked as unread."
(gnus-agent-possibly-alter-active group group-active)))))
(when (and reread gnus-agent-article-alist)
- (gnus-make-ascending-articles-unread
+ (gnus-agent-synchronize-group-flags
group
+ (list (list
(if (listp reread)
reread
(delq nil (mapcar (function (lambda (c)
@@ -3880,7 +3917,9 @@ If REREAD is not nil, downloaded articles are marked as unread."
(car c))
((cdr c)
(car c)))))
- gnus-agent-article-alist))))
+ gnus-agent-article-alist)))
+ 'del '(read)))
+ gnus-command-method)
(when (gnus-buffer-live-p gnus-group-buffer)
(gnus-group-update-group group t)))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 98e699cd80c..ef5796a6083 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -535,7 +535,8 @@ Gnus provides the following functions:
(function-item gnus-summary-save-in-file)
(function-item gnus-summary-save-body-in-file)
(function-item gnus-summary-save-in-vm)
- (function-item gnus-summary-write-to-file)))
+ (function-item gnus-summary-write-to-file)
+ (function)))
(defcustom gnus-rmail-save-name 'gnus-plain-save-name
"A function generating a file name to save articles in Rmail format.
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 4477e8f579e..7785fd4c7de 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -730,9 +730,11 @@ If GROUP is non-nil, also cater to `gnus-cacheable-groups' and
;;;###autoload
(defun gnus-cache-rename-group (old-group new-group)
- "Rename OLD-GROUP as NEW-GROUP. Always updates the cache, even when
-disabled, as the old cache files would corrupt gnus when the cache was
-next enabled. Depends upon the caller to determine whether group renaming is supported."
+ "Rename OLD-GROUP as NEW-GROUP.
+Always updates the cache, even when disabled, as the old cache
+files would corrupt Gnus when the cache was next enabled. It
+depends on the caller to determine whether group renaming is
+supported."
(let ((old-dir (gnus-cache-file-name old-group ""))
(new-dir (gnus-cache-file-name new-group "")))
(gnus-rename-file old-dir new-dir t))
@@ -740,9 +742,12 @@ next enabled. Depends upon the caller to determine whether group renaming is sup
(let ((no-save gnus-cache-active-hashtb))
(unless gnus-cache-active-hashtb
(gnus-cache-read-active))
- (let* ((old-group-hash-value (gnus-gethash old-group gnus-cache-active-hashtb))
- (new-group-hash-value (gnus-gethash new-group gnus-cache-active-hashtb))
- (delta (or old-group-hash-value new-group-hash-value)))
+ (let* ((old-group-hash-value
+ (gnus-gethash old-group gnus-cache-active-hashtb))
+ (new-group-hash-value
+ (gnus-gethash new-group gnus-cache-active-hashtb))
+ (delta
+ (or old-group-hash-value new-group-hash-value)))
(gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb)
(gnus-sethash old-group nil gnus-cache-active-hashtb)
@@ -752,9 +757,11 @@ next enabled. Depends upon the caller to determine whether group renaming is sup
;;;###autoload
(defun gnus-cache-delete-group (group)
- "Delete GROUP. Always updates the cache, even when
-disabled, as the old cache files would corrupt gnus when the cache was
-next enabled. Depends upon the caller to determine whether group deletion is supported."
+ "Delete GROUP from the cache.
+Always updates the cache, even when disabled, as the old cache
+files would corrupt gnus when the cache was next enabled.
+Depends upon the caller to determine whether group deletion is
+supported."
(let ((dir (gnus-cache-file-name group "")))
(gnus-delete-directory dir))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 113d80bd124..d3b313c621f 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -858,6 +858,7 @@ prompt the user for the name of an NNTP server to use."
(set-buffer (setq gnus-dribble-buffer
(gnus-get-buffer-create
(file-name-nondirectory dribble-file))))
+ (set (make-local-variable 'file-precious-flag) t)
(erase-buffer)
(setq buffer-file-name dribble-file)
(auto-save-mode t)
diff --git a/lisp/gnus/imap.el b/lisp/gnus/imap.el
index 2be30aa6e47..967d79463f2 100644
--- a/lisp/gnus/imap.el
+++ b/lisp/gnus/imap.el
@@ -591,6 +591,13 @@ sure of changing the value of `foo'."
(while (and (memq (process-status process) '(open run))
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
+ ;; Athena IMTEST can output SSL verify errors
+ (or (while (looking-at "^verify error:num=")
+ (forward-line))
+ t)
+ (or (while (looking-at "^TLS connection established")
+ (forward-line))
+ t)
;; cyrus 1.6.x (13? < x <= 22) queries capabilities
(or (while (looking-at "^C:")
(forward-line))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 9d0bbdfeb63..108c5056541 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -335,8 +335,11 @@ for instance, text/html parts are very unwanted, and text/richtext are
somewhat unwanted, then the value of this variable should be set
to:
- (\"text/html\" \"text/richtext\")"
- :type '(repeat string)
+ (\"text/html\" \"text/richtext\")
+
+Adding \"image/.*\" might also be useful. Spammers use it as the
+prefered part of multipart/alternative messages."
+ :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'.
:group 'mime-display)
(defcustom mm-tmp-directory
@@ -761,7 +764,19 @@ external if displayed external."
(gnus-map-function mm-file-name-rewrite-functions
(file-name-nondirectory filename))
dir))
- (setq file (mm-make-temp-file (expand-file-name "mm." dir))))
+ (setq file (mm-make-temp-file (expand-file-name "mm." dir)))
+ (let ((newname
+ ;; Use nametemplate (defined in RFC1524) if it is
+ ;; specified in mailcap.
+ (if (assoc "nametemplate" mime-info)
+ (format (assoc "nametemplate" mime-info) file)
+ ;; Add a suffix according to `mailcap-mime-extensions'.
+ (concat file (car (rassoc (mm-handle-media-type handle)
+ mailcap-mime-extensions))))))
+ (unless (string-equal file newname)
+ (when (file-exists-p file)
+ (rename-file file newname))
+ (setq file newname))))
(let ((coding-system-for-write mm-binary-coding-system))
(write-region (point-min) (point-max) file nil 'nomesg))
(message "Viewing with %s" method)
@@ -819,6 +834,9 @@ external if displayed external."
(ignore-errors (kill-buffer buffer))))))
'inline)
(t
+ ;; Deleting the temp file should be postponed for some wrappers,
+ ;; shell scripts, and so on, which might exit right after having
+ ;; started a viewer command as a background job.
(let ((command (mm-mailcap-command
method file (mm-handle-type handle))))
(unwind-protect
@@ -830,24 +848,38 @@ external if displayed external."
shell-command-switch command)
(set-process-sentinel
(get-buffer-process buffer)
- `(lambda (process state)
- (when (eq 'exit (process-status process))
- ;; Don't use `ignore-errors'.
- (condition-case nil
- (delete-file ,file)
- (error))
- (condition-case nil
- (delete-directory ,(file-name-directory file))
- (error))
- (condition-case nil
- (kill-buffer ,buffer)
- (error))
- (condition-case nil
- ,(macroexpand (list 'mm-handle-set-undisplayer
- (list 'quote handle)
- nil))
- (error))
- (message "Displaying %s...done" ,command)))))
+ (lexical-let ;; Don't use `let'.
+ ;; Function used to remove temp file and directory.
+ ((fn `(lambda nil
+ ;; Don't use `ignore-errors'.
+ (condition-case nil
+ (delete-file ,file)
+ (error))
+ (condition-case nil
+ (delete-directory
+ ,(file-name-directory file))
+ (error))))
+ ;; Form uses to kill the process buffer and
+ ;; remove the undisplayer.
+ (fm `(progn
+ (kill-buffer ,buffer)
+ ,(macroexpand
+ (list 'mm-handle-set-undisplayer
+ (list 'quote handle)
+ nil))))
+ ;; Message to be issued when the process exits.
+ (done (format "Displaying %s...done" command))
+ ;; In particular, the timer object (which is
+ ;; a vector in Emacs but is a list in XEmacs)
+ ;; requires that it is lexically scoped.
+ (timer (run-at-time 2.0 nil 'ignore)))
+ (lambda (process state)
+ (when (eq 'exit (process-status process))
+ (if (memq timer timer-list)
+ (timer-set-function timer fn)
+ (funcall fn))
+ (ignore-errors (eval fm))
+ (message "%s" done))))))
(mm-handle-set-external-undisplayer
handle (cons file buffer)))
(message "Displaying %s..." command))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 033548e3bed..03c188b87a0 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -250,19 +250,19 @@
(point-min) (point-max)
(list 'keymap w3m-minor-mode-map
;; Put the mark meaning this part was rendered by emacs-w3m.
- 'mm-inline-text-html-with-w3m t))))
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (if (functionp 'remove-specifier)
- (mapcar (lambda (prop)
- (remove-specifier
- (face-property 'default prop)
- (current-buffer)))
- '(background background-pixmap foreground)))
- (delete-region ,(point-min-marker)
- ,(point-max-marker))))))))
+ 'mm-inline-text-html-with-w3m t)))
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let (buffer-read-only)
+ (if (functionp 'remove-specifier)
+ (mapcar (lambda (prop)
+ (remove-specifier
+ (face-property 'default prop)
+ (current-buffer)))
+ '(background background-pixmap foreground)))
+ (delete-region ,(point-min-marker)
+ ,(point-max-marker)))))))))
(defun mm-links-remove-leading-blank ()
;; Delete the annoying three spaces preceding each line of links
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index ad913d441b7..1f0d1c91f49 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1872,9 +1872,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(case-fold-search nil)
(from (or (message-fetch-field "from") ""))
(to (or (message-fetch-field "to") ""))
- (date (date-to-time
- (or (message-fetch-field "date") (current-time-string))))
+ (date (message-fetch-field "date"))
(target 'delete))
+ (setq date (if date
+ (condition-case err
+ (date-to-time date)
+ (error
+ (message "%s" (error-message-string err))
+ (current-time)))
+ (current-time)))
(dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
(setq header (car regexp-target-pair))
(cond
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 0885737c953..ca63fa597ef 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -102,7 +102,7 @@ This command is used by the various nntp-open-via-* methods.")
(defvoo nntp-end-of-line "\r\n"
"*String to use on the end of lines when talking to the NNTP server.
This is \"\\r\\n\" by default, but should be \"\\n\" when
-using and indirect connection method (nntp-open-via-*).")
+using an indirect connection method (nntp-open-via-*).")
(defvoo nntp-via-rlogin-command "rsh"
"*Rlogin command used to connect to an intermediate host.
@@ -259,6 +259,13 @@ Within a string, %s is replaced with the server address and %p with
port number on server. The program should accept IMAP commands on
stdin and return responses to stdout.")
+(defvar nntp-authinfo-rejected nil
+"A custom error condition used to report 'Authentication Rejected' errors.
+Condition handlers that match just this condition ensure that the nntp
+backend doesn't catch this error.")
+(put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected))
+(put 'nntp-authinfo-rejected 'error-message "Authorization Rejected")
+
;;; Internal functions.
@@ -313,12 +320,15 @@ be restored and the command retried."
(set-buffer (process-buffer process))
(goto-char (point-min))
(while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
- (looking-at "480"))
+ (looking-at "48[02]"))
(memq (process-status process) '(open run)))
- (when (looking-at "480")
+ (cond ((looking-at "480")
(nntp-handle-authinfo process))
- (when (looking-at "^.*\n")
- (delete-region (point) (progn (forward-line 1) (point))))
+ ((looking-at "482")
+ (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message))
+ (signal 'nntp-authinfo-rejected nil))
+ ((looking-at "^.*\n")
+ (delete-region (point) (progn (forward-line 1) (point)))))
(nntp-accept-process-output process)
(goto-char (point-min)))
(prog1
@@ -411,6 +421,8 @@ be restored and the command retried."
(wait-for
(nntp-wait-for process wait-for buffer decode))
(t t)))
+ (nntp-authinfo-rejected
+ (signal 'nntp-authinfo-rejected (cdr err)))
(error
(nnheader-report 'nntp "Couldn't open connection to %s: %s"
address err))
diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el
index f328f2dbc6a..df9a5b7bd82 100644
--- a/lisp/gnus/rfc2231.el
+++ b/lisp/gnus/rfc2231.el
@@ -127,7 +127,17 @@ The list will be on the form
(> c ?\177)) ;; EXTENSION: Support non-ascii chars.
(not (memq c stoken)))
(setq value (buffer-substring
- (point) (progn (forward-sexp) (point)))))
+ (point)
+ (progn
+ (forward-sexp)
+ ;; We might not have reached at the end of
+ ;; the value because of non-ascii chars,
+ ;; so we should jump over them if any.
+ (while (and (not (eobp))
+ (> (char-after) ?\177))
+ (forward-char 1)
+ (forward-sexp))
+ (point)))))
(t
(error "Invalid header: %s" string)))
(if number
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-23 17:18:13 +0000