diff options
| author | Gnus developers | 2010-12-11 01:27:14 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2010-12-11 01:27:14 +0000 |
| commit | 3b84b005023f866afe3ba2b1e4178f39363aacc4 (patch) | |
| tree | 5f6c008ed3078c40c694f5efaee5760278226b5b | |
| parent | 2b7f50d8775c7236b947c2f3e78786c1e2002722 (diff) | |
| download | emacs-3b84b005023f866afe3ba2b1e4178f39363aacc4.tar.gz emacs-3b84b005023f866afe3ba2b1e4178f39363aacc4.zip | |
Merge changes made in Gnus trunk.
nnir.el (nnir-request-expire-articles): Only allow article deletion.
message.el (message-bogus-recipient-p): Set address to "" if nil.
gnus-gravatar.el (gnus-gravatar-transform-address): Fix error when email address is nil.
proto-stream.el (proto-stream-open-network-only): New function to have a way to specify non-STARTTLS upgrade connections.
| -rw-r--r-- | doc/misc/gnus.texi | 3 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 18 | ||||
| -rw-r--r-- | lisp/gnus/gnus-gravatar.el | 2 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 7 | ||||
| -rw-r--r-- | lisp/gnus/nnir.el | 53 | ||||
| -rw-r--r-- | lisp/gnus/nntp.el | 3 | ||||
| -rw-r--r-- | lisp/gnus/proto-stream.el | 12 |
7 files changed, 66 insertions, 32 deletions
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 2df6d90cc07..9f4d1f75ede 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 | |||
| 14445 | connection will be upgraded to an encrypted @acronym{STARTTLS} | 14445 | connection will be upgraded to an encrypted @acronym{STARTTLS} |
| 14446 | connection automatically. | 14446 | connection automatically. |
| 14447 | 14447 | ||
| 14448 | @item network-only | ||
| 14449 | The same as the above, but don't do automatic @acronym{STARTTLS} upgrades. | ||
| 14450 | |||
| 14448 | @findex nntp-open-tls-stream | 14451 | @findex nntp-open-tls-stream |
| 14449 | @item nntp-open-tls-stream | 14452 | @item nntp-open-tls-stream |
| 14450 | Opens a connection to a server over a @dfn{secure} channel. To use | 14453 | Opens a connection to a server over a @dfn{secure} channel. To use |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 18cc915b111..2ff18436ed6 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,21 @@ | |||
| 1 | 2010-12-10 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * proto-stream.el (proto-stream-open-network-only): New function to | ||
| 4 | have a way to specify non-STARTTLS upgrade connections. | ||
| 5 | |||
| 6 | 2010-12-10 Julien Danjou <julien@danjou.info> | ||
| 7 | |||
| 8 | * gnus-gravatar.el (gnus-gravatar-transform-address): Fix error when | ||
| 9 | email address is nil. | ||
| 10 | |||
| 11 | * message.el (message-bogus-recipient-p): Set address to "" if nil. | ||
| 12 | |||
| 13 | 2010-12-10 Andrew Cohen <cohen@andy.bu.edu> | ||
| 14 | |||
| 15 | * nnir.el (nnir-request-expire-articles): Ignore expiry except for | ||
| 16 | deletion. | ||
| 17 | (nnir-run-imap): Only need to parse list once. | ||
| 18 | |||
| 1 | 2010-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org> | 19 | 2010-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 2 | 20 | ||
| 3 | * shr.el (shr-tag-script): Ignore <script>. | 21 | * shr.el (shr-tag-script): Ignore <script>. |
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index 27f65c04094..1bd64e9533f 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el | |||
| @@ -65,7 +65,7 @@ If nil, default to `gravatar-size'." | |||
| 65 | (when (or force | 65 | (when (or force |
| 66 | (not (and gnus-gravatar-too-ugly | 66 | (not (and gnus-gravatar-too-ugly |
| 67 | (or (string-match gnus-gravatar-too-ugly | 67 | (or (string-match gnus-gravatar-too-ugly |
| 68 | (cadr address)) | 68 | (or (cadr address) "")) |
| 69 | (and name | 69 | (and name |
| 70 | (string-match gnus-gravatar-too-ugly | 70 | (string-match gnus-gravatar-too-ugly |
| 71 | name)))))) | 71 | name)))))) |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index de9eef5ea73..78652fb2ee0 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -4261,9 +4261,10 @@ matching entry in `message-bogus-addresses'." | |||
| 4261 | ;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"? | 4261 | ;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"? |
| 4262 | (let (found) | 4262 | (let (found) |
| 4263 | (mapc (lambda (address) | 4263 | (mapc (lambda (address) |
| 4264 | (setq address (cadr address)) | 4264 | (setq address (or (cadr address) "")) |
| 4265 | (when | 4265 | (when |
| 4266 | (or (not | 4266 | (or (string= "" address) |
| 4267 | (not | ||
| 4267 | (or | 4268 | (or |
| 4268 | (not (string-match "@" address)) | 4269 | (not (string-match "@" address)) |
| 4269 | (string-match | 4270 | (string-match |
| @@ -4277,7 +4278,7 @@ matching entry in `message-bogus-addresses'." | |||
| 4277 | "\\|") | 4278 | "\\|") |
| 4278 | message-bogus-addresses))) | 4279 | message-bogus-addresses))) |
| 4279 | (string-match re address)))) | 4280 | (string-match re address)))) |
| 4280 | (push address found))) | 4281 | (push address found))) |
| 4281 | ;; | 4282 | ;; |
| 4282 | (mail-extract-address-components recipients t)) | 4283 | (mail-extract-address-components recipients t)) |
| 4283 | found)) | 4284 | found)) |
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 726b01564e7..3b1d3246c01 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.") | |||
| 688 | (gnus-group-real-name to-newsgroup))))) | 688 | (gnus-group-real-name to-newsgroup))))) |
| 689 | 689 | ||
| 690 | (deffoo nnir-request-expire-articles (articles group &optional server force) | 690 | (deffoo nnir-request-expire-articles (articles group &optional server force) |
| 691 | (let ((articles-by-group (nnir-categorize | 691 | (if force |
| 692 | articles nnir-article-group nnir-article-ids)) | 692 | (let ((articles-by-group (nnir-categorize |
| 693 | not-deleted) | 693 | articles nnir-article-group nnir-article-ids)) |
| 694 | (while (not (null articles-by-group)) | 694 | not-deleted) |
| 695 | (let* ((group-articles (pop articles-by-group)) | 695 | (while (not (null articles-by-group)) |
| 696 | (artgroup (car group-articles)) | 696 | (let* ((group-articles (pop articles-by-group)) |
| 697 | (articleids (cadr group-articles)) | 697 | (artgroup (car group-articles)) |
| 698 | (artlist (sort (mapcar 'cdr articleids) '<))) | 698 | (articleids (cadr group-articles)) |
| 699 | (unless (gnus-check-backend-function 'request-expire-articles | 699 | (artlist (sort (mapcar 'cdr articleids) '<))) |
| 700 | artgroup) | 700 | (unless (gnus-check-backend-function 'request-expire-articles |
| 701 | (error "The group %s does not support article deletion" artgroup)) | 701 | artgroup) |
| 702 | (unless (gnus-check-server (gnus-find-method-for-group artgroup)) | 702 | (error "The group %s does not support article deletion" artgroup)) |
| 703 | (error "Couldn't open server for group %s" artgroup)) | 703 | (unless (gnus-check-server (gnus-find-method-for-group artgroup)) |
| 704 | (push (gnus-request-expire-articles | 704 | (error "Couldn't open server for group %s" artgroup)) |
| 705 | artlist artgroup force) | 705 | (push (gnus-request-expire-articles |
| 706 | not-deleted))) | 706 | artlist artgroup force) |
| 707 | (sort (delq nil not-deleted) '<))) | 707 | not-deleted))) |
| 708 | (sort (delq nil not-deleted) '<)) | ||
| 709 | articles)) | ||
| 708 | 710 | ||
| 709 | (deffoo nnir-warp-to-article () | 711 | (deffoo nnir-warp-to-article () |
| 710 | (let* ((cur (if (> (gnus-summary-article-number) 0) | 712 | (let* ((cur (if (> (gnus-summary-article-number) 0) |
| @@ -792,12 +794,13 @@ details on the language and supported extensions" | |||
| 792 | (nnir-imap-make-query | 794 | (nnir-imap-make-query |
| 793 | criteria qstring))))) | 795 | criteria qstring))))) |
| 794 | (mapc | 796 | (mapc |
| 795 | (lambda (artnum) (push (vector group artnum 100) artlist) | 797 | (lambda (artnum) |
| 796 | (setq arts (1+ arts))) | 798 | (let ((artn (string-to-number artnum))) |
| 797 | (and (car result) | 799 | (when (> artn 0) |
| 798 | (delete 0 (mapcar #'string-to-number | 800 | (push (vector group artn 100) |
| 799 | (cdr (assoc "SEARCH" | 801 | artlist) |
| 800 | (cdr result))))))) | 802 | (setq arts (1+ arts))))) |
| 803 | (and (car result) (cdr (assoc "SEARCH" (cdr result))))) | ||
| 801 | (message "Searching %s... %d matches" group arts))) | 804 | (message "Searching %s... %d matches" group arts))) |
| 802 | (message "Searching %s...done" group)) | 805 | (message "Searching %s...done" group)) |
| 803 | (quit nil)) | 806 | (quit nil)) |
| @@ -1581,8 +1584,10 @@ server is of form 'backend:name'." | |||
| 1581 | (or nnir-summary-line-format gnus-summary-line-format)) | 1584 | (or nnir-summary-line-format gnus-summary-line-format)) |
| 1582 | (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t) | 1585 | (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t) |
| 1583 | (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t) | 1586 | (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t) |
| 1587 | (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action t) | ||
| 1584 | (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t) | 1588 | (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t) |
| 1585 | (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t))) | 1589 | (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t) |
| 1590 | (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t))) | ||
| 1586 | 1591 | ||
| 1587 | 1592 | ||
| 1588 | 1593 | ||
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 9c9054a49c7..c0072a6ef2a 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el | |||
| @@ -87,6 +87,8 @@ host. | |||
| 87 | 87 | ||
| 88 | Direct connections: | 88 | Direct connections: |
| 89 | - `nntp-open-network-stream' (the default), | 89 | - `nntp-open-network-stream' (the default), |
| 90 | - `network-only' (the same as the above, but don't do automatic | ||
| 91 | STARTTLS upgrades). | ||
| 90 | - `nntp-open-ssl-stream', | 92 | - `nntp-open-ssl-stream', |
| 91 | - `nntp-open-tls-stream', | 93 | - `nntp-open-tls-stream', |
| 92 | - `nntp-open-netcat-stream'. | 94 | - `nntp-open-netcat-stream'. |
| @@ -1267,6 +1269,7 @@ password contained in '~/.nntp-authinfo'." | |||
| 1267 | (let ((coding-system-for-read nntp-coding-system-for-read) | 1269 | (let ((coding-system-for-read nntp-coding-system-for-read) |
| 1268 | (coding-system-for-write nntp-coding-system-for-write) | 1270 | (coding-system-for-write nntp-coding-system-for-write) |
| 1269 | (map '((nntp-open-network-stream network) | 1271 | (map '((nntp-open-network-stream network) |
| 1272 | (network-only network-only) | ||
| 1270 | (nntp-open-ssl-stream tls) | 1273 | (nntp-open-ssl-stream tls) |
| 1271 | (nntp-open-tls-stream tls)))) | 1274 | (nntp-open-tls-stream tls)))) |
| 1272 | (if (assoc nntp-open-connection-function map) | 1275 | (if (assoc nntp-open-connection-function map) |
diff --git a/lisp/gnus/proto-stream.el b/lisp/gnus/proto-stream.el index 6c90f3a112d..e8df945b946 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). | |||
| 75 | The PARAMETERS is a keyword list that can have the following | 75 | The PARAMETERS is a keyword list that can have the following |
| 76 | values: | 76 | values: |
| 77 | 77 | ||
| 78 | :type -- either `network', `tls', `shell' or `starttls'. If | 78 | :type -- either `network', `network-only, `tls', `shell' or |
| 79 | omitted, the default is `network'. `network' will be | 79 | `starttls'. If omitted, the default is `network'. `network' |
| 80 | opportunistically upgraded to STARTTLS if both the server and | 80 | will be opportunistically upgraded to STARTTLS if both the server |
| 81 | Emacs supports it. | 81 | and Emacs supports it. If you don't want STARTTLS upgrades, use |
| 82 | `network-only'. | ||
| 82 | 83 | ||
| 83 | :end-of-command -- a regexp saying what the end of a command is. | 84 | :end-of-command -- a regexp saying what the end of a command is. |
| 84 | This defaults to \"\\n\". | 85 | This defaults to \"\\n\". |
| @@ -109,6 +110,9 @@ command to switch on STARTTLS otherwise." | |||
| 109 | stream) | 110 | stream) |
| 110 | greeting capabilities)))) | 111 | greeting capabilities)))) |
| 111 | 112 | ||
| 113 | (defun proto-stream-open-network-only (name buffer host service parameters) | ||
| 114 | (open-network-stream name buffer host service)) | ||
| 115 | |||
| 112 | (defun proto-stream-open-network (name buffer host service parameters) | 116 | (defun proto-stream-open-network (name buffer host service parameters) |
| 113 | (let* ((start (with-current-buffer buffer (point))) | 117 | (let* ((start (with-current-buffer buffer (point))) |
| 114 | (stream (open-network-stream name buffer host service)) | 118 | (stream (open-network-stream name buffer host service)) |