summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/misc/ChangeLog24
-rw-r--r--doc/misc/emacs-mime.texi15
-rw-r--r--doc/misc/gnus.texi19
-rw-r--r--lisp/ChangeLog34
-rw-r--r--lisp/gnus/ChangeLog158
-rw-r--r--lisp/gnus/gnus-agent.el18
-rw-r--r--lisp/gnus/gnus-art.el105
-rw-r--r--lisp/gnus/gnus-cache.el5
-rw-r--r--lisp/gnus/gnus-dired.el99
-rw-r--r--lisp/gnus/gnus-group.el18
-rw-r--r--lisp/gnus/gnus-int.el6
-rw-r--r--lisp/gnus/gnus-kill.el1
-rw-r--r--lisp/gnus/gnus-move.el3
-rw-r--r--lisp/gnus/gnus-msg.el5
-rw-r--r--lisp/gnus/gnus-srvr.el2
-rw-r--r--lisp/gnus/gnus-start.el29
-rw-r--r--lisp/gnus/gnus-sum.el1
-rw-r--r--lisp/gnus/gnus-uu.el46
-rw-r--r--lisp/gnus/gnus.el27
-rw-r--r--lisp/gnus/mail-source.el9
-rw-r--r--lisp/gnus/mailcap.el27
-rw-r--r--lisp/gnus/message.el16
-rw-r--r--lisp/gnus/mm-uu.el9
-rw-r--r--lisp/gnus/nnkiboze.el3
-rw-r--r--lisp/gnus/nnmail.el26
-rw-r--r--lisp/gnus/rfc2047.el66
-rw-r--r--lisp/gnus/yenc.el19
-rw-r--r--lisp/net/imap.el11
-rw-r--r--lisp/net/tls.el123
29 files changed, 712 insertions, 212 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 02e39fe8171..61fd28a0622 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,27 @@
+2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Other Files): Add the yenc command.
+
+2007-11-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.texi (MIME Commands): Default of gnus-article-loose-mime is t
+ since 2004-08-06.
+
+2007-11-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.texi (Fancy Mail Splitting): Fix description of splitting based
+ on body.
+
+2007-11-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emacs-mime.texi (rfc2047): Mention rfc2047-encoded-word-regexp-loose
+ and rfc2047-allow-irregular-q-encoded-words; fix description of
+ rfc2047-encode-encoded-words.
+
+2007-11-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.texi (Fetching Mail): Remove obsoleted `nnmail-spool-file'.
+
2007-12-05 Michael Olson <mwolson@gnu.org>
* remember.texi (Diary): Remove "require" line for remember-diary.el.
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index d4cbf8380b6..f8be71ef860 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -1417,10 +1417,23 @@ This is an alist of encoding / function pairs. The encodings are
@vindex rfc2047-encoded-word-regexp
When decoding words, this library looks for matches to this regexp.
+@item rfc2047-encoded-word-regexp-loose
+@vindex rfc2047-encoded-word-regexp-loose
+This is a version from which the regexp for the Q encoding pattern of
+@code{rfc2047-encoded-word-regexp} is made loose.
+
@item rfc2047-encode-encoded-words
@vindex rfc2047-encode-encoded-words
The boolean variable specifies whether encoded words
-(e.g. @samp{=?hello?=}) should be encoded again.
+(e.g. @samp{=?us-ascii?q?hello?=}) should be encoded again.
+@code{rfc2047-encoded-word-regexp} is used to look for such words.
+
+@item rfc2047-allow-irregular-q-encoded-words
+@vindex rfc2047-allow-irregular-q-encoded-words
+The boolean variable specifies whether irregular Q encoded words
+(e.g. @samp{=?us-ascii?q?hello??=}) should be decoded. If it is
+non-@code{nil}, @code{rfc2047-encoded-word-regexp-loose} is used instead
+of @code{rfc2047-encoded-word-regexp} to look for encoded words.
@end table
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 97e70c1cec2..10e7741f8d2 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -8175,6 +8175,11 @@ Save the current series
@findex gnus-uu-decode-binhex
Unbinhex the current series (@code{gnus-uu-decode-binhex}). This
doesn't really work yet.
+
+@item X Y
+@kindex X Y (Summary)
+@findex gnus-uu-decode-yenc
+yEnc-decode the current series and save it (@code{gnus-uu-decode-yenc}).
@end table
@@ -9740,7 +9745,7 @@ To have all Vcards be ignored, you'd say something like this:
If non-@code{nil}, Gnus won't require the @samp{MIME-Version} header
before interpreting the message as a @acronym{MIME} message. This helps
when reading messages from certain broken mail user agents. The
-default is @code{nil}.
+default is @code{t}.
@item gnus-article-emulate-mime
@vindex gnus-article-emulate-mime
@@ -14649,14 +14654,12 @@ If non-@code{nil}, name of program for fetching new mail. If
@subsubsection Fetching Mail
@vindex mail-sources
-@vindex nnmail-spool-file
The way to actually tell Gnus where to get new mail from is to set
@code{mail-sources} to a list of mail source specifiers
(@pxref{Mail Source Specifiers}).
-If this variable (and the obsolescent @code{nnmail-spool-file}) is
-@code{nil}, the mail back ends will never attempt to fetch mail by
-themselves.
+If this variable is @code{nil}, the mail back ends will never attempt to
+fetch mail by themselves.
If you want to fetch mail both from your local spool as well as a
@acronym{POP} mail server, you'd say something like:
@@ -14865,9 +14868,9 @@ body of the messages:
"string.group"))))
@end lisp
-The buffer is narrowed to the message in question when @var{function}
-is run. That's why @code{(widen)} needs to be called after
-@code{save-excursion} and @code{save-restriction} in the example
+The buffer is narrowed to the header of the message in question when
+@var{function} is run. That's why @code{(widen)} needs to be called
+after @code{save-excursion} and @code{save-restriction} in the example
above. Also note that with the nnimap back end, message bodies will
not be downloaded by default. You need to set
@code{nnimap-split-download-body} to @code{t} to do that
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 733fba10ebe..1bcc372a619 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,37 @@
+2007-12-05 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * net/tls.el (tls-hostmismatch, open-tls-stream): Checkdoc cleanup.
+
+2007-12-05 Elias Oltmanns <eo@nebensachen.de>
+
+ * net/tls.el (open-tls-stream): Actually consult tls-checktrust to
+ see if certs should be verified and what is to be done in the
+ event of a verification failure.
+
+2007-12-05 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * net/tls.el (tls-program): Provide more custom choices from
+ `tls-checktrust'. Refer to `tls-checktrust' in doc string.
+ (tls-process-connection-type, tls-success): Remove "*" in doc string.
+ (tls-checktrust, tls-hostmismatch, tls-untrusted): Add custom
+ version. Minor improvement to doc strings.
+ (tls-program): Add comment.
+
+2007-12-05 Elias Oltmanns <eo@nebensachen.de>
+
+ * net/tls.el (tls-certtool-program, tls-hostmismatch): New variables.
+ (tls-checktrust): New variable. Check if GNU TLS complained about a
+ mismatch between the hostname provided in the certificate and the name
+ of the host connnecting to.
+ (open-tls-stream): Use them. Check certificates against trusted root
+ certificates.
+
+2007-12-05 Nathan J. Williams <nathanw@MIT.EDU> (tiny change)
+
+ * net/imap.el (imap-mailbox-status-asynch): Upcase STATUS items.
+ (imap-parse-status): Upcase status-att for broken servers that sends
+ them lower-case (e.g., MS Exchange 2007).
+
2007-12-05 D. Goel <deego3@gmail.com>
* simple.el (undo): Ditto.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 7f6dda4c5eb..87e7f595cab 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,31 @@
+2007-12-04 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-group.el (gnus-group-highlight-line): Add FIXME.
+
+ * gnus-dired.el: Reduce Gnus dependencies.
+ (gnus-ems, gnus-msg, gnus-util, message, mm-decode, mml): Don't
+ require. Use autoloads instead.
+ (mml-attach-file, mm-default-file-encoding, mailcap-extension-to-mime)
+ (mailcap-mime-info, mm-mailcap-command, ps-print-preprint)
+ (message-buffers, gnus-setup-message, gnus-print-buffer): Autoload.
+ (gnus-dired-mode): Adjust doc string.
+ (gnus-dired-mail-mode): New variable.
+ (gnus-dired-mode-map): Avoid using `gnus-define-keys'.
+ (gnus-dired-mode): Avoid using `gnus-run-hooks'.
+ (gnus-dired-mail-buffers): New function. Return mail or message
+ composition buffers.
+ (gnus-dired-attach): Use it.
+ (gnus-dired-find-file-mailcap): Call `mailcap-mime-info' with
+ NO-DECODE.
+ (gnus-dired-print): Use `gnus-print-buffer' depending on
+ `gnus-dired-mail-mode'.
+
+2007-12-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * rfc2047.el (rfc2047-encoded-word-regexp)
+ (rfc2047-encoded-word-regexp-loose): Move forward; add comments
+ explaining what regexp patterns are for.
+
2007-12-04 Glenn Morris <rgm@gnu.org>
* password.el: Move to ../password-cache.el.
@@ -15,6 +43,29 @@
* mml-sec.el, sieve-manage.el, smime.el: Require password-cache or
password.
+2007-12-03 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mailcap.el: Reduce dependencies.
+ (mail-header-parse-content-type): Autoload.
+ (mailcap-delete-duplicates): New alias.
+ (mailcap-mime-info): Add optional argument NO-DECODE.
+ (mailcap-mime-types): Use mailcap-delete-duplicates.
+
+ * message.el (message-ignored-supersedes-headers): Add "X-ID".
+
+2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc
+ function.
+
+ * gnus-uu.el (gnus-uu-decode-yenc): New command.
+ (gnus-uu-yenc-article): New function.
+
+ * yenc.el (yenc-first-part-p, yenc-last-part-p): New functions.
+
+ * mm-uu.el (mm-uu-yenc-extract): Get the data from the original
+ buffer.
+
2007-12-02 Glenn Morris <rgm@gnu.org>
* sasl-cram.el, sasl-digest.el, sasl-ntlm.el, sasl.el:
@@ -24,6 +75,20 @@
* encrypt.el: Remove file.
+2007-12-01 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-cite-prefix-regexp): Remove `-' and `+' to avoid
+ matches on patches.
+
+ * gnus-art.el (gnus-article-browse-html-article): Mention
+ `mm-text-html-renderer' in the doc string.
+
+ * rfc2047.el (rfc2047-encode-max-chars): Refer to RFC 2047 in doc
+ string. Add comments.
+
+ * message.el (message-idna-to-ascii-rhs-1): Don't call `idna-to-ascii'
+ if rhs is ASCII.
+
2007-12-01 Glenn Morris <rgm@gnu.org>
* dig.el, dns.el: Move to ../net.
@@ -36,15 +101,91 @@
* encrypt.el: Require password, rather than autoloading password-read.
+2007-11-28 Elias Oltmanns <eo@nebensachen.de>
+
+ * gnus.el (gnus-method-to-server): Add an optional parameter so the
+ caller can indicate whether the cache should be disregarded for this
+ call. This way the result of the call is reproducible at all times and
+ can be considered a canonical server name for the supplied method.
+ (gnus-agent-method-p): Canonicalize server names by pushing their
+ method through `gnus-method-to-server' using the no-cache argument.
+
+ * gnus-srvr.el (gnus-server-insert-server-line): Call
+ `gnus-method-to-server' with `no-cache' argument.
+
+ * gnus-agent.el (gnus-agent-toggle-plugged): Don't call
+ gnus-agent-possibly-synchronize-flags as this should be called when the
+ server is actually being opened.
+ (gnus-agent-possibly-synchronize-flags)
+ (gnus-agent-possibly-synchronize-flags-server): Move check for the
+ flags file of an agentized server to the latter function.
+
+ * gnus-int.el (gnus-agent-possibly-synchronize-flags-server): Autoload.
+ (gnus-open-server): Call gnus-agent-possibly-synchronize-flags-server
+ after a connection has been established successfully.
+
+2007-11-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (article-display-face): Force to display face if called
+ interactively; check if gnus-article-x-face-too-ugly matches author.
+ (article-display-x-face): Display face even if From header is missing
+ as article-display-face does.
+
2007-11-28 Richard Stallman <rms@gnu.org>
* md4.el: Move to ../.
* hmac-def.el, hmac-md5.el, ntlm.el: Move to ../net.
+2007-11-27 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mail-source.el (mail-sources): Default to fetch from file for
+ compatibility with default of nnmail-spool-file.
+
+2007-11-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * rfc2047.el (rfc2047-allow-irregular-q-encoded-words): New variable.
+ (rfc2047-encodable-p): Use rfc2047-encoded-word-regexp instead of "=?"
+ to look for encoded word that should be encoded again.
+ (rfc2047-encoded-word-regexp): Make B encoding pattern strict.
+ (rfc2047-encoded-word-regexp-loose): New constant that has loose Q
+ encoding pattern.
+ (rfc2047-decode-region): Switch strict regexp and loose one according
+ to rfc2047-allow-irregular-q-encoded-words.
+
2007-11-26 Simon Josefsson <simon@josefsson.org>
* imap.el: Move to ../net directory.
+2007-11-25 Romain Francoise <romain@orebokech.com>
+
+ * gnus-msg.el (gnus-summary-reply): Delete extra paren.
+
+2007-11-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * nnmail.el (nnmail-spool-file): Remove obsolete variable.
+ (nnmail-get-new-mail): Remove code using `nnmail-spool-file'.
+
+ * gnus-start.el (defvar, gnus-get-unread-articles): Remove code using
+ `nnmail-spool-file'.
+
+ * nnkiboze.el (nnkiboze-generate-groups): Don't bind obsolete
+ `nnmail-spool-file'.
+
+ * gnus-move.el (gnus-change-server): Ditto.
+
+ * gnus-kill.el (gnus-batch-score): Ditto.
+
+ * gnus-cache.el (gnus-jog-cache): Ditto.
+
+ * gnus-msg.el (gnus-summary-reply): Ignore
+ gnus-confirm-mail-reply-to-news for wide and very wide replies.
+
+2007-11-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-cache.el (gnus-cache-generate-nov-databases): Use
+ nnml-generate-nov-databases-directory instead of
+ nnml-generate-nov-databases-1.
+
2007-11-24 Glenn Morris <rgm@gnu.org>
* message.el (message-tool-bar-retro): Update for rename
@@ -52,6 +193,11 @@
2007-11-22 Reiner Steib <Reiner.Steib@gmx.de>
+ * smime.el (smime-cert-by-ldap-1): Use `ldap-search' instead of
+ `smime-ldap-search' for Emacs 22 and up.
+
+2007-11-22 Reiner Steib <Reiner.Steib@gmx.de>
+
* hashcash.el: Move to ../mail directory.
* smime-ldap.el: Remove. Not used in Emacs 22 and up.
@@ -87,6 +233,18 @@
(spam-check-crm114, spam-initialize, spam-unload-hook):
Fix typos in docstrings.
+2007-11-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-get-unread-articles): Mark groups as having never
+ been checked if they have never been read and those group levels are
+ higher than the one that a user specified.
+
+2007-11-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-get-unread-articles): Don't prevent from checking
+ foreign groups unless a group level is specified by a user.
+ Reported by Dan Nicolaescu <dann@ics.uci.edu>.
+
2007-11-21 Reiner Steib <Reiner.Steib@gmx.de>
* message.el (message-send-mail-function): Require sendmail.
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index a29d985463f..22ffd585973 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -636,8 +636,7 @@ manipulated as follows:
(gnus-agent-make-mode-line-string " Plugged"
'mouse-2
'gnus-agent-toggle-plugged))
- (gnus-agent-go-online gnus-agent-go-online)
- (gnus-agent-possibly-synchronize-flags))
+ (gnus-agent-go-online gnus-agent-go-online))
(t
(gnus-agent-close-connections)
(setq gnus-plugged set-to)
@@ -868,8 +867,7 @@ be a select method."
(interactive)
(save-excursion
(dolist (gnus-command-method (gnus-agent-covered-methods))
- (when (and (file-exists-p (gnus-agent-lib-file "flags"))
- (eq (gnus-server-status gnus-command-method) 'ok))
+ (when (eq (gnus-server-status gnus-command-method) 'ok)
(gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
(defun gnus-agent-synchronize-flags-server (method)
@@ -905,11 +903,13 @@ be a select method."
(defun gnus-agent-possibly-synchronize-flags-server (method)
"Synchronize flags for server according to `gnus-agent-synchronize-flags'."
- (when (or (and gnus-agent-synchronize-flags
- (not (eq gnus-agent-synchronize-flags 'ask)))
- (and (eq gnus-agent-synchronize-flags 'ask)
- (gnus-y-or-n-p (format "Synchronize flags on server `%s'? "
- (cadr method)))))
+ (when (and (file-exists-p (gnus-agent-lib-file "flags"))
+ (or (and gnus-agent-synchronize-flags
+ (not (eq gnus-agent-synchronize-flags 'ask)))
+ (and (eq gnus-agent-synchronize-flags 'ask)
+ (gnus-y-or-n-p
+ (format "Synchronize flags on server `%s'? "
+ (cadr method))))))
(gnus-agent-synchronize-flags-server method)))
;;;###autoload
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 4b93c030ac7..059d43bf0b8 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2334,9 +2334,9 @@ long lines iff arg is positive."
(defvar gnus-face-properties-alist)
-(defun article-display-face ()
+(defun article-display-face (&optional force)
"Display any Face headers in the header."
- (interactive)
+ (interactive (list 'force))
(let ((wash-face-p buffer-read-only))
(gnus-with-article-headers
;; When displaying parts, this function can be called several times on
@@ -2346,7 +2346,8 @@ long lines iff arg is positive."
;; read-only.
(if (and wash-face-p (memq 'face gnus-article-wash-types))
(gnus-delete-images 'face)
- (let (face faces from)
+ (let ((from (message-fetch-field "from"))
+ face faces)
(save-current-buffer
(when (and wash-face-p
(gnus-buffer-live-p gnus-original-article-buffer)
@@ -2354,16 +2355,22 @@ long lines iff arg is positive."
(set-buffer gnus-original-article-buffer))
(save-restriction
(mail-narrow-to-head)
- (while (gnus-article-goto-header "Face")
- (push (mail-header-field-value) faces))))
+ (when (or force
+ ;; Check whether this face is censored.
+ (not (and gnus-article-x-face-too-ugly
+ (or from
+ (setq from (message-fetch-field "from")))
+ (string-match gnus-article-x-face-too-ugly
+ from))))
+ (while (gnus-article-goto-header "Face")
+ (push (mail-header-field-value) faces)))))
(when faces
(goto-char (point-min))
- (let ((from (gnus-article-goto-header "from"))
- png image)
- (unless from
+ (let (png image)
+ (unless (setq from (gnus-article-goto-header "from"))
(insert "From:")
(setq from (point))
- (insert "[no `from' set]\n"))
+ (insert " [no `from' set]\n"))
(while faces
(when (setq png (gnus-convert-face-to-png (pop faces)))
(setq image
@@ -2388,7 +2395,8 @@ long lines iff arg is positive."
;; instead.
(gnus-delete-images 'xface)
;; Display X-Faces.
- (let (x-faces from face)
+ (let ((from (message-fetch-field "from"))
+ x-faces face)
(save-current-buffer
(when (and wash-face-p
(gnus-buffer-live-p gnus-original-article-buffer)
@@ -2399,43 +2407,41 @@ long lines iff arg is positive."
(set-buffer gnus-original-article-buffer))
(save-restriction
(mail-narrow-to-head)
- (while (gnus-article-goto-header "X-Face")
- (push (mail-header-field-value) x-faces))
- (setq from (message-fetch-field "from"))))
- ;; 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))))
- (when (and x-faces
- gnus-article-x-face-command
- (or force
- ;; Check whether this face is censored.
- (not gnus-article-x-face-too-ugly)
- (and from
- (not (string-match gnus-article-x-face-too-ugly
- from)))))
- (while (setq face (pop x-faces))
- ;; We display the face.
- (cond ((stringp 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))
- (gnus-set-process-query-on-exit-flag
- (start-process
- "article-x-face" nil shell-file-name
- shell-command-switch gnus-article-x-face-command)
- nil)
- (with-temp-buffer
- (insert face)
- (process-send-region "article-x-face"
- (point-min) (point-max)))
- (process-send-eof "article-x-face")))
- ((functionp gnus-article-x-face-command)
- ;; The command is a lisp function, so we call it.
- (funcall gnus-article-x-face-command face))
- (t
- (error "%s is not a function"
- gnus-article-x-face-command))))))))))
+ (and gnus-article-x-face-command
+ (or force
+ ;; Check whether this face is censored.
+ (not (and gnus-article-x-face-too-ugly
+ (or from
+ (setq from (message-fetch-field "from")))
+ (string-match gnus-article-x-face-too-ugly
+ from))))
+ (while (gnus-article-goto-header "X-Face")
+ (push (mail-header-field-value) x-faces)))))
+ (when x-faces
+ ;; We display the face.
+ (cond ((functionp gnus-article-x-face-command)
+ ;; The command is a lisp function, so we call it.
+ (mapc gnus-article-x-face-command x-faces))
+ ((stringp 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))
+ (gnus-set-process-query-on-exit-flag
+ (start-process
+ "article-x-face" nil shell-file-name
+ shell-command-switch gnus-article-x-face-command)
+ nil)
+ ;; Sending multiple EOFs to xv doesn't work,
+ ;; so we only do a single external face.
+ (with-temp-buffer
+ (insert (car x-faces))
+ (process-send-region "article-x-face"
+ (point-min) (point-max)))
+ (process-send-eof "article-x-face")))
+ (t
+ (error "`%s' set to `%s' is not a function"
+ gnus-article-x-face-command
+ 'gnus-article-x-face-command)))))))))
(defun article-decode-mime-words ()
"Decode all MIME-encoded words in the article."
@@ -2823,7 +2829,10 @@ Warning: Spammers use links to images in HTML articles to verify
whether you have read the message. As
`gnus-article-browse-html-article' passes the unmodified HTML
content to the browser without eliminating these \"web bugs\" you
-should only use it for mails from trusted senders."
+should only use it for mails from trusted senders.
+
+If you alwasy want to display HTML part in the browser, set
+`mm-text-html-renderer' to nil."
;; Cf. `mm-w3m-safe-url-regexp'
(interactive)
(save-window-excursion
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index fecb0685858..4f61a0f2759 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -92,7 +92,7 @@ it's not cached."
(defvar gnus-cache-total-fetched-hashtb nil)
(eval-and-compile
- (autoload 'nnml-generate-nov-databases-1 "nnml")
+ (autoload 'nnml-generate-nov-databases-directory "nnml")
(autoload 'nnvirtual-find-group-art "nnvirtual"))
@@ -620,7 +620,6 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
(interactive)
(let ((gnus-mark-article-hook nil)
(gnus-expert-user t)
- (nnmail-spool-file nil)
(mail-sources nil)
(gnus-use-dribble-file nil)
(gnus-novice-user nil)
@@ -756,7 +755,7 @@ If LOW, update the lower bound instead."
(interactive (list gnus-cache-directory))
(gnus-cache-close)
(let ((nnml-generate-active-function 'identity))
- (nnml-generate-nov-databases-1 dir))
+ (nnml-generate-nov-databases-directory dir))
(setq gnus-cache-total-fetched-hashtb nil)
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index fa9ef21bd1a..97e61a013c8 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -42,25 +42,55 @@
;;; Code:
(require 'dired)
-(require 'gnus-ems)
-(require 'gnus-msg)
-(require 'gnus-util)
-(require 'message)
-(require 'mm-encode)
-(require 'mml)
+(autoload 'mml-attach-file "mml")
+(autoload 'mm-default-file-encoding "mm-decode");; Shift this to `mailcap.el'?
+(autoload 'mailcap-extension-to-mime "mailcap")
+(autoload 'mailcap-mime-info "mailcap")
+
+;; Maybe shift this function to `mailcap.el'?
+(autoload 'mm-mailcap-command "mm-decode")
+
+(autoload 'ps-print-preprint "ps-print")
+
+;; Autoloads to avoid byte-compiler warnings. These are used only if the user
+;; customizes `gnus-dired-mail-mode' to use Message and/or Gnus.
+(autoload 'message-buffers "message")
+(autoload 'gnus-setup-message "gnus-msg")
+(autoload 'gnus-print-buffer "gnus-sum")
(defvar gnus-dired-mode nil
- "Minor mode for intersections of gnus and dired.")
+ "Minor mode for intersections of MIME mail composition and dired.")
(defvar gnus-dired-mode-map nil)
(unless gnus-dired-mode-map
(setq gnus-dired-mode-map (make-sparse-keymap))
- (gnus-define-keys gnus-dired-mode-map
- "\C-c\C-m\C-a" gnus-dired-attach
- "\C-c\C-m\C-l" gnus-dired-find-file-mailcap
- "\C-c\C-m\C-p" gnus-dired-print))
+ (define-key gnus-dired-mode-map "\C-c\C-m\C-a" 'gnus-dired-attach)
+ (define-key gnus-dired-mode-map "\C-c\C-m\C-l" 'gnus-dired-find-file-mailcap)
+ (define-key gnus-dired-mode-map "\C-c\C-m\C-p" 'gnus-dired-print))
+
+;; FIXME: Make it customizable, change the default to `mail-user-agent' when
+;; this file if renamed (e.g. to `dired-mime.el').
+
+(defcustom gnus-dired-mail-mode 'gnus-user-agent ;; mail-user-agent
+ "Your preference for a mail composition package.
+See `mail-user-agent' for more information."
+ :group 'mail ;; dired?
+ :version "23.0" ;; No Gnus
+ :type '(radio (function-item :tag "Default Emacs mail"
+ :format "%t\n"
+ sendmail-user-agent)
+ (function-item :tag "Emacs interface to MH"
+ :format "%t\n"
+ mh-e-user-agent)
+ (function-item :tag "Gnus Message package"
+ :format "%t\n"
+ message-user-agent)
+ (function-item :tag "Gnus Message with full Gnus features"
+ :format "%t\n"
+ gnus-user-agent)
+ (function :tag "Other")))
(defun gnus-dired-mode (&optional arg)
"Minor mode for intersections of gnus and dired.
@@ -73,14 +103,31 @@
(> (prefix-numeric-value arg) 0)))
(when gnus-dired-mode
(add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map)
- (gnus-run-hooks 'gnus-dired-mode-hook))))
+ (save-current-buffer
+ (run-hooks 'gnus-dired-mode-hook)))))
;;;###autoload
(defun turn-on-gnus-dired-mode ()
"Convenience method to turn on gnus-dired-mode."
+ (interactive)
(gnus-dired-mode 1))
-;; Method to attach files to a gnus composition.
+(defun gnus-dired-mail-buffers ()
+ "Return a list of active mail composition buffers."
+ (if (and (memq gnus-dired-mail-mode '(message-user-agent gnus-user-agent))
+ (require 'message)
+ (fboundp 'message-buffers))
+ (message-buffers)
+ ;; Cf. `message-buffers' in `message.el':
+ (let (buffers)
+ (save-excursion
+ (dolist (buffer (buffer-list t))
+ (set-buffer buffer)
+ (when (eq major-mode 'mail-mode)
+ (push (buffer-name buffer) buffers))))
+ (nreverse buffers))))
+
+;; Method to attach files to a mail composition.
(defun gnus-dired-attach (files-to-attach)
"Attach dired's marked files to a gnus message composition.
If called non-interactively, FILES-TO-ATTACH should be a list of
@@ -102,22 +149,25 @@ filenames."
(mapconcat
(lambda (f) (file-name-nondirectory f))
files-to-attach ", "))
- (setq bufs (message-buffers))
+ (setq bufs (gnus-dired-mail-buffers))
- ;; set up destination message buffer
+ ;; set up destination mail composition buffer
(if (and bufs
- (y-or-n-p "Attach files to existing message buffer? "))
+ (y-or-n-p "Attach files to existing mail composition buffer? "))
(setq destination
(if (= (length bufs) 1)
(get-buffer (car bufs))
- (completing-read "Attach to which message buffer: "
+ (completing-read "Attach to which mail composition buffer: "
(mapcar
(lambda (b)
(cons b (get-buffer b)))
bufs)
nil t)))
- ;; setup a new gnus message buffer
- (gnus-setup-message 'message (message-mail))
+ ;; setup a new mail composition buffer
+ (if (eq gnus-dired-mail-mode 'gnus-user-agent)
+ (gnus-setup-message 'message (message-mail))
+ ;; FIXME: Is this the right thing?
+ (compose-mail))
(setq destination (current-buffer)))
;; set buffer to destination buffer, and attach files
@@ -151,7 +201,8 @@ If ARG is non-nil, open it in a new buffer."
(setq method
(cdr (assoc 'viewer
(car (mailcap-mime-info mime-type
- 'all)))))))
+ 'all
+ 'no-decode)))))))
(let ((view-command (mm-mailcap-command method file-name nil)))
(message "viewing via %s" view-command)
(start-process "*display*"
@@ -186,7 +237,8 @@ file to save in."
(mailcap-extension-to-mime
(match-string 0 file-name)))
(stringp
- (setq method (mailcap-mime-info mime-type "print"))))
+ (setq method (mailcap-mime-info mime-type "print"
+ 'no-decode))))
(call-process shell-file-name nil
(generate-new-buffer " *mm*")
nil
@@ -194,7 +246,10 @@ file to save in."
(mm-mailcap-command method file-name mime-type))
(with-temp-buffer
(insert-file-contents file-name)
- (gnus-print-buffer))
+ (if (eq gnus-dired-mail-mode 'gnus-user-agent)
+ (gnus-print-buffer)
+ ;; FIXME:
+ (error "MIME print only implemeted via Gnus")))
(ps-despool print-to))))
((file-symlink-p file-name)
(error "File is a symlink to a nonexistent target"))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index d043a515f49..5843214e48a 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1655,6 +1655,24 @@ if it is a string, only list groups matching REGEXP."
(ticked (gnus-range-length (cdr (assq 'tick marked))))
(group-age (gnus-group-timestamp-delta group))
(inhibit-read-only t))
+ ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
+ ;; ======================================================================
+ ;; From: Richard Stallman
+ ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
+ ;; Cc: ding@gnus.org
+ ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
+ ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
+ ;;
+ ;; [...]
+ ;; The kludge is that the alist elements contain expressions that refer
+ ;; to local variables with short names. Perhaps write your own tiny
+ ;; evaluator that handles just `and', `or', and numeric comparisons
+ ;; and just a few specific variables.
+ ;; ======================================================================
+ ;;
+ ;; Similar for other evaluated variables. Grep for risky-local-variable
+ ;; to find them! -- rsteib
+ ;;
;; Eval the cars of the lists until we find a match.
(while (and list
(not (eval (caar list))))
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 52b5e350653..ac2b7237866 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -36,6 +36,7 @@
(autoload 'gnus-agent-expire "gnus-agent")
(autoload 'gnus-agent-regenerate-group "gnus-agent")
(autoload 'gnus-agent-read-servers-validate-native "gnus-agent")
+(autoload 'gnus-agent-possibly-synchronize-flags-server "gnus-agent")
(defcustom gnus-open-server-hook nil
"Hook called just before opening connection to the news server."
@@ -278,6 +279,11 @@ If it is down, start it up (again)."
;; prompting with "go offline?". This is only a concern
;; when the agent's backend fails to open the server.
(gnus-open-server gnus-command-method))
+ (when (and (eq (cadr elem) 'ok) gnus-agent
+ (gnus-agent-method-p gnus-command-method))
+ (save-excursion
+ (gnus-agent-possibly-synchronize-flags-server
+ gnus-command-method)))
result)))))
(defun gnus-close-server (gnus-command-method)
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index 5778a02e168..2d64a76b6c6 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -687,7 +687,6 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
(concat "options -n "
(mapconcat 'identity command-line-args-left " "))))
(gnus-expert-user t)
- (nnmail-spool-file nil)
(mail-sources nil)
(gnus-use-dribble-file nil)
(gnus-batch-mode t)
diff --git a/lisp/gnus/gnus-move.el b/lisp/gnus/gnus-move.el
index 0a97f8d5bd6..cf5cde692ff 100644
--- a/lisp/gnus/gnus-move.el
+++ b/lisp/gnus/gnus-move.el
@@ -47,8 +47,7 @@ Update the .newsrc.eld file to reflect the change of nntp server."
;; First start Gnus.
(let ((gnus-activate-level 0)
- (mail-sources nil)
- (nnmail-spool-file nil))
+ (mail-sources nil))
(gnus))
(save-excursion
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index f5bf3a7ef65..735b9ed629b 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1101,7 +1101,10 @@ If VERY-WIDE, make a very wide reply."
((functionp gnus-confirm-mail-reply-to-news)
(funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
(t gnus-confirm-mail-reply-to-news)))
- (y-or-n-p "Really reply by mail to article author? "))
+ (if (or wide very-wide)
+ t ;; Ignore gnus-confirm-mail-reply-to-news for wide and very
+ ;; wide replies.
+ (y-or-n-p "Really reply by mail to article author? ")))
(let* ((article
(if (listp (car yank))
(caar yank)
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index ca087f9ca4d..77e06ee04f8 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -280,7 +280,7 @@ The following commands are available:
;; Insert the text.
(eval gnus-server-line-format-spec))
(list 'gnus-server (intern gnus-tmp-name)
- 'gnus-named-server (intern (gnus-method-to-server method))))))
+ 'gnus-named-server (intern (gnus-method-to-server method t))))))
(defun gnus-enter-server-buffer ()
"Set up the server buffer."
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 98994d5aaf7..7d6b91366e6 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1669,7 +1669,7 @@ If SCAN, request a scan of that group as well."
(defun gnus-get-unread-articles (&optional level)
(setq gnus-server-method-cache nil)
(let* ((newsrc (cdr gnus-newsrc-alist))
- (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
+ (alevel (or level gnus-activate-level (1+ gnus-level-subscribed)))
(foreign-level
(min
(cond ((and gnus-activate-foreign-newsgroups
@@ -1678,11 +1678,11 @@ If SCAN, request a scan of that group as well."
((numberp gnus-activate-foreign-newsgroups)
gnus-activate-foreign-newsgroups)
(t 0))
- level))
+ alevel))
(methods-cache nil)
(type-cache nil)
scanned-methods info group active method retrieve-groups cmethod
- method-type ignore)
+ method-type)
(gnus-message 6 "Checking new news...")
(while newsrc
@@ -1719,7 +1719,6 @@ If SCAN, request a scan of that group as well."
'foreign)))
(push (cons method method-type) type-cache))
- (setq ignore nil)
(cond ((and method (eq method-type 'foreign))
;; These groups are foreign. Check the level.
(if (<= (gnus-info-level info) foreign-level)
@@ -1733,9 +1732,17 @@ If SCAN, request a scan of that group as well."
(when (fboundp (intern (concat (symbol-name (car method))
"-request-update-info")))
(inline (gnus-request-update-info info method))))
- (setq ignore t)))
+ (if (and level
+ ;; If `active' is nil that means the group has
+ ;; never been read, the group should be marked
+ ;; as having never been checked (see below).
+ active
+ (> (gnus-info-level info) level))
+ ;; Don't check groups of which levels are higher
+ ;; than the one that a user specified.
+ (setq active 'ignore))))
;; These groups are native or secondary.
- ((> (gnus-info-level info) level)
+ ((> (gnus-info-level info) alevel)
;; We don't want these groups.
(setq active 'ignore))
;; Activate groups.
@@ -1755,11 +1762,7 @@ If SCAN, request a scan of that group as well."
;; not required.
(if (and
(or nnmail-scan-directory-mail-source-once
- (null (assq 'directory
- (or mail-sources
- (if (listp nnmail-spool-file)
- nnmail-spool-file
- (list nnmail-spool-file))))))
+ (null (assq 'directory mail-sources)))
(member method scanned-methods))
(setq active (gnus-activate-group group))
(setq active (gnus-activate-group group 'scan))
@@ -1772,10 +1775,6 @@ If SCAN, request a scan of that group as well."
((eq active 'ignore)
;; Don't do anything.
)
- ((and active ignore)
- ;; The level of the foreign group is higher than the specified
- ;; value.
- )
(active
(inline (gnus-get-unread-articles-in-group info active t)))
(t
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 214693ece8c..b082a8b152e 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -2195,6 +2195,7 @@ increase the score of each group you read."
"O" gnus-uu-decode-save
"b" gnus-uu-decode-binhex
"B" gnus-uu-decode-binhex
+ "Y" gnus-uu-decode-yenc
"p" gnus-uu-decode-postscript
"P" gnus-uu-decode-postscript-and-save)
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index d3b13f3843a..3a045c2c234 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -35,6 +35,7 @@
(require 'message)
(require 'gnus-msg)
(require 'mm-decode)
+(require 'yenc)
(defgroup gnus-extract nil
"Extracting encoded files."
@@ -346,6 +347,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(defvar gnus-uu-file-name nil)
(defvar gnus-uu-uudecode-process nil)
(defvar gnus-uu-binhex-article-name nil)
+(defvar gnus-uu-yenc-article-name nil)
(defvar gnus-uu-work-dir nil)
@@ -412,6 +414,17 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
(gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
+(defun gnus-uu-decode-yenc (n dir)
+ "Decode the yEnc-encoded current article."
+ (interactive
+ (list current-prefix-arg
+ (file-name-as-directory
+ (read-file-name "yEnc decode and save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir))))
+ (setq gnus-uu-yenc-article-name nil)
+ (gnus-uu-decode-with-method 'gnus-uu-yenc-article n dir nil t))
+
(defun gnus-uu-decode-uu-view (&optional n)
"Uudecodes and views the current article."
(interactive "P")
@@ -1016,6 +1029,39 @@ When called interactively, prompt for REGEXP."
(cons gnus-uu-binhex-article-name state)
state)))
+;; yEnc
+
+(defun gnus-uu-yenc-article (buffer in-state)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (widen)
+ (let ((file-name (yenc-extract-filename))
+ state start-char)
+ (when (not file-name)
+ (setq state (list 'wrong-type)))
+
+ (if (memq 'wrong-type state)
+ ()
+ (when (yenc-first-part-p)
+ (setq gnus-uu-yenc-article-name
+ (expand-file-name file-name gnus-uu-work-dir))
+ (push 'begin state))
+ (when (yenc-last-part-p)
+ (push 'end state))
+ (unless state
+ (push 'middle state))
+ (mm-with-unibyte-buffer
+ (insert-buffer gnus-original-article-buffer)
+ (yenc-decode-region (point-min) (point-max))
+ (when (and (member 'begin state)
+ (file-exists-p gnus-uu-yenc-article-name))
+ (delete-file gnus-uu-yenc-article-name))
+ (mm-append-to-file (point-min) (point-max)
+ gnus-uu-yenc-article-name)))
+ (if (memq 'begin state)
+ (cons file-name state)
+ state))))
+
;; PostScript
(defun gnus-uu-decode-postscript-article (process-buffer in-state)
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 74d596ae761..bd96e52d65f 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3521,15 +3521,16 @@ that that variable is buffer-local to the summary buffers."
(nth 1 method))))
method)))
-(defsubst gnus-method-to-server (method)
+(defsubst gnus-method-to-server (method &optional nocache)
(catch 'server-name
(setq method (or method gnus-select-method))
;; Perhaps it is already in the cache.
- (mapc (lambda (name-method)
- (if (equal (cdr name-method) method)
- (throw 'server-name (car name-method))))
- gnus-server-method-cache)
+ (unless nocache
+ (mapc (lambda (name-method)
+ (if (equal (cdr name-method) method)
+ (throw 'server-name (car name-method))))
+ gnus-server-method-cache))
(mapc
(lambda (server-alist)
@@ -4254,14 +4255,16 @@ Allow completion over sensible values."
;;; Agent functions
-(defun gnus-agent-method-p (method)
+(defun gnus-agent-method-p (method-or-server)
"Say whether METHOD is covered by the agent."
- (or (eq (car gnus-agent-method-p-cache) method)
- (setq gnus-agent-method-p-cache
- (cons method
- (member (if (stringp method)
- method
- (gnus-method-to-server method)) gnus-agent-covered-methods))))
+ (or (eq (car gnus-agent-method-p-cache) method-or-server)
+ (let* ((method (if (stringp method-or-server)
+ (gnus-server-to-method method-or-server)
+ method-or-server))
+ (server (gnus-method-to-server method t)))
+ (setq gnus-agent-method-p-cache
+ (cons method-or-server
+ (member server gnus-agent-covered-methods)))))
(cdr gnus-agent-method-p-cache))
(defun gnus-online (method)
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 2e724163edb..39595b767ad 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -58,15 +58,16 @@
(list 'const (car a)))
imap-stream-alist)))
-(defcustom mail-sources nil
- "*Where the mail backends will look for incoming mail.
+(defcustom mail-sources '((file))
+ "Where the mail backends will look for incoming mail.
This variable is a list of mail source specifiers.
See Info node `(gnus)Mail Source Specifiers'."
:group 'mail-source
+ :version "23.0" ;; No Gnus
:link '(custom-manual "(gnus)Mail Source Specifiers")
:type `(choice
- (const nil)
- (repeat
+ (const :tag "None" nil)
+ (repeat :tag "List"
(choice :format "%[Value Menu%] %v"
:value (file)
(cons :tag "Spool file"
diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el
index 6839a6472b7..063b2ec2f44 100644
--- a/lisp/gnus/mailcap.el
+++ b/lisp/gnus/mailcap.el
@@ -33,8 +33,14 @@
;;; Code:
(eval-when-compile (require 'cl))
-(require 'mail-parse)
-(require 'mm-util)
+(autoload 'mail-header-parse-content-type "mail-parse")
+
+;; `mm-delete-duplicates' is an alias for `delete-dups' in Emacs 22.
+(defalias 'mailcap-delete-duplicates
+ (if (fboundp 'delete-dups)
+ 'delete-dups
+ (autoload 'mm-delete-duplicates "mm-util")
+ 'mm-delete-duplicates))
(defgroup mailcap nil
"Definition of viewers for MIME types."
@@ -722,7 +728,7 @@ If TEST is not given, it defaults to t."
t)
(t nil))))
-(defun mailcap-mime-info (string &optional request)
+(defun mailcap-mime-info (string &optional request no-decode)
"Get the MIME viewer command for STRING, return nil if none found.
Expects a complete content-type header line as its argument.
@@ -732,7 +738,11 @@ entry) will be returned. If it is a string, then the mailcap field
corresponding to that string will be returned (print, description,
whatever). If a number, then all the information for this specific
viewer is returned. If `all', then all possible viewers for
-this type is returned."
+this type is returned.
+
+If NO-DECODE is non-nil, don't decode STRING."
+ ;; NO-DECODE avoids calling `mail-header-parse-content-type' from
+ ;; `mail-parse.el'
(let (
major ; Major encoding (text, etc)
minor ; Minor encoding (html, etc)
@@ -746,7 +756,10 @@ this type is returned."
viewer ; The one and only viewer
ctl)
(save-excursion
- (setq ctl (mail-header-parse-content-type (or string "text/plain")))
+ (setq ctl
+ (if no-decode
+ (list (or string "text/plain"))
+ (mail-header-parse-content-type (or string "text/plain"))))
(setq major (split-string (car ctl) "/"))
(setq minor (cadr major)
major (car major))
@@ -766,7 +779,7 @@ this type is returned."
(setq viewer (car passed)))
(cond
((and (null viewer) (not (equal major "default")) request)
- (mailcap-mime-info "default" request))
+ (mailcap-mime-info "default" request no-decode))
((or (null request) (equal request ""))
(mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
((stringp request)
@@ -976,7 +989,7 @@ If FORCE, re-parse even if already parsed."
(defun mailcap-mime-types ()
"Return a list of MIME media types."
(mailcap-parse-mimetypes)
- (mm-delete-duplicates
+ (mailcap-delete-duplicates
(nconc
(mapcar 'cdr mailcap-mime-extensions)
(apply
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 4fc0ee1a5b6..3aaa8c25745 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -273,7 +273,7 @@ included. Organization and User-Agent are optional."
:link '(custom-manual "(message)Mail Headers")
:type 'regexp)
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
@@ -588,21 +588,21 @@ Done before generating the new subject of a forward."
:type 'regexp)
(defcustom message-cite-prefix-regexp
- (if (string-match "[[:digit:]]" "1") ;; support POSIX?
- "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
+ (if (string-match "[[:digit:]]" "1")
+ ;; Support POSIX? XEmacs 21.5.27 doesn't.
+ "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|}]\\)+"
;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
(let (non-word-constituents)
(with-syntax-table text-mode-syntax-table
(setq non-word-constituents
(concat
- (if (string-match "\\w" "-") "" "-")
(if (string-match "\\w" "_") "" "_")
(if (string-match "\\w" ".") "" "."))))
(if (equal non-word-constituents "")
- "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
+ "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}]\\)+"
(concat "\\([ \t]*\\(\\w\\|["
non-word-constituents
- "]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
+ "]\\)+>+\\|[ \t]*[]>|}]\\)+"))))
"*Regexp matching the longest possible citation prefix on a line."
:version "22.1"
:group 'message-insertion
@@ -5559,7 +5559,9 @@ subscribed address (and not the additional To and Cc header contents)."
(mapcar 'downcase
(mapcar
'car (mail-header-parse-addresses field))))))
- (setq ace (downcase (idna-to-ascii rhs)))
+ (setq ace (if (string-match "\\`[[:ascii:]]+\\'" rhs)
+ rhs
+ (downcase (idna-to-ascii rhs))))
(when (and (not (equal rhs ace))
(or (not (eq message-use-idna 'ask))
(y-or-n-p (format "Replace %s with %s in %s:? "
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 18ff2ae0838..52d47b728ef 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -272,7 +272,7 @@ If PROPERTIES is non-nil, PROPERTIES are applied to the buffer,
see `set-text-properties'. If PROPERTIES equals t, this means to
apply the face `mm-uu-extract'."
(let ((obuf (current-buffer))
- (coding-system
+ (coding-system
;; Might not exist in non-MULE XEmacs
(when (boundp 'buffer-file-coding-system)
buffer-file-coding-system)))
@@ -428,7 +428,12 @@ apply the face `mm-uu-extract'."
(cons 'filename file-name)))))
(defun mm-uu-yenc-extract ()
- (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+ ;; This might not be exactly correct, but we sure can't get the
+ ;; binary data from the article buffer, since that's already in a
+ ;; non-binary charset. So get it from the original article buffer.
+ (mm-make-handle (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (mm-uu-copy-to-buffer start-point end-point))
(list (or (and file-name
(string-match "\\.[^\\.]+$" file-name)
(mailcap-extension-to-mime
diff --git a/lisp/gnus/nnkiboze.el b/lisp/gnus/nnkiboze.el
index 78e35c410bb..06acca8c09d 100644
--- a/lisp/gnus/nnkiboze.el
+++ b/lisp/gnus/nnkiboze.el
@@ -198,8 +198,7 @@
"\"Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups\".
Finds out what articles are to be part of the nnkiboze groups."
(interactive)
- (let ((nnmail-spool-file nil)
- (mail-sources nil)
+ (let ((mail-sources nil)
(gnus-use-dribble-file nil)
(gnus-read-active-file t)
(gnus-expert-user t))
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 8ff6d1d1459..e05c286b1ab 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -240,16 +240,11 @@ If non-nil, also update the cache when copy or move articles."
:group 'nnmail
:type 'boolean)
-(defcustom nnmail-spool-file '((file))
- "*Where the mail backends will look for incoming mail.
-This variable is a list of mail source specifiers.
-This variable is obsolete; `mail-sources' should be used instead."
- :group 'nnmail-files
- :type 'sexp)
(make-obsolete-variable 'nnmail-spool-file
"This option is obsolete in Gnus 5.9. \
Use `mail-sources' instead.")
;; revision 5.29 / p0-85 / Gnus 5.9
+;; Variable removed in No Gnus v0.7
(defcustom nnmail-resplit-incoming nil
"*If non-nil, re-split incoming procmail sorted mail."
@@ -1765,10 +1760,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(defun nnmail-get-new-mail (method exit-func temp
&optional group spool-func)
"Read new incoming mail."
- (let* ((sources (or mail-sources
- (if (listp nnmail-spool-file)
- nnmail-spool-file
- (list nnmail-spool-file))))
+ (let* ((sources mail-sources)
fetching-sources
(group-in group)
(i 0)
@@ -1778,20 +1770,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(when (and (nnmail-get-value "%s-get-new-mail" method)
sources)
(while (setq source (pop sources))
- ;; Be compatible with old values.
- (cond
- ((stringp source)
- (setq source
- (cond
- ((string-match "^po:" source)
- (list 'pop :user (substring source (match-end 0))))
- ((file-directory-p source)
- (list 'directory :path source))
- (t
- (list 'file :path source)))))
- ((eq source 'procmail)
- (message "Invalid value for nnmail-spool-file: `procmail'")
- nil))
;; Hack to only fetch the contents of a single group's spool file.
(when (and (eq (car source) 'directory)
(null nnmail-scan-directory-mail-source-once)
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index 3ef8af0f10b..55d60ae3fb7 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -99,6 +99,40 @@ quoted-printable and base64 respectively.")
(defvar rfc2047-encode-encoded-words t
"Whether encoded words should be encoded again.")
+(defvar rfc2047-allow-irregular-q-encoded-words t
+ "*Whether to decode irregular Q-encoded words.")
+
+(eval-and-compile ;; Necessary to hard code them in `rfc2047-decode-region'.
+ (defconst rfc2047-encoded-word-regexp
+ "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\\?\
+\\(B\\?[+/0-9A-Za-z]*=*\
+\\|Q\\?[ ->@-~]*\
+\\)\\?="
+ "Regexp that matches encoded word."
+ ;; The patterns for the B encoding and the Q encoding, i.e. the ones
+ ;; beginning with "B" and "Q" respectively, are restricted into only
+ ;; the characters that those encodings may generally use.
+ )
+ (defconst rfc2047-encoded-word-regexp-loose
+ "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\\?\
+\\(B\\?[+/0-9A-Za-z]*=*\
+\\|Q\\?\\(?:\\?+[ -<>@-~]\\)?\\(?:[ ->@-~]+\\?+[ -<>@-~]\\)*[ ->@-~]*\\?*\
+\\)\\?="
+ "Regexp that matches encoded word allowing loose Q encoding."
+ ;; The pattern for the Q encoding, i.e. the one beginning with "Q",
+ ;; is similar to:
+ ;; "Q\\?\\(\\?+[^\n=?]\\)?\\([^\n?]+\\?+[^\n=?]\\)*[^\n?]*\\?*"
+ ;; <--------1-------><----------2,3----------><--4--><-5->
+ ;; They mean:
+ ;; 1. After "Q?", allow "?"s that follow a character other than "=".
+ ;; 2. Allow "=" after "Q?"; it isn't regarded as the terminator.
+ ;; 3. In the middle of an encoded word, allow "?"s that follow a
+ ;; character other than "=".
+ ;; 4. Allow any characters other than "?" in the middle of an
+ ;; encoded word.
+ ;; 5. At the end, allow "?"s.
+ ))
+
;;;
;;; Functions for encoding RFC2047 messages
;;;
@@ -295,7 +329,7 @@ The buffer may be narrowed."
(goto-char (point-min))
(or (and rfc2047-encode-encoded-words
(prog1
- (search-forward "=?" nil t)
+ (re-search-forward rfc2047-encoded-word-regexp nil t)
(goto-char (point-min))))
(and charsets
(not (equal charsets (list (car message-posting-charset))))))))
@@ -530,10 +564,19 @@ By default, the string is treated as containing addresses (see
(rfc2047-encode-region (point-min) (point-max))
(buffer-string)))
+;; From RFC 2047:
+;; 2. Syntax of encoded-words
+;; [...]
+;; While there is no limit to the length of a multiple-line header
+;; field, each line of a header field that contains one or more
+;; 'encoded-word's is limited to 76 characters.
+;;
+;; In `rfc2047-encode-parameter' it is bound to nil, so don't defconst it.
(defvar rfc2047-encode-max-chars 76
"Maximum characters of each header line that contain encoded-words.
-If it is nil, encoded-words will not be folded. Too small value may
-cause an error. Don't change this for no particular reason.")
+According to RFC 2047, it is 76. If it is nil, encoded-words
+will not be folded. Too small value may cause an error. You
+should not change this value.")
(defun rfc2047-encode-1 (column string cs encoder start crest tail
&optional eword)
@@ -824,11 +867,6 @@ it, put the following line in your ~/.gnus.el file:
;;; Functions for decoding RFC2047 messages
;;;
-(eval-and-compile
- (defconst rfc2047-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\
-\\?\\(B\\|Q\\)\\?\\([!->@-~ ]*\\)\\?="))
-
(defvar rfc2047-quote-decoded-words-containing-tspecials nil
"If non-nil, quote decoded words containing special characters.")
@@ -947,10 +985,12 @@ If ADDRESS-MIME is non-nil, strip backslashes which precede characters
other than `\"' and `\\' in quoted strings."
(interactive "r")
(let ((case-fold-search t)
- (eword-regexp (eval-when-compile
- ;; Ignore whitespace between encoded-words.
- (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp
- "\\)")))
+ (eword-regexp
+ (if rfc2047-allow-irregular-q-encoded-words
+ (eval-when-compile
+ (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp-loose "\\)"))
+ (eval-when-compile
+ (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp "\\)"))))
b e match words)
(save-excursion
(save-restriction
@@ -966,7 +1006,7 @@ other than `\"' and `\\' in quoted strings."
(while match
(push (list (match-string 2) ;; charset
(char-after (match-beginning 3)) ;; encoding
- (match-string 4) ;; encoded-text
+ (substring (match-string 3) 2) ;; encoded-text
(match-string 1)) ;; encoded-word
words)
;; Look for the subsequent encoded-words.
diff --git a/lisp/gnus/yenc.el b/lisp/gnus/yenc.el
index 7550186b35e..7843f6a9aa0 100644
--- a/lisp/gnus/yenc.el
+++ b/lisp/gnus/yenc.el
@@ -55,6 +55,25 @@
191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
208 209 210 211 212 213])
+(defun yenc-first-part-p ()
+ "Say whether the buffer contains the first part of a yEnc file."
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "^=ybegin part=1 " nil t)))
+
+(defun yenc-last-part-p ()
+ "Say whether the buffer contains the last part of a yEnc file."
+ (save-excursion
+ (goto-char (point-min))
+ (let (total-size end-size)
+ (when (re-search-forward "^=ybegin.*size=\\([0-9]+\\)" nil t)
+ (setq total-size (match-string 1)))
+ (when (re-search-forward "^=ypart.*end=\\([0-9]+\\)" nil t)
+ (setq end-size (match-string 1)))
+ (and total-size
+ end-size
+ (string= total-size end-size)))))
+
;;;###autoload
(defun yenc-decode-region (start end)
"Yenc decode region between START and END using an internal decoder."
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index 4e8535ab2a9..8e41c68720b 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -1533,10 +1533,11 @@ or 'unseen. The IMAP command tag is returned."
(imap-send-command (list "STATUS \""
(imap-utf7-encode mailbox)
"\" "
- (format "%s"
- (if (listp items)
- items
- (list items)))))))
+ (upcase
+ (format "%s"
+ (if (listp items)
+ items
+ (list items))))))))
(defun imap-mailbox-acl-get (&optional mailbox buffer)
"Get ACL on mailbox from server in BUFFER."
@@ -2524,7 +2525,7 @@ Return nil if no complete line has arrived."
(while (and (not (eq (char-after) ?\)))
(or (forward-char) t)
(looking-at "\\([A-Za-z]+\\) "))
- (let ((token (match-string 1)))
+ (let ((token (upcase (match-string 1))))
(goto-char (match-end 0))
(cond ((string= token "MESSAGES")
(imap-mailbox-put 'messages (read (current-buffer)) mailbox))
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index 104cb991254..594212923c2 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -85,26 +85,93 @@ and `gnutls-cli' (version 2.0.1) output."
Each entry in the list is tried until a connection is successful.
%h is replaced with server hostname, %p with port to connect to.
The program should read input on stdin and write output to
-stdout. Also see `tls-success' for what the program should output
-after successful negotiation."
- :type '(repeat string)
+stdout.
+
+See `tls-checktrust' on how to check trusted root certs.
+
+Also see `tls-success' for what the program should output after
+successful negotiation."
+ :type
+ '(choice
+ (list :tag "Choose commands"
+ :value
+ ("gnutls-cli -p %p %h"
+ "gnutls-cli -p %p %h --protocols ssl3"
+ "openssl s_client -connect %h:%p -no_ssl2")
+ (set :inline t
+ ;; FIXME: add brief `:tag "..."' descriptions.
+ ;; (repeat :inline t :tag "Other" (string))
+ ;; See `tls-checktrust':
+ (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h")
+ (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3")
+ (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2")
+ ;; No trust check:
+ (const "gnutls-cli -p %p %h")
+ (const "gnutls-cli -p %p %h --protocols ssl3")
+ (const "openssl s_client -connect %h:%p -no_ssl2"))
+ (repeat :inline t :tag "Other" (string)))
+ (const :tag "Default list of commands"
+ ("gnutls-cli -p %p %h"
+ "gnutls-cli -p %p %h --protocols ssl3"
+ "openssl s_client -connect %h:%p -no_ssl2"))
+ (list :tag "List of commands"
+ (repeat :tag "Command" (string))))
:version "22.1"
:group 'tls)
(defcustom tls-process-connection-type nil
- "*Value for `process-connection-type' to use when starting TLS process."
+ "Value for `process-connection-type' to use when starting TLS process."
:version "22.1"
:type 'boolean
:group 'tls)
(defcustom tls-success "- Handshake was completed\\|SSL handshake has read "
- "*Regular expression indicating completed TLS handshakes.
+ "Regular expression indicating completed TLS handshakes.
The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's
\"openssl s_client\" outputs."
:version "22.1"
:type 'regexp
:group 'tls)
+(defcustom tls-checktrust nil
+ "Indicate if certificates should be checked against trusted root certs.
+If this is `ask', the user can decide whether to accept an
+untrusted certificate. You may have to adapt `tls-program' in
+order to make this feature work properly, i.e., to ensure that
+the external program knows about the root certificates you
+consider trustworthy, e.g.:
+
+\(setq tls-program
+ '(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\"
+ \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3\"
+ \"openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2\"))"
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Ask" ask))
+ :version "23.0" ;; No Gnus
+ :group 'tls)
+
+(defcustom tls-untrusted
+ "- Peer's certificate is NOT trusted\\|Verify return code: \\([^0] \\|.[^ ]\\)"
+ "Regular expression indicating failure of TLS certificate verification.
+The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's
+\"openssl s_client\" return in the event of unsuccessful
+verification."
+ :type 'regexp
+ :version "23.0" ;; No Gnus
+ :group 'tls)
+
+(defcustom tls-hostmismatch
+ "# The hostname in the certificate does NOT match"
+ "Regular expression indicating a host name mismatch in certificate.
+When the host name specified in the certificate doesn't match the
+name of the host you are connecting to, gnutls-cli issues a
+warning to this effect. There is no such feature in openssl. Set
+this to nil if you want to ignore host name mismatches."
+ :type 'regexp
+ :version "23.0" ;; No Gnus
+ :group 'tls)
+
(defcustom tls-certtool-program (executable-find "certtool")
"Name of GnuTLS certtool.
Used by `tls-certificate-information'."
@@ -141,7 +208,7 @@ Returns a subprocess-object to represent the connection.
Input and output work as for subprocesses; `delete-process' closes it.
Args are NAME BUFFER HOST PORT.
NAME is name for process. It is modified if necessary to make it unique.
-BUFFER is the buffer (or buffer-name) to associate with the process.
+BUFFER is the buffer (or buffer name) to associate with the process.
Process output goes at end of that buffer, unless you specify
an output stream or filter function to handle the output.
BUFFER may be also nil, meaning that this process is not associated
@@ -177,25 +244,31 @@ Fourth arg PORT is an integer specifying a port to connect to."
(sit-for 1)))
(message "Opening TLS connection with `%s'...%s" cmd
(if done "done" "failed"))
- (if (not done)
- (delete-process process)
- ;; advance point to after all informational messages that
- ;; `openssl s_client' and `gnutls' print
- (let ((start-of-data nil))
- (while
- (not (setq start-of-data
- ;; the string matching `tls-end-of-info'
- ;; might come in separate chunks from
- ;; `accept-process-output', so start the
- ;; search where `tls-success' ended
- (save-excursion
- (if (re-search-forward tls-end-of-info nil t)
- (match-end 0)))))
- (accept-process-output process 1))
- (if start-of-data
- ;; move point to start of client data
- (goto-char start-of-data)))
- (setq done process))))
+ (if done
+ (setq done process)
+ (delete-process process))))
+ (when done
+ (save-excursion
+ (set-buffer buffer)
+ (when
+ (or
+ (and tls-checktrust
+ (progn
+ (goto-char (point-min))
+ (re-search-forward tls-untrusted nil t))
+ (or
+ (and (not (eq tls-checktrust 'ask))
+ (message "The certificate presented by `%s' is NOT trusted." host))
+ (not (yes-or-no-p
+ (format "The certificate presented by `%s' is NOT trusted. Accept anyway? " host)))))
+ (and tls-hostmismatch
+ (progn
+ (goto-char (point-min))
+ (re-search-forward tls-hostmismatch nil t))
+ (not (yes-or-no-p
+ (format "Host name in certificate doesn't match `%s'. Connect anyway? " host)))))
+ (setq done nil)
+ (delete-process process))))
(message "Opening TLS connection to `%s'...%s"
host (if done "done" "failed")))
(when use-temp-buffer
View Lorry Controller Status