summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/misc/gnus.texi3
-rw-r--r--lisp/gnus/ChangeLog18
-rw-r--r--lisp/gnus/gnus-gravatar.el2
-rw-r--r--lisp/gnus/message.el7
-rw-r--r--lisp/gnus/nnir.el53
-rw-r--r--lisp/gnus/nntp.el3
-rw-r--r--lisp/gnus/proto-stream.el12
7 files changed, 66 insertions, 32 deletions
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 2df6d90cc0..9f4d1f75ed 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -14445,6 +14445,9 @@ remote system. If both Emacs and the server supports it, the
connection will be upgraded to an encrypted @acronym{STARTTLS}
connection automatically.
+@item network-only
+The same as the above, but don't do automatic @acronym{STARTTLS} upgrades.
+
@findex nntp-open-tls-stream
@item nntp-open-tls-stream
Opens a connection to a server over a @dfn{secure} channel. To use
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 18cc915b11..2ff18436ed 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,21 @@
+2010-12-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * proto-stream.el (proto-stream-open-network-only): New function to
+ have a way to specify non-STARTTLS upgrade connections.
+
+2010-12-10 Julien Danjou <julien@danjou.info>
+
+ * gnus-gravatar.el (gnus-gravatar-transform-address): Fix error when
+ email address is nil.
+
+ * message.el (message-bogus-recipient-p): Set address to "" if nil.
+
+2010-12-10 Andrew Cohen <cohen@andy.bu.edu>
+
+ * nnir.el (nnir-request-expire-articles): Ignore expiry except for
+ deletion.
+ (nnir-run-imap): Only need to parse list once.
+
2010-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el (shr-tag-script): Ignore <script>.
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index 27f65c0409..1bd64e9533 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -65,7 +65,7 @@ If nil, default to `gravatar-size'."
(when (or force
(not (and gnus-gravatar-too-ugly
(or (string-match gnus-gravatar-too-ugly
- (cadr address))
+ (or (cadr address) ""))
(and name
(string-match gnus-gravatar-too-ugly
name))))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index de9eef5ea7..78652fb2ee 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4261,9 +4261,10 @@ matching entry in `message-bogus-addresses'."
;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"?
(let (found)
(mapc (lambda (address)
- (setq address (cadr address))
+ (setq address (or (cadr address) ""))
(when
- (or (not
+ (or (string= "" address)
+ (not
(or
(not (string-match "@" address))
(string-match
@@ -4277,7 +4278,7 @@ matching entry in `message-bogus-addresses'."
"\\|")
message-bogus-addresses)))
(string-match re address))))
- (push address found)))
+ (push address found)))
;;
(mail-extract-address-components recipients t))
found))
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 726b01564e..3b1d3246c0 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -688,23 +688,25 @@ Add an entry here when adding a new search engine.")
(gnus-group-real-name to-newsgroup)))))
(deffoo nnir-request-expire-articles (articles group &optional server force)
- (let ((articles-by-group (nnir-categorize
- articles nnir-article-group nnir-article-ids))
- not-deleted)
- (while (not (null articles-by-group))
- (let* ((group-articles (pop articles-by-group))
- (artgroup (car group-articles))
- (articleids (cadr group-articles))
- (artlist (sort (mapcar 'cdr articleids) '<)))
- (unless (gnus-check-backend-function 'request-expire-articles
- artgroup)
- (error "The group %s does not support article deletion" artgroup))
- (unless (gnus-check-server (gnus-find-method-for-group artgroup))
- (error "Couldn't open server for group %s" artgroup))
- (push (gnus-request-expire-articles
- artlist artgroup force)
- not-deleted)))
- (sort (delq nil not-deleted) '<)))
+ (if force
+ (let ((articles-by-group (nnir-categorize
+ articles nnir-article-group nnir-article-ids))
+ not-deleted)
+ (while (not (null articles-by-group))
+ (let* ((group-articles (pop articles-by-group))
+ (artgroup (car group-articles))
+ (articleids (cadr group-articles))
+ (artlist (sort (mapcar 'cdr articleids) '<)))
+ (unless (gnus-check-backend-function 'request-expire-articles
+ artgroup)
+ (error "The group %s does not support article deletion" artgroup))
+ (unless (gnus-check-server (gnus-find-method-for-group artgroup))
+ (error "Couldn't open server for group %s" artgroup))
+ (push (gnus-request-expire-articles
+ artlist artgroup force)
+ not-deleted)))
+ (sort (delq nil not-deleted) '<))
+ articles))
(deffoo nnir-warp-to-article ()
(let* ((cur (if (> (gnus-summary-article-number) 0)
@@ -792,12 +794,13 @@ details on the language and supported extensions"
(nnir-imap-make-query
criteria qstring)))))
(mapc
- (lambda (artnum) (push (vector group artnum 100) artlist)
- (setq arts (1+ arts)))
- (and (car result)
- (delete 0 (mapcar #'string-to-number
- (cdr (assoc "SEARCH"
- (cdr result)))))))
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (push (vector group artn 100)
+ artlist)
+ (setq arts (1+ arts)))))
+ (and (car result) (cdr (assoc "SEARCH" (cdr result)))))
(message "Searching %s... %d matches" group arts)))
(message "Searching %s...done" group))
(quit nil))
@@ -1581,8 +1584,10 @@ server is of form 'backend:name'."
(or nnir-summary-line-format gnus-summary-line-format))
(remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t)
(remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t)
+ (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action t)
(add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t)
- (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t)))
+ (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t)
+ (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t)))
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 9c9054a49c..c0072a6ef2 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -87,6 +87,8 @@ host.
Direct connections:
- `nntp-open-network-stream' (the default),
+- `network-only' (the same as the above, but don't do automatic
+ STARTTLS upgrades).
- `nntp-open-ssl-stream',
- `nntp-open-tls-stream',
- `nntp-open-netcat-stream'.
@@ -1267,6 +1269,7 @@ password contained in '~/.nntp-authinfo'."
(let ((coding-system-for-read nntp-coding-system-for-read)
(coding-system-for-write nntp-coding-system-for-write)
(map '((nntp-open-network-stream network)
+ (network-only network-only)
(nntp-open-ssl-stream tls)
(nntp-open-tls-stream tls))))
(if (assoc nntp-open-connection-function map)
diff --git a/lisp/gnus/proto-stream.el b/lisp/gnus/proto-stream.el
index 6c90f3a112..e8df945b94 100644
--- a/lisp/gnus/proto-stream.el
+++ b/lisp/gnus/proto-stream.el
@@ -75,10 +75,11 @@ is a string representing the capabilities of the server (if any).
The PARAMETERS is a keyword list that can have the following
values:
-:type -- either `network', `tls', `shell' or `starttls'. If
-omitted, the default is `network'. `network' will be
-opportunistically upgraded to STARTTLS if both the server and
-Emacs supports it.
+:type -- either `network', `network-only, `tls', `shell' or
+`starttls'. If omitted, the default is `network'. `network'
+will be opportunistically upgraded to STARTTLS if both the server
+and Emacs supports it. If you don't want STARTTLS upgrades, use
+`network-only'.
:end-of-command -- a regexp saying what the end of a command is.
This defaults to \"\\n\".
@@ -109,6 +110,9 @@ command to switch on STARTTLS otherwise."
stream)
greeting capabilities))))
+(defun proto-stream-open-network-only (name buffer host service parameters)
+ (open-network-stream name buffer host service))
+
(defun proto-stream-open-network (name buffer host service parameters)
(let* ((start (with-current-buffer buffer (point)))
(stream (open-network-stream name buffer host service))
generated by cgit v1.2.3 (git 2.46.0) at 2024-09-21 14:13:40 +0000