aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/gnus
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/gnus')
-rw-r--r--lisp/gnus/ChangeLog228
-rw-r--r--lisp/gnus/auth-source.el314
-rw-r--r--lisp/gnus/gnus-art.el14
-rw-r--r--lisp/gnus/gnus-group.el33
-rw-r--r--lisp/gnus/gnus-int.el4
-rw-r--r--lisp/gnus/gnus-start.el26
-rw-r--r--lisp/gnus/gnus-sum.el56
-rw-r--r--lisp/gnus/gnus-sync.el12
-rw-r--r--lisp/gnus/gnus-util.el6
-rw-r--r--lisp/gnus/gnus-win.el6
-rw-r--r--lisp/gnus/gravatar.el6
-rw-r--r--lisp/gnus/gssapi.el105
-rw-r--r--lisp/gnus/message.el18
-rw-r--r--lisp/gnus/mm-uu.el8
-rw-r--r--lisp/gnus/nnimap.el68
-rw-r--r--lisp/gnus/shr.el15
-rw-r--r--lisp/gnus/sieve-manage.el7
17 files changed, 694 insertions, 232 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index c14c79a92cb..7eca03bd93b 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,182 @@
12011-03-18 Julien Danjou <julien@danjou.info>
2
3 * gnus-util.el (gnus-buffer-live-p): Simplify gnus-buffer-live-p.
4 (gnus-buffer-live-p): Check that buffer is not nil.
5
62011-03-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
7
8 * gnus-art.el: Require mouse, which the build bot seems to say is
9 needed.
10
11 * gravatar.el (gravatar-retrieve-synchronously): Use `url-retrieve' on
12 XEmacs, since it doesn't have url-retrieve-synchronously.
13
142011-03-17 Antoine Levitt <antoine.levitt@gmail.com>
15
16 * gnus-group.el (gnus-group-list-ticked): New function.
17 (gnus-group-make-menu-bar): Provide a menu entry for it.
18 (gnus-group-list-map): Provide a binding for it.
19
202011-03-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
21
22 * shr.el (shr-visit-file): New command.
23
24 * nnimap.el (nnimap-fetch-inbox): Rewrite slightly last patch.
25
262011-03-17 Bjørn Mork <bjorn@mork.no>
27
28 * nnimap.el (nnimap-fetch-inbox): Don't download bodies on ver4-capable
29 servers.
30
312011-03-16 Julien Danjou <julien@danjou.info>
32
33 * mm-uu.el (mm-uu-dissect-text-parts): Only dissect handle that are
34 inline.
35
36 * gnus-art.el (article-hide-list-identifiers): Use
37 gnus-group-get-list-identifiers.
38
39 * gnus-sum.el (gnus-group-get-list-identifiers): New function.
40 (gnus-summary-remove-list-identifiers): Use
41 gnus-group-get-list-identifiers to get regexp.
42 (gnus-select-newsgroup, gnus-summary-insert-subject)
43 (gnus-summary-insert-articles): Call
44 gnus-summary-remove-list-identifiers unconditionally.
45
462011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
47
48 * gnus-sum.el (gnus-articles-to-read): Revert back to old behaviour if
49 we're selecting a group with unread articles.
50
51 * nnimap.el (nnimap-open-connection-1): Allow `network-only', too.
52
53 * gssapi.el: New file separated out from imap.el to provide a general
54 Kerberos 5 connection facility for Emacs.
55
56 * message.el (message-elide-ellipsis): Document the format spec
57 ellipsis.
58
592011-03-15 Reiner Steib <Reiner.Steib@gmx.de>
60
61 * message.el (message-elide-region): Allow the ellipsis to say how many
62 lines were removed.
63
642011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
65
66 * gnus-win.el (gnus-configure-frame): Protect against trying to restore
67 window configurations containing buffers that are now dead.
68
69 * nnimap.el (nnimap-parse-flags): Remove all MODSEQ entries before
70 parsing to avoid integer overflows.
71 (nnimap-parse-flags): Simplify the last change.
72 (nnimap-parse-flags): Store HIGHESTMODSEQ as a string, since it may be
73 too large for 32-bit Emacsen.
74
752011-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
76
77 * auth-source.el (auth-source-netrc-create):
78 * message.el (message-yank-original): Fix use of `case'.
79
802011-03-15 Nelson Ferreira <nelson.ferreira@ieee.org> (tiny change)
81
82 * gnus-art.el (gnus-article-treat-body-boundary): Fix boundary width on
83 XEmacs, which was one character too wide.
84
852011-03-09 Antoine Levitt <antoine.levitt@gmail.com>
86
87 * gnus-sum.el (gnus-articles-to-read): Use gnus-large-newsgroup as
88 default number of articles to display.
89 (gnus-articles-to-read): Use pretty names for prompt.
90
912011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
92
93 * gnus-int.el (gnus-open-server): Ditto.
94
95 * gnus-start.el (gnus-activate-group): Give a backtrace if
96 debug-on-quit is set and the user hits `C-g'.
97 (gnus-read-active-file): Ditto.
98
99 * gnus-group.el (gnus-group-read-ephemeral-group): Ditto.
100
1012011-03-15 Teodor Zlatanov <tzz@lifelogs.com>
102
103 * message.el (message-yank-original): Use cond instead of CL case.
104
1052011-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
106
107 * auth-source.el (auth-source-netrc-create): Use usual format for the
108 default in prompts.
109
1102011-03-13 Teodor Zlatanov <tzz@lifelogs.com>
111
112 * auth-source.el (auth-source-netrc-create): Show the default in the
113 prompt when prompting for token creation.
114
1152011-03-12 Teodor Zlatanov <tzz@lifelogs.com>
116
117 * auth-source.el (auth-source-format-prompt): Always convert the value
118 to a string to avoid evaluating non-string arguments.
119 (auth-source-netrc-create): Offer default properly, not as initial
120 content in `read-string'.
121 (auth-source-netrc-saver): Use a cache keyed by file name and MD5 hash
122 of line to determine if we've been run before. If so, don't run again,
123 but print a trivial message to indicate the cache was hit instead.
124
1252011-03-11 Teodor Zlatanov <tzz@lifelogs.com>
126
127 * gnus-sync.el (gnus-sync-install-hooks, gnus-sync-unload-hook):
128 Don't install `gnus-sync-read' to any hooks by default. It's buggy.
129 The user will have to run `gnus-sync-read' manually and wait for Cloudy
130 Gnus.
131
1322011-03-11 Julien Danjou <julien@danjou.info>
133
134 * mm-uu.el (mm-uu-type-alist): Add support for diff starting with "===
135 modified file".
136
1372011-03-09 Teodor Zlatanov <tzz@lifelogs.com>
138
139 * auth-source.el (auth-source-read-char-choice): New function to read a
140 character choice using `dropdown-list', `read-char-choice', or
141 `read-char'. It appends "[a/b/c] " to the prompt if the choices were
142 '(?a ?b ?c). The `dropdown-list' support is disabled for now. Use
143 `eval-when-compile' to load `dropdown-list'. Remove `dropdown-list'.
144 (auth-source-netrc-saver): Use it.
145 (auth-source-pick-first-password): New convenience function.
146
1472011-03-08 Teodor Zlatanov <tzz@lifelogs.com>
148
149 * nnimap.el (nnimap-credentials): Keep the :save-function as the third
150 parameter in the credentials.
151 (nnimap-open-connection-1): Use it after a successful login.
152 (nnimap-credentials): Add IMAP-specific user and password prompt.
153
154 * auth-source.el (auth-source-search): Add :require parameter, taking a
155 list. Document it and the :save-function return token. Pass :require
156 down. Change the CREATED message from a warning to a debug statement.
157 (auth-source-search-backends): Pass :require down.
158 (auth-source-netrc-search): Pass :require down.
159 (auth-source-netrc-parse): Use :require, if it's given, as a filter.
160 Change save prompt to indicate all modifications saved here are
161 deletions.
162 (auth-source-netrc-create): Take user login name as default in user
163 prompt. Move all the save functionality to a lexically bound function
164 under the :save-function token in the returned list. Set up clearer
165 default prompts for user, host, port, and secret.
166 (auth-source-netrc-saver): New function, intended to be wrapped for
167 :save-function.
168
1692011-03-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
170
171 * shr.el (shr-table-horizontal-line): Change the defaults for the table
172 lines to be spaces instead.
173
1742011-03-07 Julien Danjou <julien@danjou.info>
175
176 * sieve-manage.el (sieve-sasl-auth): Create auth-info if not found.
177 (sieve-sasl-auth): Check that auth-source-search did return something,
178 or just return an empty string.
179
12011-03-05 Antoine Levitt <antoine.levitt@gmail.com> 1802011-03-05 Antoine Levitt <antoine.levitt@gmail.com>
2 181
3 * gnus.el (gnus-interactive): Use read-directory-name. 182 * gnus.el (gnus-interactive): Use read-directory-name.
@@ -12,6 +191,13 @@
12 191
132011-03-05 Lars Magne Ingebrigtsen <larsi@gnus.org> 1922011-03-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
14 193
194 * gnus-start.el (gnus-group-change-level): Allow putting foreign groups
195 onto the list of killed groups, too. This makes killed nnimap groups,
196 for instance, more reliably not reappear.
197
198 * nnimap.el (nnimap-request-thread): Don't bug out when we can't find
199 the parent.
200
15 * gnus-sum.el (gnus-update-read-articles): Fix typo. 201 * gnus-sum.el (gnus-update-read-articles): Fix typo.
16 202
17 * gnus.el (gnus-valid-select-methods): Mark nnimap as a backend that 203 * gnus.el (gnus-valid-select-methods): Mark nnimap as a backend that
@@ -24,8 +210,8 @@
24 210
252011-03-05 Antoine Levitt <antoine.levitt@gmail.com> 2112011-03-05 Antoine Levitt <antoine.levitt@gmail.com>
26 212
27 * message.el (message-cite-reply-position, message-cite-style): New 213 * message.el (message-cite-reply-position, message-cite-style):
28 variables. 214 New variables.
29 (message-yank-original): Use the new citation styles. 215 (message-yank-original): Use the new citation styles.
30 216
312011-03-04 Daiki Ueno <ueno@unixuser.org> 2172011-03-04 Daiki Ueno <ueno@unixuser.org>
@@ -139,14 +325,14 @@
139 325
1402011-02-23 Lars Ingebrigtsen <larsi@gnus.org> 3262011-02-23 Lars Ingebrigtsen <larsi@gnus.org>
141 327
142 * gnus-start.el (gnus-dribble-read-file): Set 328 * gnus-start.el (gnus-dribble-read-file):
143 buffer-save-without-query, since we always want to save the dribble 329 Set buffer-save-without-query, since we always want to save the dribble
144 file, probably. 330 file, probably.
145 331
146 * nnmail.el (nnmail-article-group): Allow a final "" split to work on 332 * nnmail.el (nnmail-article-group): Allow a final "" split to work on
147 nnimap. 333 nnimap.
148 334
149 * gnus-sum.el (gnus-user-date-format-alist): Renamed back again from 335 * gnus-sum.el (gnus-user-date-format-alist): Rename back again from
150 -summary- since it's a user-visible variable. 336 -summary- since it's a user-visible variable.
151 337
152 * nnimap.el (nnimap-retrieve-group-data-early): Don't do QRESYNC the 338 * nnimap.el (nnimap-retrieve-group-data-early): Don't do QRESYNC the
@@ -392,8 +578,8 @@
3922011-02-14 Teodor Zlatanov <tzz@lifelogs.com> 5782011-02-14 Teodor Zlatanov <tzz@lifelogs.com>
393 579
394 * auth-source.el (auth-source-backend-parse-parameters): Don't rely on 580 * auth-source.el (auth-source-backend-parse-parameters): Don't rely on
395 `plist-get' to accept non-list parameters (XEmacs issue). Fix 581 `plist-get' to accept non-list parameters (XEmacs issue).
396 docstring. 582 Fix docstring.
397 (auth-source-secrets-search): Use `delete-dups', `append mapcar', and 583 (auth-source-secrets-search): Use `delete-dups', `append mapcar', and
398 `butlast' instead of `remove-duplicates', `mapcan', and `subseq'. 584 `butlast' instead of `remove-duplicates', `mapcan', and `subseq'.
399 (auth-sources, auth-source-backend-parse, auth-source-secrets-search): 585 (auth-sources, auth-source-backend-parse, auth-source-secrets-search):
@@ -433,8 +619,8 @@
433 619
4342011-02-13 Tassilo Horn <tassilo@member.fsf.org> (tiny change) 6202011-02-13 Tassilo Horn <tassilo@member.fsf.org> (tiny change)
435 621
436 * nnimap.el (nnimap-request-accept-article, nnimap-process-quirk): Fix 622 * nnimap.el (nnimap-request-accept-article, nnimap-process-quirk):
437 Gcc processing on imap. 623 Fix Gcc processing on imap.
438 624
4392011-02-10 Stefan Monnier <monnier@iro.umontreal.ca> 6252011-02-10 Stefan Monnier <monnier@iro.umontreal.ca>
440 626
@@ -522,8 +708,8 @@
522 708
5232011-02-06 Michael Albinus <michael.albinus@gmx.de> 7092011-02-06 Michael Albinus <michael.albinus@gmx.de>
524 710
525 * auth-source.el (top): Require 'eieio unconditionally. Autoload 711 * auth-source.el (top): Require 'eieio unconditionally.
526 `secrets-get-attributes' instead of `secrets-get-attribute'. 712 Autoload `secrets-get-attributes' instead of `secrets-get-attribute'.
527 (auth-source-secrets-search): Limit search when `max' is greater than 713 (auth-source-secrets-search): Limit search when `max' is greater than
528 number of results. 714 number of results.
529 715
@@ -559,7 +745,7 @@
559 (auth-source-protocol-defaults, auth-source-user-or-password-imap) 745 (auth-source-protocol-defaults, auth-source-user-or-password-imap)
560 (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh) 746 (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh)
561 (auth-source-user-or-password-sftp) 747 (auth-source-user-or-password-sftp)
562 (auth-source-user-or-password-smtp): Removed. 748 (auth-source-user-or-password-smtp): Remove.
563 (auth-source-user-or-password): Deprecated and modified to be a wrapper 749 (auth-source-user-or-password): Deprecated and modified to be a wrapper
564 around `auth-source-search'. Not tested thoroughly. 750 around `auth-source-search'. Not tested thoroughly.
565 751
@@ -725,16 +911,16 @@
725 * gnus-group.el (gnus-group-jump-to-group): Allow jumping to groups 911 * gnus-group.el (gnus-group-jump-to-group): Allow jumping to groups
726 that Gnus doesn't know exists again. 912 that Gnus doesn't know exists again.
727 913
728 * gnus-art.el (gnus-article-date-lapsed-new-header): Removed. 914 * gnus-art.el (gnus-article-date-lapsed-new-header): Remove.
729 (gnus-treat-date-ut): Ditto. 915 (gnus-treat-date-ut): Ditto.
730 (gnus-article-update-date-header): Renamed. 916 (gnus-article-update-date-header): Rename.
731 (gnus-treat-date-local): Removed. 917 (gnus-treat-date-local): Remove.
732 (gnus-treat-date-english): Removed. 918 (gnus-treat-date-english): Remove.
733 (gnus-treat-date-lapsed): Removed. 919 (gnus-treat-date-lapsed): Remove.
734 (gnus-treat-date-combined-lapsed): Removed. 920 (gnus-treat-date-combined-lapsed): Remove.
735 (gnus-treat-date-original): Removed. 921 (gnus-treat-date-original): Remove.
736 (gnus-treat-date-iso8601): Removed. 922 (gnus-treat-date-iso8601): Remove.
737 (gnus-treat-date-user-defined): Removed. 923 (gnus-treat-date-user-defined): Remove.
738 (gnus-article-date-headers): New variable to control all the date 924 (gnus-article-date-headers): New variable to control all the date
739 header options. 925 header options.
740 (article-date-ut): Rewrite to allow using the new way to format date 926 (article-date-ut): Rewrite to allow using the new way to format date
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index 500de10b71c..e0bea324a25 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -54,6 +54,8 @@
54(autoload 'secrets-list-collections "secrets") 54(autoload 'secrets-list-collections "secrets")
55(autoload 'secrets-search-items "secrets") 55(autoload 'secrets-search-items "secrets")
56 56
57(autoload 'rfc2104-hash "rfc2104")
58
57(defvar secrets-enabled) 59(defvar secrets-enabled)
58 60
59(defgroup auth-source nil 61(defgroup auth-source nil
@@ -286,6 +288,28 @@ If the value is not a list, symmetric encryption will be used."
286 msg)) 288 msg))
287 289
288 290
291;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
292(defun auth-source-read-char-choice (prompt choices)
293 "Read one of CHOICES by `read-char-choice', or `read-char'.
294`dropdown-list' support is disabled because it doesn't work reliably.
295Only one of CHOICES will be returned. The PROMPT is augmented
296with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
297 (when choices
298 (let* ((prompt-choices
299 (apply 'concat (loop for c in choices
300 collect (format "%c/" c))))
301 (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
302 (full-prompt (concat prompt prompt-choices))
303 k)
304
305 (while (not (memq k choices))
306 (setq k (cond
307 ((fboundp 'read-char-choice)
308 (read-char-choice full-prompt choices))
309 (t (message "%s" full-prompt)
310 (setq k (read-char))))))
311 k)))
312
289;; (auth-source-pick nil :host "any" :port 'imap :user "joe") 313;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
290;; (auth-source-pick t :host "any" :port 'imap :user "joe") 314;; (auth-source-pick t :host "any" :port 'imap :user "joe")
291;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe") 315;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
@@ -393,7 +417,7 @@ parameters."
393 417
394(defun* auth-source-search (&rest spec 418(defun* auth-source-search (&rest spec
395 &key type max host user port secret 419 &key type max host user port secret
396 create delete 420 require create delete
397 &allow-other-keys) 421 &allow-other-keys)
398 "Search or modify authentication backends according to SPEC. 422 "Search or modify authentication backends according to SPEC.
399 423
@@ -487,6 +511,11 @@ should `catch' the backend-specific error as usual. Some
487backends (netrc, at least) will prompt the user rather than throw 511backends (netrc, at least) will prompt the user rather than throw
488an error. 512an error.
489 513
514:require (A B C) means that only results that contain those
515tokens will be returned. Thus for instance requiring :secret
516will ensure that any results will actually have a :secret
517property.
518
490:delete t means to delete any found entries. nil by default. 519:delete t means to delete any found entries. nil by default.
491Use `auth-source-delete' in ELisp code instead of calling 520Use `auth-source-delete' in ELisp code instead of calling
492`auth-source-search' directly with this parameter. 521`auth-source-search' directly with this parameter.
@@ -516,11 +545,17 @@ is a plist with keys :backend :host :port :user, plus any other
516keys provided by the backend (notably :secret). But note the 545keys provided by the backend (notably :secret). But note the
517exception for :max 0, which see above. 546exception for :max 0, which see above.
518 547
548The token can hold a :save-function key. If you call that, the
549user will be prompted to save the data to the backend. You can't
550request that this should happen right after creation, because
551`auth-source-search' has no way of knowing if the token is
552actually useful. So the caller must arrange to call this function.
553
519The token's :secret key can hold a function. In that case you 554The token's :secret key can hold a function. In that case you
520must call it to obtain the actual value." 555must call it to obtain the actual value."
521 (let* ((backends (mapcar 'auth-source-backend-parse auth-sources)) 556 (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
522 (max (or max 1)) 557 (max (or max 1))
523 (ignored-keys '(:create :delete :max)) 558 (ignored-keys '(:require :create :delete :max))
524 (keys (loop for i below (length spec) by 2 559 (keys (loop for i below (length spec) by 2
525 unless (memq (nth i spec) ignored-keys) 560 unless (memq (nth i spec) ignored-keys)
526 collect (nth i spec))) 561 collect (nth i spec)))
@@ -539,6 +574,10 @@ must call it to obtain the actual value."
539 (or (eq t create) (listp create)) t 574 (or (eq t create) (listp create)) t
540 "Invalid auth-source :create parameter (must be t or a list): %s %s") 575 "Invalid auth-source :create parameter (must be t or a list): %s %s")
541 576
577 (assert
578 (listp require) t
579 "Invalid auth-source :require parameter (must be a list): %s")
580
542 (setq filtered-backends (copy-sequence backends)) 581 (setq filtered-backends (copy-sequence backends))
543 (dolist (backend backends) 582 (dolist (backend backends)
544 (dolist (key keys) 583 (dolist (key keys)
@@ -562,8 +601,9 @@ must call it to obtain the actual value."
562 spec 601 spec
563 ;; to exit early 602 ;; to exit early
564 max 603 max
565 ;; create and delete 604 ;; create is always nil here
566 nil delete)) 605 nil delete
606 require))
567 607
568 (auth-source-do-debug 608 (auth-source-do-debug
569 "auth-source-search: found %d results (max %d) matching %S" 609 "auth-source-search: found %d results (max %d) matching %S"
@@ -577,9 +617,9 @@ must call it to obtain the actual value."
577 spec 617 spec
578 ;; to exit early 618 ;; to exit early
579 max 619 max
580 ;; create and delete 620 create delete
581 create delete)) 621 require))
582 (auth-source-do-warn 622 (auth-source-do-debug
583 "auth-source-search: CREATED %d results (max %d) matching %S" 623 "auth-source-search: CREATED %d results (max %d) matching %S"
584 (length found) max spec)) 624 (length found) max spec))
585 625
@@ -589,18 +629,19 @@ must call it to obtain the actual value."
589 629
590 found)) 630 found))
591 631
592(defun auth-source-search-backends (backends spec max create delete) 632(defun auth-source-search-backends (backends spec max create delete require)
593 (let (matches) 633 (let (matches)
594 (dolist (backend backends) 634 (dolist (backend backends)
595 (when (> max (length matches)) ; when we need more matches... 635 (when (> max (length matches)) ; when we need more matches...
596 (let ((bmatches (apply 636 (let* ((bmatches (apply
597 (slot-value backend 'search-function) 637 (slot-value backend 'search-function)
598 :backend backend 638 :backend backend
599 ;; note we're overriding whatever the spec 639 ;; note we're overriding whatever the spec
600 ;; has for :create and :delete 640 ;; has for :require, :create, and :delete
601 :create create 641 :require require
602 :delete delete 642 :create create
603 spec))) 643 :delete delete
644 spec)))
604 (when bmatches 645 (when bmatches
605 (auth-source-do-trivia 646 (auth-source-do-trivia
606 "auth-source-search-backend: got %d (max %d) in %s:%s matching %S" 647 "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
@@ -713,7 +754,28 @@ while \(:host t) would find all host entries."
713 (return 'no))) 754 (return 'no)))
714 'no)))) 755 'no))))
715 756
716;;; Backend specific parsing: netrc/authinfo backend 757;;; (auth-source-pick-first-password :host "z.lifelogs.com")
758;;; (auth-source-pick-first-password :port "imap")
759(defun auth-source-pick-first-password (&rest spec)
760 "Pick the first secret found from applying SPEC to `auth-source-search'."
761 (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1))))
762 (secret (plist-get result :secret)))
763
764 (if (functionp secret)
765 (funcall secret)
766 secret)))
767
768;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
769(defun auth-source-format-prompt (prompt alist)
770 "Format PROMPT using %x (for any character x) specifiers in ALIST."
771 (dolist (cell alist)
772 (let ((c (nth 0 cell))
773 (v (nth 1 cell)))
774 (when (and c v)
775 (setq prompt (replace-regexp-in-string (format "%%%c" c)
776 (format "%s" v)
777 prompt)))))
778 prompt)
717 779
718(defun auth-source-ensure-strings (values) 780(defun auth-source-ensure-strings (values)
719 (unless (listp values) 781 (unless (listp values)
@@ -724,12 +786,14 @@ while \(:host t) would find all host entries."
724 value)) 786 value))
725 values)) 787 values))
726 788
789;;; Backend specific parsing: netrc/authinfo backend
790
727(defvar auth-source-netrc-cache nil) 791(defvar auth-source-netrc-cache nil)
728 792
729;;; (auth-source-netrc-parse "~/.authinfo.gpg") 793;;; (auth-source-netrc-parse "~/.authinfo.gpg")
730(defun* auth-source-netrc-parse (&rest 794(defun* auth-source-netrc-parse (&rest
731 spec 795 spec
732 &key file max host user port delete 796 &key file max host user port delete require
733 &allow-other-keys) 797 &allow-other-keys)
734 "Parse FILE and return a list of all entries in the file. 798 "Parse FILE and return a list of all entries in the file.
735Note that the MAX parameter is used so we can exit the parse early." 799Note that the MAX parameter is used so we can exit the parse early."
@@ -828,7 +892,15 @@ Note that the MAX parameter is used so we can exit the parse early."
828 (or 892 (or
829 (aget alist "port") 893 (aget alist "port")
830 (aget alist "protocol") 894 (aget alist "protocol")
831 t))) 895 t))
896 (or
897 ;; the required list of keys is nil, or
898 (null require)
899 ;; every element of require is in the normalized list
900 (let ((normalized (nth 0 (auth-source-netrc-normalize
901 (list alist)))))
902 (loop for req in require
903 always (plist-get normalized req)))))
832 (decf max) 904 (decf max)
833 (push (nreverse alist) result) 905 (push (nreverse alist) result)
834 ;; to delete a line, we just comment it out 906 ;; to delete a line, we just comment it out
@@ -853,7 +925,7 @@ Note that the MAX parameter is used so we can exit the parse early."
853 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) 925 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
854 926
855 ;; ask AFTER we've successfully opened the file 927 ;; ask AFTER we've successfully opened the file
856 (when (y-or-n-p (format "Save file %s? (%d modifications)" 928 (when (y-or-n-p (format "Save file %s? (%d deletions)"
857 file modified)) 929 file modified))
858 (write-region (point-min) (point-max) file nil 'silent) 930 (write-region (point-min) (point-max) file nil 'silent)
859 (auth-source-do-debug 931 (auth-source-do-debug
@@ -893,7 +965,7 @@ Note that the MAX parameter is used so we can exit the parse early."
893 965
894(defun* auth-source-netrc-search (&rest 966(defun* auth-source-netrc-search (&rest
895 spec 967 spec
896 &key backend create delete 968 &key backend require create delete
897 type max host user port 969 type max host user port
898 &allow-other-keys) 970 &allow-other-keys)
899"Given a property list SPEC, return search matches from the :backend. 971"Given a property list SPEC, return search matches from the :backend.
@@ -905,6 +977,7 @@ See `auth-source-search' for details on SPEC."
905 (let ((results (auth-source-netrc-normalize 977 (let ((results (auth-source-netrc-normalize
906 (auth-source-netrc-parse 978 (auth-source-netrc-parse
907 :max max 979 :max max
980 :require require
908 :delete delete 981 :delete delete
909 :file (oref backend source) 982 :file (oref backend source)
910 :host (or host t) 983 :host (or host t)
@@ -933,17 +1006,6 @@ See `auth-source-search' for details on SPEC."
933 (nth 0 v) 1006 (nth 0 v)
934 v)) 1007 v))
935 1008
936;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
937
938(defun auth-source-format-prompt (prompt alist)
939 "Format PROMPT using %x (for any character x) specifiers in ALIST."
940 (dolist (cell alist)
941 (let ((c (nth 0 cell))
942 (v (nth 1 cell)))
943 (when (and c v)
944 (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt)))))
945 prompt)
946
947;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) 1009;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
948;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) 1010;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
949 1011
@@ -992,12 +1054,12 @@ See `auth-source-search' for details on SPEC."
992 (data (auth-source-netrc-element-or-first data)) 1054 (data (auth-source-netrc-element-or-first data))
993 ;; this is the default to be offered 1055 ;; this is the default to be offered
994 (given-default (aget auth-source-creation-defaults r)) 1056 (given-default (aget auth-source-creation-defaults r))
995 ;; the default supplementals are simple: for the user, 1057 ;; the default supplementals are simple:
996 ;; try (user-login-name), otherwise take given-default 1058 ;; for the user, try `given-default' and then (user-login-name);
1059 ;; otherwise take `given-default'
997 (default (cond 1060 (default (cond
998 ;; don't default the user name 1061 ((and (not given-default) (eq r 'user))
999 ;; ((and (not given-default) (eq r 'user)) 1062 (user-login-name))
1000 ;; (user-login-name))
1001 (t given-default))) 1063 (t given-default)))
1002 (printable-defaults (list 1064 (printable-defaults (list
1003 (cons 'user 1065 (cons 'user
@@ -1020,10 +1082,10 @@ See `auth-source-search' for details on SPEC."
1020 "[any port]")))) 1082 "[any port]"))))
1021 (prompt (or (aget auth-source-creation-prompts r) 1083 (prompt (or (aget auth-source-creation-prompts r)
1022 (case r 1084 (case r
1023 ('secret "%p password for user %u, host %h: ") 1085 (secret "%p password for %u@%h: ")
1024 ('user "%p user name: ") 1086 (user "%p user name for %h: ")
1025 ('host "%p host name for user %u: ") 1087 (host "%p host name for user %u: ")
1026 ('port "%p port for user %u and host %h: ")) 1088 (port "%p port for %u@%h: "))
1027 (format "Enter %s (%%u@%%h:%%p): " r))) 1089 (format "Enter %s (%%u@%%h:%%p): " r)))
1028 (prompt (auth-source-format-prompt 1090 (prompt (auth-source-format-prompt
1029 prompt 1091 prompt
@@ -1031,14 +1093,20 @@ See `auth-source-search' for details on SPEC."
1031 (?h ,(aget printable-defaults 'host)) 1093 (?h ,(aget printable-defaults 'host))
1032 (?p ,(aget printable-defaults 'port)))))) 1094 (?p ,(aget printable-defaults 'port))))))
1033 1095
1034 ;; store the data, prompting for the password if needed 1096 ;; Store the data, prompting for the password if needed.
1035 (setq data 1097 (setq data
1036 (cond 1098 (cond
1037 ((and (null data) (eq r 'secret)) 1099 ((and (null data) (eq r 'secret))
1038 ;; special case prompt for passwords 1100 ;; Special case prompt for passwords.
1039 (read-passwd prompt)) 1101 (read-passwd prompt))
1040 ((null data) 1102 ((null data)
1041 (read-string prompt default)) 1103 (when default
1104 (setq prompt
1105 (if (string-match ": *\\'" prompt)
1106 (concat (substring prompt 0 (match-beginning 0))
1107 " (default " default "): ")
1108 (concat prompt "(default " default ") "))))
1109 (read-string prompt nil nil default))
1042 (t (or data default)))) 1110 (t (or data default))))
1043 1111
1044 (when data 1112 (when data
@@ -1049,7 +1117,7 @@ See `auth-source-search' for details on SPEC."
1049 (lambda () data)) 1117 (lambda () data))
1050 data)))) 1118 data))))
1051 1119
1052 ;; when r is not an empty string... 1120 ;; When r is not an empty string...
1053 (when (and (stringp data) 1121 (when (and (stringp data)
1054 (< 0 (length data))) 1122 (< 0 (length data)))
1055 ;; this function is not strictly necessary but I think it 1123 ;; this function is not strictly necessary but I think it
@@ -1062,79 +1130,99 @@ See `auth-source-search' for details on SPEC."
1062 (if (zerop (length add)) "" " ") 1130 (if (zerop (length add)) "" " ")
1063 ;; remap auth-source tokens to netrc 1131 ;; remap auth-source tokens to netrc
1064 (case r 1132 (case r
1065 ('user "login") 1133 (user "login")
1066 ('host "machine") 1134 (host "machine")
1067 ('secret "password") 1135 (secret "password")
1068 ('port "port") ; redundant but clearer 1136 (port "port") ; redundant but clearer
1069 (t (symbol-name r))) 1137 (t (symbol-name r)))
1070 ;; the value will be printed in %S format 1138 ;; the value will be printed in %S format
1071 data)))) 1139 data))))
1072 (setq add (concat add (funcall printer))))))) 1140 (setq add (concat add (funcall printer)))))))
1073 1141
1074 (with-temp-buffer 1142 (plist-put
1075 (when (file-exists-p file) 1143 artificial
1076 (insert-file-contents file)) 1144 :save-function
1077 (when auth-source-gpg-encrypt-to 1145 (lexical-let ((file file)
1078 ;; (see bug#7487) making `epa-file-encrypt-to' local to 1146 (add add))
1079 ;; this buffer lets epa-file skip the key selection query 1147 (lambda () (auth-source-netrc-saver file add))))
1080 ;; (see the `local-variable-p' check in 1148
1081 ;; `epa-file-write-region'). 1149 (list artificial)))
1082 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) 1150
1083 (make-local-variable 'epa-file-encrypt-to)) 1151;;(funcall (plist-get (nth 0 (auth-source-search :host '("nonesuch2") :user "tzz" :port "imap" :create t :max 1)) :save-function))
1084 (if (listp auth-source-gpg-encrypt-to) 1152(defun auth-source-netrc-saver (file add)
1085 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) 1153 "Save a line ADD in FILE, prompting along the way.
1086 (goto-char (point-max)) 1154Respects `auth-source-save-behavior'. Uses
1087 1155`auth-source-netrc-cache' to avoid prompting more than once."
1088 ;; ask AFTER we've successfully opened the file 1156 (let* ((key (format "%s %s" file (rfc2104-hash 'md5 64 16 file add)))
1089 (let ((prompt (format "Save auth info to file %s? %s: " 1157 (cached (assoc key auth-source-netrc-cache)))
1090 file 1158
1091 "y/n/N/e/?")) 1159 (if cached
1092 (done (not (eq auth-source-save-behavior 'ask))) 1160 (auth-source-do-trivia
1093 (bufname "*auth-source Help*") 1161 "auth-source-netrc-saver: found previous run for key %s, returning"
1094 k) 1162 key)
1095 (while (not done) 1163 (with-temp-buffer
1096 (message "%s" prompt) 1164 (when (file-exists-p file)
1097 (setq k (read-char)) 1165 (insert-file-contents file))
1098 (case k 1166 (when auth-source-gpg-encrypt-to
1099 (?y (setq done t)) 1167 ;; (see bug#7487) making `epa-file-encrypt-to' local to
1100 (?? (save-excursion 1168 ;; this buffer lets epa-file skip the key selection query
1101 (with-output-to-temp-buffer bufname 1169 ;; (see the `local-variable-p' check in
1102 (princ 1170 ;; `epa-file-write-region').
1103 (concat "(y)es, save\n" 1171 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
1104 "(n)o but use the info\n" 1172 (make-local-variable 'epa-file-encrypt-to))
1105 "(N)o and don't ask to save again\n" 1173 (if (listp auth-source-gpg-encrypt-to)
1106 "(e)dit the line\n" 1174 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
1107 "(?) for help as you can see.\n")) 1175 ;; we want the new data to be found first, so insert at beginning
1108 (set-buffer standard-output) 1176 (goto-char (point-min))
1109 (help-mode)))) 1177
1110 (?n (setq add "" 1178 ;; Ask AFTER we've successfully opened the file.
1111 done t)) 1179 (let ((prompt (format "Save auth info to file %s? " file))
1112 (?N (setq add "" 1180 (done (not (eq auth-source-save-behavior 'ask)))
1113 done t 1181 (bufname "*auth-source Help*")
1114 auth-source-save-behavior nil)) 1182 k)
1115 (?e (setq add (read-string "Line to add: " add))) 1183 (while (not done)
1116 (t nil))) 1184 (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??)))
1117 1185 (case k
1118 (when (get-buffer-window bufname) 1186 (?y (setq done t))
1119 (delete-window (get-buffer-window bufname))) 1187 (?? (save-excursion
1120 1188 (with-output-to-temp-buffer bufname
1121 ;; make sure the info is not saved 1189 (princ
1122 (when (null auth-source-save-behavior) 1190 (concat "(y)es, save\n"
1123 (setq add "")) 1191 "(n)o but use the info\n"
1124 1192 "(N)o and don't ask to save again\n"
1125 (when (< 0 (length add)) 1193 "(e)dit the line\n"
1126 (progn 1194 "(?) for help as you can see.\n"))
1127 (unless (bolp) 1195 ;; Why? Doesn't with-output-to-temp-buffer already do
1128 (insert "\n")) 1196 ;; the exact same thing anyway? --Stef
1129 (insert add "\n") 1197 (set-buffer standard-output)
1130 (write-region (point-min) (point-max) file nil 'silent) 1198 (help-mode))))
1131 (auth-source-do-warn 1199 (?n (setq add ""
1132 "auth-source-netrc-create: wrote 1 new line to %s" 1200 done t))
1133 file) 1201 (?N (setq add ""
1134 nil)) 1202 done t
1135 1203 auth-source-save-behavior nil))
1136 (when (eq done t) 1204 (?e (setq add (read-string "Line to add: " add)))
1137 (list artificial)))))) 1205 (t nil)))
1206
1207 (when (get-buffer-window bufname)
1208 (delete-window (get-buffer-window bufname)))
1209
1210 ;; Make sure the info is not saved.
1211 (when (null auth-source-save-behavior)
1212 (setq add ""))
1213
1214 (when (< 0 (length add))
1215 (progn
1216 (unless (bolp)
1217 (insert "\n"))
1218 (insert add "\n")
1219 (write-region (point-min) (point-max) file nil 'silent)
1220 (auth-source-do-debug
1221 "auth-source-netrc-create: wrote 1 new line to %s"
1222 file)
1223 (message "Saved new authentication information to %s" file)
1224 nil))))
1225 (aput 'auth-source-netrc-cache key "ran"))))
1138 1226
1139;;; Backend specific parsing: Secrets API backend 1227;;; Backend specific parsing: Secrets API backend
1140 1228
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index c64138b43d7..7c7e0531926 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -44,6 +44,7 @@
44(require 'wid-edit) 44(require 'wid-edit)
45(require 'mm-uu) 45(require 'mm-uu)
46(require 'message) 46(require 'message)
47(require 'mouse)
47 48
48(autoload 'gnus-msg-mail "gnus-msg" nil t) 49(autoload 'gnus-msg-mail "gnus-msg" nil t)
49(autoload 'gnus-button-mailto "gnus-msg") 50(autoload 'gnus-button-mailto "gnus-msg")
@@ -2337,10 +2338,12 @@ long lines if and only if arg is positive."
2337 (let ((start (point))) 2338 (let ((start (point)))
2338 (insert "X-Boundary: ") 2339 (insert "X-Boundary: ")
2339 (gnus-add-text-properties start (point) '(invisible t intangible t)) 2340 (gnus-add-text-properties start (point) '(invisible t intangible t))
2340 (insert (let (str) 2341 (insert (let (str (max (window-width)))
2341 (while (>= (window-width) (length str)) 2342 (if (featurep 'xemacs)
2343 (setq max (1- max)))
2344 (while (>= max (length str))
2342 (setq str (concat str gnus-body-boundary-delimiter))) 2345 (setq str (concat str gnus-body-boundary-delimiter)))
2343 (substring str 0 (window-width))) 2346 (substring str 0 max))
2344 "\n") 2347 "\n")
2345 (gnus-put-text-property start (point) 'gnus-decoration 'header))))) 2348 (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
2346 2349
@@ -3074,10 +3077,7 @@ images if any to the browser, and deletes them when exiting the group
3074The `gnus-list-identifiers' variable specifies what to do." 3077The `gnus-list-identifiers' variable specifies what to do."
3075 (interactive) 3078 (interactive)
3076 (let ((inhibit-point-motion-hooks t) 3079 (let ((inhibit-point-motion-hooks t)
3077 (regexp (or (gnus-parameter-list-identifier gnus-newsgroup-name) 3080 (regexp (gnus-group-get-list-identifiers gnus-newsgroup-name))
3078 (if (consp gnus-list-identifiers)
3079 (mapconcat 'identity gnus-list-identifiers " *\\|")
3080 gnus-list-identifiers)))
3081 (inhibit-read-only t)) 3081 (inhibit-read-only t))
3082 (when regexp 3082 (when regexp
3083 (save-excursion 3083 (save-excursion
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 9ed3cf02a49..c265538e19c 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -697,7 +697,8 @@ simple manner.")
697 "M" gnus-group-list-all-matching 697 "M" gnus-group-list-all-matching
698 "l" gnus-group-list-level 698 "l" gnus-group-list-level
699 "c" gnus-group-list-cached 699 "c" gnus-group-list-cached
700 "?" gnus-group-list-dormant) 700 "?" gnus-group-list-dormant
701 "!" gnus-group-list-ticked)
701 702
702(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) 703(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
703 "k" gnus-group-list-limit 704 "k" gnus-group-list-limit
@@ -849,7 +850,8 @@ simple manner.")
849 ["List all groups matching..." gnus-group-list-all-matching t] 850 ["List all groups matching..." gnus-group-list-all-matching t]
850 ["List active file" gnus-group-list-active t] 851 ["List active file" gnus-group-list-active t]
851 ["List groups with cached" gnus-group-list-cached t] 852 ["List groups with cached" gnus-group-list-cached t]
852 ["List groups with dormant" gnus-group-list-dormant t]) 853 ["List groups with dormant" gnus-group-list-dormant t]
854 ["List groups with ticked" gnus-group-list-ticked t])
853 ("Sort" 855 ("Sort"
854 ["Default sort" gnus-group-sort-groups t] 856 ["Default sort" gnus-group-sort-groups t]
855 ["Sort by method" gnus-group-sort-groups-by-method t] 857 ["Sort by method" gnus-group-sort-groups-by-method t]
@@ -2313,9 +2315,10 @@ Return the name of the group if selection was successful."
2313 gnus-fetch-old-ephemeral-headers)) 2315 gnus-fetch-old-ephemeral-headers))
2314 (gnus-group-read-group (or number t) t group select-articles)) 2316 (gnus-group-read-group (or number t) t group select-articles))
2315 group) 2317 group)
2316 ;;(error nil)
2317 (quit 2318 (quit
2318 (message "Quit reading the ephemeral group") 2319 (if debug-on-quit
2320 (debug "Quit")
2321 (message "Quit reading the ephemeral group"))
2319 nil))))) 2322 nil)))))
2320 2323
2321(defcustom gnus-gmane-group-download-format 2324(defcustom gnus-gmane-group-download-format
@@ -4535,6 +4538,28 @@ This command may read the active file."
4535 (goto-char (point-min)) 4538 (goto-char (point-min))
4536 (gnus-group-position-point)) 4539 (gnus-group-position-point))
4537 4540
4541(defun gnus-group-list-ticked (level &optional lowest)
4542 "List all groups with ticked articles.
4543If the prefix LEVEL is non-nil, it should be a number that says which
4544level to cut off listing groups.
4545If LOWEST, don't list groups with level lower than LOWEST.
4546
4547This command may read the active file."
4548 (interactive "P")
4549 (when level
4550 (setq level (prefix-numeric-value level)))
4551 (when (or (not level) (>= level gnus-level-zombie))
4552 (gnus-cache-open))
4553 (funcall gnus-group-prepare-function
4554 (or level gnus-level-subscribed)
4555 #'(lambda (info)
4556 (let ((marks (gnus-info-marks info)))
4557 (assq 'tick marks)))
4558 lowest
4559 'ignore)
4560 (goto-char (point-min))
4561 (gnus-group-position-point))
4562
4538(defun gnus-group-listed-groups () 4563(defun gnus-group-listed-groups ()
4539 "Return a list of listed groups." 4564 "Return a list of listed groups."
4540 (let (point groups) 4565 (let (point groups)
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index a67063bb970..ef15a479892 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -270,7 +270,9 @@ If it is down, start it up (again)."
270 server (error-message-string err)) 270 server (error-message-string err))
271 nil) 271 nil)
272 (quit 272 (quit
273 (gnus-message 1 "Quit trying to open server %s" server) 273 (if debug-on-quit
274 (debug "Quit")
275 (gnus-message 1 "Quit trying to open server %s" server))
274 nil))) 276 nil)))
275 open-offline) 277 open-offline)
276 ;; If this hasn't been opened before, we add it to the list. 278 ;; If this hasn't been opened before, we add it to the list.
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index ebfa53f841e..afded87fe37 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1306,16 +1306,13 @@ for new groups, and subscribe the new groups as zombies."
1306 ((>= level gnus-level-zombie) 1306 ((>= level gnus-level-zombie)
1307 ;; Remove from the hash table. 1307 ;; Remove from the hash table.
1308 (gnus-sethash group nil gnus-newsrc-hashtb) 1308 (gnus-sethash group nil gnus-newsrc-hashtb)
1309 ;; We do not enter foreign groups into the list of dead 1309 (if (= level gnus-level-zombie)
1310 ;; groups. 1310 (push group gnus-zombie-list)
1311 (unless (gnus-group-foreign-p group) 1311 (if (= oldlevel gnus-level-killed)
1312 (if (= level gnus-level-zombie) 1312 ;; Remove from active hashtb.
1313 (push group gnus-zombie-list) 1313 (unintern group gnus-active-hashtb)
1314 (if (= oldlevel gnus-level-killed) 1314 ;; Don't add it into killed-list if it was killed.
1315 ;; Remove from active hashtb. 1315 (push group gnus-killed-list))))
1316 (unintern group gnus-active-hashtb)
1317 ;; Don't add it into killed-list if it was killed.
1318 (push group gnus-killed-list)))))
1319 (t 1316 (t
1320 ;; If the list is to be entered into the newsrc assoc, and 1317 ;; If the list is to be entered into the newsrc assoc, and
1321 ;; it was killed, we have to create an entry in the newsrc 1318 ;; it was killed, we have to create an entry in the newsrc
@@ -1465,9 +1462,10 @@ If SCAN, request a scan of that group as well."
1465 (inline (gnus-request-group group (or dont-sub-check dont-check) 1462 (inline (gnus-request-group group (or dont-sub-check dont-check)
1466 method 1463 method
1467 (gnus-get-info group))) 1464 (gnus-get-info group)))
1468 ;;(error nil)
1469 (quit 1465 (quit
1470 (message "Quit activating %s" group) 1466 (if debug-on-quit
1467 (debug "Quit")
1468 (message "Quit activating %s" group))
1471 nil))) 1469 nil)))
1472 (unless dont-check 1470 (unless dont-check
1473 (setq active (gnus-parse-active)) 1471 (setq active (gnus-parse-active))
@@ -2007,7 +2005,9 @@ If SCAN, request a scan of that group as well."
2007 ;; We catch C-g so that we can continue past servers 2005 ;; We catch C-g so that we can continue past servers
2008 ;; that do not respond. 2006 ;; that do not respond.
2009 (quit 2007 (quit
2010 (message "Quit reading the active file") 2008 (if debug-on-quit
2009 (debug "Quit")
2010 (message "Quit reading the active file"))
2011 nil)))))))) 2011 nil))))))))
2012 2012
2013(defun gnus-read-active-file-1 (method force) 2013(defun gnus-read-active-file-1 (method force)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a8786e39c7b..29a98b7d11d 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5510,12 +5510,17 @@ or a straight list of headers."
5510 (cdr (assq number gnus-newsgroup-scored)) 5510 (cdr (assq number gnus-newsgroup-scored))
5511 (memq number gnus-newsgroup-processable)))))) 5511 (memq number gnus-newsgroup-processable))))))
5512 5512
5513(defun gnus-group-get-list-identifiers (group)
5514 "Get list identifier regexp for GROUP."
5515 (or (gnus-parameter-list-identifier group)
5516 (if (consp gnus-list-identifiers)
5517 (mapconcat 'identity gnus-list-identifiers " *\\|")
5518 gnus-list-identifiers)))
5519
5513(defun gnus-summary-remove-list-identifiers () 5520(defun gnus-summary-remove-list-identifiers ()
5514 "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." 5521 "Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
5515 (let ((regexp (if (consp gnus-list-identifiers) 5522 (let ((regexp (gnus-group-get-list-identifiers gnus-newsgroup-name))
5516 (mapconcat 'identity gnus-list-identifiers " *\\|") 5523 changed subject)
5517 gnus-list-identifiers))
5518 changed subject)
5519 (when regexp 5524 (when regexp
5520 (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)")) 5525 (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)"))
5521 (dolist (header gnus-newsgroup-headers) 5526 (dolist (header gnus-newsgroup-headers)
@@ -5707,8 +5712,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5707 (when gnus-agent 5712 (when gnus-agent
5708 (gnus-agent-get-undownloaded-list)) 5713 (gnus-agent-get-undownloaded-list))
5709 ;; Remove list identifiers from subject 5714 ;; Remove list identifiers from subject
5710 (when gnus-list-identifiers 5715 (gnus-summary-remove-list-identifiers)
5711 (gnus-summary-remove-list-identifiers))
5712 ;; Check whether auto-expire is to be done in this group. 5716 ;; Check whether auto-expire is to be done in this group.
5713 (setq gnus-newsgroup-auto-expire 5717 (setq gnus-newsgroup-auto-expire
5714 (gnus-group-auto-expirable-p group)) 5718 (gnus-group-auto-expirable-p group))
@@ -5798,7 +5802,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5798 5802
5799(defun gnus-articles-to-read (group &optional read-all) 5803(defun gnus-articles-to-read (group &optional read-all)
5800 "Find out what articles the user wants to read." 5804 "Find out what articles the user wants to read."
5801 (let* ((articles 5805 (let* ((only-read-p t)
5806 (articles
5802 ;; Select all articles if `read-all' is non-nil, or if there 5807 ;; Select all articles if `read-all' is non-nil, or if there
5803 ;; are no unread articles. 5808 ;; are no unread articles.
5804 (if (or read-all 5809 (if (or read-all
@@ -5822,6 +5827,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5822 (gnus-uncompress-range (gnus-active group))) 5827 (gnus-uncompress-range (gnus-active group)))
5823 (gnus-cache-articles-in-group group)) 5828 (gnus-cache-articles-in-group group))
5824 ;; Select only the "normal" subset of articles. 5829 ;; Select only the "normal" subset of articles.
5830 (setq only-read-p nil)
5825 (gnus-sorted-nunion 5831 (gnus-sorted-nunion
5826 (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked) 5832 (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
5827 gnus-newsgroup-unreads))) 5833 gnus-newsgroup-unreads)))
@@ -5845,16 +5851,25 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5845 (let* ((cursor-in-echo-area nil) 5851 (let* ((cursor-in-echo-area nil)
5846 (initial (gnus-parameter-large-newsgroup-initial 5852 (initial (gnus-parameter-large-newsgroup-initial
5847 gnus-newsgroup-name)) 5853 gnus-newsgroup-name))
5854 (default (if only-read-p
5855 (or initial gnus-large-newsgroup)
5856 number))
5848 (input 5857 (input
5849 (read-string 5858 (read-string
5850 (format 5859 (if only-read-p
5851 "How many articles from %s (%s %d): " 5860 (format
5852 (gnus-group-decoded-name gnus-newsgroup-name) 5861 "How many articles from %s (available %d, default %d): "
5853 (if initial "max" "default") 5862 (gnus-group-decoded-name
5854 number) 5863 (gnus-group-real-name gnus-newsgroup-name))
5855 (if initial 5864 number default)
5856 (cons (number-to-string initial) 5865 (format
5857 0))))) 5866 "How many articles from %s (%d available): "
5867 (gnus-group-decoded-name
5868 (gnus-group-real-name gnus-newsgroup-name))
5869 default))
5870 nil
5871 nil
5872 (number-to-string default))))
5858 (if (string-match "^[ \t]*$" input) number input))) 5873 (if (string-match "^[ \t]*$" input) number input)))
5859 ((and (> scored marked) (< scored number) 5874 ((and (> scored marked) (< scored number)
5860 (> (- scored number) 20)) 5875 (> (- scored number) 20))
@@ -5862,7 +5877,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5862 (read-string 5877 (read-string
5863 (format "%s %s (%d scored, %d total): " 5878 (format "%s %s (%d scored, %d total): "
5864 "How many articles from" 5879 "How many articles from"
5865 (gnus-group-decoded-name group) 5880 (gnus-group-decoded-name
5881 (gnus-group-real-name gnus-newsgroup-name))
5866 scored number)))) 5882 scored number))))
5867 (if (string-match "^[ \t]*$" input) 5883 (if (string-match "^[ \t]*$" input)
5868 number input))) 5884 number input)))
@@ -6564,9 +6580,8 @@ the subject line on."
6564 (1+ (point-at-eol)) 6580 (1+ (point-at-eol))
6565 (gnus-delete-line)))))) 6581 (gnus-delete-line))))))
6566 ;; Remove list identifiers from subject. 6582 ;; Remove list identifiers from subject.
6567 (when gnus-list-identifiers 6583 (let ((gnus-newsgroup-headers (list header)))
6568 (let ((gnus-newsgroup-headers (list header))) 6584 (gnus-summary-remove-list-identifiers))
6569 (gnus-summary-remove-list-identifiers)))
6570 (when old-header 6585 (when old-header
6571 (mail-header-set-number header (mail-header-number old-header))) 6586 (mail-header-set-number header (mail-header-number old-header)))
6572 (setq gnus-newsgroup-sparse 6587 (setq gnus-newsgroup-sparse
@@ -12670,8 +12685,7 @@ returned."
12670 (when gnus-agent 12685 (when gnus-agent
12671 (gnus-agent-get-undownloaded-list)) 12686 (gnus-agent-get-undownloaded-list))
12672 ;; Remove list identifiers from subject 12687 ;; Remove list identifiers from subject
12673 (when gnus-list-identifiers 12688 (gnus-summary-remove-list-identifiers)
12674 (gnus-summary-remove-list-identifiers))
12675 ;; First and last article in this newsgroup. 12689 ;; First and last article in this newsgroup.
12676 (when gnus-newsgroup-headers 12690 (when gnus-newsgroup-headers
12677 (setq gnus-newsgroup-begin 12691 (setq gnus-newsgroup-begin
diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el
index 892b10a0d0e..fbdacdd2fbe 100644
--- a/lisp/gnus/gnus-sync.el
+++ b/lisp/gnus/gnus-sync.el
@@ -25,7 +25,8 @@
25;; This is the gnus-sync.el package. 25;; This is the gnus-sync.el package.
26 26
27;; It's due for a rewrite using gnus-after-set-mark-hook and 27;; It's due for a rewrite using gnus-after-set-mark-hook and
28;; gnus-before-update-mark-hook. Until then please consider it 28;; gnus-before-update-mark-hook, and my plan is to do this once No
29;; Gnus development is done. Until then please consider it
29;; experimental. 30;; experimental.
30 31
31;; Put this in your startup file (~/.gnus.el for instance) 32;; Put this in your startup file (~/.gnus.el for instance)
@@ -42,7 +43,8 @@
42 43
43;; TODO: 44;; TODO:
44 45
45;; - after gnus-sync-read, the message counts are wrong 46;; - after gnus-sync-read, the message counts are wrong. So it's not
47;; run automatically, you have to call it with M-x gnus-sync-read
46 48
47;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to 49;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to
48;; catch the mark updates 50;; catch the mark updates
@@ -220,13 +222,13 @@ synchronized, I believe). Also see `gnus-variable-list'."
220 "Install the sync hooks." 222 "Install the sync hooks."
221 (interactive) 223 (interactive)
222 ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read) 224 ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read)
223 (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save) 225 ;; (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)
224 (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) 226 (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save))
225 227
226(defun gnus-sync-unload-hook () 228(defun gnus-sync-unload-hook ()
227 "Uninstall the sync hooks." 229 "Uninstall the sync hooks."
228 (interactive) 230 (interactive)
229 ;; (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read) 231 (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read)
230 (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save) 232 (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
231 (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) 233 (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
232 234
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 42dbd5948cf..3f66b45aaab 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -672,11 +672,9 @@ If N, return the Nth ancestor instead."
672 (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references) 672 (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references)
673 (match-string 1 references)))))) 673 (match-string 1 references))))))
674 674
675(defun gnus-buffer-live-p (buffer) 675(defsubst gnus-buffer-live-p (buffer)
676 "Say whether BUFFER is alive or not." 676 "Say whether BUFFER is alive or not."
677 (and buffer 677 (and buffer (buffer-live-p (get-buffer buffer))))
678 (get-buffer buffer)
679 (buffer-name (get-buffer buffer))))
680 678
681(defun gnus-horizontal-recenter () 679(defun gnus-horizontal-recenter ()
682 "Recenter the current buffer horizontally." 680 "Recenter the current buffer horizontally."
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 156f9a020fd..c38f57d96cb 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -268,8 +268,10 @@ See the Gnus manual for an explanation of the syntax used.")
268 (error "Invalid buffer type: %s" type)) 268 (error "Invalid buffer type: %s" type))
269 (let ((buf (gnus-get-buffer-create 269 (let ((buf (gnus-get-buffer-create
270 (gnus-window-to-buffer-helper buffer)))) 270 (gnus-window-to-buffer-helper buffer))))
271 (if (eq buf (window-buffer (selected-window))) (set-buffer buf) 271 (when (buffer-name buf)
272 (switch-to-buffer buf))) 272 (if (eq buf (window-buffer (selected-window)))
273 (set-buffer buf)
274 (switch-to-buffer buf))))
273 (when (memq 'frame-focus split) 275 (when (memq 'frame-focus split)
274 (setq gnus-window-frame-focus window)) 276 (setq gnus-window-frame-focus window))
275 ;; We return the window if it has the `point' spec. 277 ;; We return the window if it has the `point' spec.
diff --git a/lisp/gnus/gravatar.el b/lisp/gnus/gravatar.el
index 0c97080d847..4b0c9a16283 100644
--- a/lisp/gnus/gravatar.el
+++ b/lisp/gnus/gravatar.el
@@ -129,8 +129,10 @@ You can provide a list of argument to pass to CB in CBARGS."
129 "Retrieve MAIL-ADDRESS gravatar and returns it." 129 "Retrieve MAIL-ADDRESS gravatar and returns it."
130 (let ((url (gravatar-build-url mail-address))) 130 (let ((url (gravatar-build-url mail-address)))
131 (if (gravatar-cache-expired url) 131 (if (gravatar-cache-expired url)
132 (with-current-buffer (url-retrieve-synchronously url) 132 (with-current-buffer (if (featurep 'xemacs)
133 (when gravatar-automatic-caching 133 (url-retrieve url)
134 (url-retrieve-synchronously url))
135 (when gravatar-automatic-caching
134 (url-store-in-cache (current-buffer))) 136 (url-store-in-cache (current-buffer)))
135 (let ((data (gravatar-data->image))) 137 (let ((data (gravatar-data->image)))
136 (kill-buffer (current-buffer)) 138 (kill-buffer (current-buffer))
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el
new file mode 100644
index 00000000000..3765fb84ee8
--- /dev/null
+++ b/lisp/gnus/gssapi.el
@@ -0,0 +1,105 @@
1;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs
2
3;; Copyright (C) 2011 Free Software Foundation, Inc.
4
5;; Author: Simon Josefsson <simon@josefsson.org>
6;; Lars Magne Ingebrigtsen <larsi@gnus.org>
7;; Keywords: network
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;;; Code:
27
28(require 'format-spec)
29
30(defcustom gssapi-program (list
31 (concat "gsasl %s %p "
32 "--mechanism GSSAPI "
33 "--authentication-id %l")
34 "imtest -m gssapi -u %l -p %p %s")
35 "List of strings containing commands for GSSAPI (krb5) authentication.
36%s is replaced with server hostname, %p with port to connect to, and
37%l with the value of `imap-default-user'. The program should accept
38IMAP commands on stdin and return responses to stdout. Each entry in
39the list is tried until a successful connection is made."
40 :group 'network
41 :type '(repeat string))
42
43(defun open-gssapi-stream (name buffer server port)
44 (let ((cmds gssapi-program)
45 cmd done)
46 (with-current-buffer buffer
47 (while (and (not done)
48 (setq cmd (pop cmds)))
49 (message "Opening GSSAPI connection with `%s'..." cmd)
50 (erase-buffer)
51 (let* ((coding-system-for-read 'binary)
52 (coding-system-for-write 'binary)
53 (process (start-process
54 name buffer shell-file-name shell-command-switch
55 (format-spec
56 cmd
57 (format-spec-make
58 ?s server
59 ?p (number-to-string port)
60 ?l imap-default-user))))
61 response)
62 (when process
63 (while (and (memq (process-status process) '(open run))
64 (goto-char (point-min))
65 ;; Athena IMTEST can output SSL verify errors
66 (or (while (looking-at "^verify error:num=")
67 (forward-line))
68 t)
69 (or (while (looking-at "^TLS connection established")
70 (forward-line))
71 t)
72 ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
73 (or (while (looking-at "^C:")
74 (forward-line))
75 t)
76 ;; cyrus 1.6 imtest print "S: " before server greeting
77 (or (not (looking-at "S: "))
78 (forward-char 3)
79 t)
80 ;; GNU SASL may print 'Trying ...' first.
81 (or (not (looking-at "Trying "))
82 (forward-line)
83 t)
84 (not (and (looking-at "\\* \\(OK\\|PREAUTH\\|BYE\\) ")
85 ;; success in imtest 1.6:
86 (re-search-forward
87 (concat "^\\(\\(Authenticat.*\\)\\|\\("
88 "Client authentication "
89 "finished.*\\)\\)")
90 nil t)
91 (setq response (match-string 1)))))
92 (accept-process-output process 1)
93 (sit-for 1))
94 (erase-buffer)
95 (message "GSSAPI IMAP connection: %s" (or response "failed"))
96 (if (and response (let ((case-fold-search nil))
97 (not (string-match "failed" response))))
98 (setq done process)
99 (delete-process process)
100 nil))))
101 done)))
102
103(provide 'gssapi)
104
105;;; gssapi.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 08c59b00bfc..bb9215aca7c 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -49,6 +49,7 @@
49(require 'mail-parse) 49(require 'mail-parse)
50(require 'mml) 50(require 'mml)
51(require 'rfc822) 51(require 'rfc822)
52(require 'format-spec)
52 53
53(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ 54(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
54 55
@@ -438,7 +439,10 @@ whitespace)."
438 :group 'message-various) 439 :group 'message-various)
439 440
440(defcustom message-elide-ellipsis "\n[...]\n\n" 441(defcustom message-elide-ellipsis "\n[...]\n\n"
441 "*The string which is inserted for elided text." 442 "*The string which is inserted for elided text.
443This is a format-spec string, and you can use %l to say how many
444lines were removed, and %c to say how many characters were
445removed."
442 :type 'string 446 :type 'string
443 :link '(custom-manual "(message)Various Commands") 447 :link '(custom-manual "(message)Various Commands")
444 :group 'message-various) 448 :group 'message-various)
@@ -3535,8 +3539,12 @@ Note that this should not be used in newsgroups."
3535An ellipsis (from `message-elide-ellipsis') will be inserted where the 3539An ellipsis (from `message-elide-ellipsis') will be inserted where the
3536text was killed." 3540text was killed."
3537 (interactive "r") 3541 (interactive "r")
3538 (kill-region b e) 3542 (let ((lines (count-lines b e))
3539 (insert message-elide-ellipsis)) 3543 (chars (- e b)))
3544 (kill-region b e)
3545 (insert (format-spec message-elide-ellipsis
3546 `((?l . ,lines)
3547 (?c . ,chars))))))
3540 3548
3541(defvar message-caesar-translation-table nil) 3549(defvar message-caesar-translation-table nil)
3542 3550
@@ -3749,12 +3757,12 @@ prefix, and don't delete any headers."
3749 (insert-before-markers ?\n) 3757 (insert-before-markers ?\n)
3750 (goto-char pt)))) 3758 (goto-char pt))))
3751 (case message-cite-reply-position 3759 (case message-cite-reply-position
3752 ('above 3760 (above
3753 (message-goto-body) 3761 (message-goto-body)
3754 (insert body-text) 3762 (insert body-text)
3755 (insert (if (bolp) "\n" "\n\n")) 3763 (insert (if (bolp) "\n" "\n\n"))
3756 (message-goto-body)) 3764 (message-goto-body))
3757 ('below 3765 (below
3758 (message-goto-signature))) 3766 (message-goto-signature)))
3759 ;; Add a `message-setup-very-last-hook' here? 3767 ;; Add a `message-setup-very-last-hook' here?
3760 ;; Add `gnus-article-highlight-citation' here? 3768 ;; Add `gnus-article-highlight-citation' here?
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 14b44198303..4f7b5ed26b3 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -158,6 +158,12 @@ This can be either \"inline\" or \"attachment\".")
158 mm-uu-diff-extract 158 mm-uu-diff-extract
159 nil 159 nil
160 mm-uu-diff-test) 160 mm-uu-diff-test)
161 (diff
162 "^=== modified file "
163 nil
164 mm-uu-diff-extract
165 nil
166 mm-uu-diff-test)
161 (git-format-patch 167 (git-format-patch
162 "^diff --git " 168 "^diff --git "
163 "^-- " 169 "^-- "
@@ -699,6 +705,8 @@ Assume text has been decoded if DECODED is non-nil."
699 ;; Mutt still uses application/pgp even though 705 ;; Mutt still uses application/pgp even though
700 ;; it has already been withdrawn. 706 ;; it has already been withdrawn.
701 (string-match "\\`text/\\|\\`application/pgp\\'" type) 707 (string-match "\\`text/\\|\\`application/pgp\\'" type)
708 (equal (car (mm-handle-disposition handle))
709 "inline")
702 (setq 710 (setq
703 children 711 children
704 (with-current-buffer buffer 712 (with-current-buffer buffer
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index aa4ecbc3b0f..bcbe7b678d5 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -279,16 +279,21 @@ textual parts.")
279 (current-buffer))) 279 (current-buffer)))
280 280
281(defun nnimap-credentials (address ports) 281(defun nnimap-credentials (address ports)
282 (let ((found (nth 0 (auth-source-search :max 1 282 (let* ((auth-source-creation-prompts
283 :host address 283 '((user . "IMAP user at %h: ")
284 :port ports 284 (secret . "IMAP password for %u@%h: ")))
285 :create t)))) 285 (found (nth 0 (auth-source-search :max 1
286 :host address
287 :port ports
288 :require '(:user :secret)
289 :create t))))
286 (if found 290 (if found
287 (list (plist-get found :user) 291 (list (plist-get found :user)
288 (let ((secret (plist-get found :secret))) 292 (let ((secret (plist-get found :secret)))
289 (if (functionp secret) 293 (if (functionp secret)
290 (funcall secret) 294 (funcall secret)
291 secret))) 295 secret))
296 (plist-get found :save-function))
292 nil))) 297 nil)))
293 298
294(defun nnimap-keepalive () 299(defun nnimap-keepalive ()
@@ -335,6 +340,7 @@ textual parts.")
335 (ports 340 (ports
336 (cond 341 (cond
337 ((or (eq nnimap-stream 'network) 342 ((or (eq nnimap-stream 'network)
343 (eq nnimap-stream 'network-only)
338 (eq nnimap-stream 'starttls)) 344 (eq nnimap-stream 'starttls))
339 (nnheader-message 7 "Opening connection to %s..." 345 (nnheader-message 7 "Opening connection to %s..."
340 nnimap-address) 346 nnimap-address)
@@ -396,7 +402,12 @@ textual parts.")
396 (let ((nnimap-inhibit-logging t)) 402 (let ((nnimap-inhibit-logging t))
397 (setq login-result 403 (setq login-result
398 (nnimap-login (car credentials) (cadr credentials)))) 404 (nnimap-login (car credentials) (cadr credentials))))
399 (unless (car login-result) 405 (if (car login-result)
406 ;; save the credentials if a save function exists
407 ;; (such a function will only be passed if a new
408 ;; token was created)
409 (when (functionp (nth 2 credentials))
410 (funcall (nth 2 credentials)))
400 ;; If the login failed, then forget the credentials 411 ;; If the login failed, then forget the credentials
401 ;; that are now possibly cached. 412 ;; that are now possibly cached.
402 (dolist (host (list (nnoo-current-server 'nnimap) 413 (dolist (host (list (nnoo-current-server 'nnimap)
@@ -1442,6 +1453,11 @@ textual parts.")
1442 ;; Change \Delete etc to %Delete, so that the reader can read it. 1453 ;; Change \Delete etc to %Delete, so that the reader can read it.
1443 (subst-char-in-region (point-min) (point-max) 1454 (subst-char-in-region (point-min) (point-max)
1444 ?\\ ?% t) 1455 ?\\ ?% t)
1456 ;; Remove any MODSEQ entries in the buffer, because they may contain
1457 ;; numbers that are too large for 32-bit Emacsen.
1458 (while (re-search-forward " MODSEQ ([0-9]+)" nil t)
1459 (replace-match "" t t))
1460 (goto-char (point-min))
1445 (let (start end articles groups uidnext elems permanent-flags 1461 (let (start end articles groups uidnext elems permanent-flags
1446 uidvalidity vanished highestmodseq) 1462 uidvalidity vanished highestmodseq)
1447 (dolist (elem sequences) 1463 (dolist (elem sequences)
@@ -1481,9 +1497,9 @@ textual parts.")
1481 (match-string 1))) 1497 (match-string 1)))
1482 (goto-char start) 1498 (goto-char start)
1483 (setq highestmodseq 1499 (setq highestmodseq
1484 (and (search-forward "HIGHESTMODSEQ " 1500 (and (re-search-forward "HIGHESTMODSEQ \\([0-9]+\\)"
1485 (or end (point-min)) t) 1501 (or end (point-min)) t)
1486 (read (current-buffer)))) 1502 (match-string 1)))
1487 (goto-char end) 1503 (goto-char end)
1488 (forward-line -1)) 1504 (forward-line -1))
1489 ;; The UID FETCH FLAGS was successful. 1505 ;; The UID FETCH FLAGS was successful.
@@ -1497,18 +1513,7 @@ textual parts.")
1497 (goto-char end)) 1513 (goto-char end))
1498 (while (re-search-forward "^\\* [0-9]+ FETCH " start t) 1514 (while (re-search-forward "^\\* [0-9]+ FETCH " start t)
1499 (let ((p (point))) 1515 (let ((p (point)))
1500 ;; FIXME: For FETCH lines like "* 2971 FETCH (FLAGS (%Recent) UID 1516 (setq elems (read (current-buffer)))
1501 ;; 12509 MODSEQ (13419098521433281274))" we get an
1502 ;; overflow-error. The handler simply deletes that large number
1503 ;; and reads again. But maybe there's a better fix...
1504 (setq elems (condition-case nil (read (current-buffer))
1505 (overflow-error
1506 ;; After an overflow-error, point is just after
1507 ;; the too large number. So delete it and try
1508 ;; again.
1509 (delete-region (point) (progn (backward-word) (point)))
1510 (goto-char p)
1511 (read (current-buffer)))))
1512 (push (cons (cadr (memq 'UID elems)) 1517 (push (cons (cadr (memq 'UID elems))
1513 (cadr (memq 'FLAGS elems))) 1518 (cadr (memq 'FLAGS elems)))
1514 articles))) 1519 articles)))
@@ -1545,10 +1550,11 @@ textual parts.")
1545 refid refid value))))) 1550 refid refid value)))))
1546 (result (with-current-buffer (nnimap-buffer) 1551 (result (with-current-buffer (nnimap-buffer)
1547 (nnimap-command "UID SEARCH %s" cmd)))) 1552 (nnimap-command "UID SEARCH %s" cmd))))
1548 (gnus-fetch-headers 1553 (when result
1549 (and (car result) (delete 0 (mapcar #'string-to-number 1554 (gnus-fetch-headers
1550 (cdr (assoc "SEARCH" (cdr result)))))) 1555 (and (car result) (delete 0 (mapcar #'string-to-number
1551 nil t))) 1556 (cdr (assoc "SEARCH" (cdr result))))))
1557 nil t))))
1552 1558
1553(defun nnimap-possibly-change-group (group server) 1559(defun nnimap-possibly-change-group (group server)
1554 (let ((open-result t)) 1560 (let ((open-result t))
@@ -1663,6 +1669,8 @@ textual parts.")
1663 (goto-char (point-max))) 1669 (goto-char (point-max)))
1664 openp) 1670 openp)
1665 (quit 1671 (quit
1672 (when debug-on-quit
1673 (debug "Quit"))
1666 ;; The user hit C-g while we were waiting: kill the process, in case 1674 ;; The user hit C-g while we were waiting: kill the process, in case
1667 ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind 1675 ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind
1668 ;; NAT routers). 1676 ;; NAT routers).
@@ -1754,11 +1762,15 @@ textual parts.")
1754 (format "(UID %s%s)" 1762 (format "(UID %s%s)"
1755 (format 1763 (format
1756 (if (nnimap-ver4-p) 1764 (if (nnimap-ver4-p)
1757 "BODY.PEEK[HEADER] BODY.PEEK" 1765 "BODY.PEEK"
1758 "RFC822.PEEK")) 1766 "RFC822.PEEK"))
1759 (if nnimap-split-download-body-default 1767 (cond
1760 "[]" 1768 (nnimap-split-download-body-default
1761 "[1]"))) 1769 "[]")
1770 ((nnimap-ver4-p)
1771 "[HEADER]")
1772 (t
1773 "[1]"))))
1762 t)) 1774 t))
1763 1775
1764(defun nnimap-split-incoming-mail () 1776(defun nnimap-split-incoming-mail ()
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index bb9695ebb72..113137a0046 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -53,17 +53,17 @@ fit these criteria."
53 :group 'shr 53 :group 'shr
54 :type 'regexp) 54 :type 'regexp)
55 55
56(defcustom shr-table-horizontal-line ?- 56(defcustom shr-table-horizontal-line ?
57 "Character used to draw horizontal table lines." 57 "Character used to draw horizontal table lines."
58 :group 'shr 58 :group 'shr
59 :type 'character) 59 :type 'character)
60 60
61(defcustom shr-table-vertical-line ?| 61(defcustom shr-table-vertical-line ?
62 "Character used to draw vertical table lines." 62 "Character used to draw vertical table lines."
63 :group 'shr 63 :group 'shr
64 :type 'character) 64 :type 'character)
65 65
66(defcustom shr-table-corner ?+ 66(defcustom shr-table-corner ?
67 "Character used to draw table corners." 67 "Character used to draw table corners."
68 :group 'shr 68 :group 'shr
69 :type 'character) 69 :type 'character)
@@ -113,6 +113,15 @@ cid: URL as the argument.")
113 113
114;; Public functions and commands. 114;; Public functions and commands.
115 115
116(defun shr-visit-file (file)
117 (interactive "fHTML file name: ")
118 (pop-to-buffer "*html*")
119 (erase-buffer)
120 (shr-insert-document
121 (with-temp-buffer
122 (insert-file-contents file)
123 (libxml-parse-html-region (point-min) (point-max)))))
124
116;;;###autoload 125;;;###autoload
117(defun shr-insert-document (dom) 126(defun shr-insert-document (dom)
118 (setq shr-content-cache nil) 127 (setq shr-content-cache nil)
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index c9a0df20590..5c2e775a211 100644
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -275,9 +275,10 @@ Valid states are `closed', `initial', `nonauth', and `auth'.")
275 (with-current-buffer buffer 275 (with-current-buffer buffer
276 (let* ((auth-info (auth-source-search :host sieve-manage-server 276 (let* ((auth-info (auth-source-search :host sieve-manage-server
277 :port "sieve" 277 :port "sieve"
278 :max 1)) 278 :max 1
279 (user-name (plist-get (nth 0 auth-info) :user)) 279 :create t))
280 (user-password (plist-get (nth 0 auth-info) :secret)) 280 (user-name (or (plist-get (nth 0 auth-info) :user) ""))
281 (user-password (or (plist-get (nth 0 auth-info) :secret) ""))
281 (user-password (if (functionp user-password) 282 (user-password (if (functionp user-password)
282 (funcall user-password) 283 (funcall user-password)
283 user-password)) 284 user-password))
generated by cgit v1.2.1 (git 2.18.0) at 2026-03-25 14:06:25 +0000