Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-941
This commit is contained in:
Miles Bader
parent
f6e7ec0248
commit
b890d447fb
29 changed files with 712 additions and 212 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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,20 +101,101 @@
|
|||
|
||||
* 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
|
||||
mail_send.xpm->mail-send.xpm.
|
||||
|
||||
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.
|
||||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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:? "
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
123
lisp/net/tls.el
123
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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue