Merge changes made in Gnus trunk.
nndraft.el (nndraft-request-expire-articles): Use the group name instead if "nndraft". gnus.texi (Using IMAP): Remove the @acronyms from the headings. nnregistry.el: Added. nnimap.el (nnimap-insert-partial-structure): Be way more permissive when interpreting the structures. GNUS-NEWS: Minor error in GNUS-NEWS - password-cache.el. nnimap.el (nnimap-request-accept-article): Add \r\n to the lines to make this work with Cyrus. gnus-registry.el: Don't prompt on load, which makes it impossible to build Gnus. gnus-gravatar.el: Add gnus-gravatar-properties. gnus-agent.el, gnus-art.el, gnus-bookmark.el, gnus-dired.el, gnus-group.el,\ gnus-int.el, gnus-msg.el, gnus-registry.el, gnus-score.el, gnus-srvr.el,\ gnus-sum.el, gnus-topic.el, gnus-util.el, gnus.el, mm-decode.el, mm-util.el,\ mm-view.el, mml-smime.el, mml.el, nnmairix.el, nnrss.el, smime.el:\ Introduce gnus-completing-read. gnus-util.el: Make completing-read function configurable. gnus-util.el: Add requires and fix history for iswitchb. webmail.el: Remove netscape/my-deja, since they no longer exist. gnus.el (gnus-local-domain): Declare variable obsolete. nnimap.el (nnimap-insert-partial-structure): Get the type from the correct slot, too. pop3.el (pop3-send-streaming-command, pop3-stream-length): New variable. nnimap.el (nnimap-open-connection): Revert the auto-network->starttls code. nnimap.el (nnimap-request-set-mark): Erase the buffer before issuing commands. nnimap.el (nnimap-split-rule): Mark as obsolete. gnus-sum.el (gnus-valid-move-group-p): Make sure that `group' is a symbol. nnimap.el (nnimap-split-incoming-mail): Allow `default' as nnimap-split-methods value. nnimap.el (nnimap-request-article): Downcase the NILs so that they are nil. nndoc.el (nndoc-retrieve-groups): New function. gnus.texi: Fix Gravatar documentation.
This commit is contained in:
Gnus developers
Katsumi Yamaoka
parent
968ef9b4da
commit
229b59da36
32 changed files with 368 additions and 639 deletions
|
|
@ -629,7 +629,7 @@ Select Methods
|
|||
|
||||
* Server Buffer:: Making and editing virtual servers.
|
||||
* Getting News:: Reading USENET news with Gnus.
|
||||
* Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}.
|
||||
* Using IMAP:: Reading mail from @acronym{IMAP}.
|
||||
* Getting Mail:: Reading your personal mail with Gnus.
|
||||
* Browsing the Web:: Getting messages from a plethora of Web sources.
|
||||
* Other Sources:: Reading directories, files.
|
||||
|
|
@ -10797,7 +10797,7 @@ article is to use Muttprint (@pxref{Saving Articles}).
|
|||
@item A C
|
||||
@vindex gnus-fetch-partial-articles
|
||||
@findex gnus-summary-show-complete-article
|
||||
If @code{gnus-fetch-partial-articles} is non-@code{nil}, Gnus will
|
||||
If @code{<backend>-fetch-partial-articles} is non-@code{nil}, Gnus will
|
||||
fetch partial articles, if the backend it fetches them from supports
|
||||
it. Currently only @code{nnimap} does. If you're looking at a
|
||||
partial article, and want to see the complete article instead, then
|
||||
|
|
@ -13700,7 +13700,7 @@ The different methods all have their peculiarities, of course.
|
|||
@menu
|
||||
* Server Buffer:: Making and editing virtual servers.
|
||||
* Getting News:: Reading USENET news with Gnus.
|
||||
* Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}.
|
||||
* Using IMAP:: Reading mail from @acronym{IMAP}.
|
||||
* Getting Mail:: Reading your personal mail with Gnus.
|
||||
* Browsing the Web:: Getting messages from a plethora of Web sources.
|
||||
* Other Sources:: Reading directories, files.
|
||||
|
|
@ -14787,8 +14787,8 @@ there.
|
|||
@end table
|
||||
|
||||
|
||||
@node Using @acronym{IMAP}
|
||||
@section Using @acronym{IMAP}
|
||||
@node Using IMAP
|
||||
@section Using IMAP
|
||||
@cindex imap
|
||||
|
||||
The most popular mail backend is probably @code{nnimap}, which
|
||||
|
|
@ -14798,14 +14798,14 @@ This means that it's a convenient choice when you're reading your mail
|
|||
from different locations, or with different user agents.
|
||||
|
||||
@menu
|
||||
* Connecting to an @acronym{IMAP} Server:: Getting started with @acronym{IMAP}.
|
||||
* Customizing the @acronym{IMAP} Connection:: Variables for @acronym{IMAP} connection.
|
||||
* Client-Side @acronym{IMAP} Splitting:: Put mail in the correct mail box.
|
||||
* Connecting to an IMAP Server:: Getting started with @acronym{IMAP}.
|
||||
* Customizing the IMAP Connection:: Variables for @acronym{IMAP} connection.
|
||||
* Client-Side IMAP Splitting:: Put mail in the correct mail box.
|
||||
@end menu
|
||||
|
||||
|
||||
@node Connecting to an @acronym{IMAP} Server
|
||||
@subsection Connecting to an @acronym{IMAP} Server
|
||||
@node Connecting to an IMAP Server
|
||||
@subsection Connecting to an IMAP Server
|
||||
|
||||
Connecting to an @acronym{IMAP} can be very easy. Type @kbd{B} in the
|
||||
group buffer, or (if your primary interest is reading email), say
|
||||
|
|
@ -14826,15 +14826,15 @@ machine imap.gmail.com login <username> password <password> port imap
|
|||
That should basically be it for most users.
|
||||
|
||||
|
||||
@node Customizing the @acronym{IMAP} Connection
|
||||
@subsection Customizing the @acronym{IMAP} Connection
|
||||
@node Customizing the IMAP Connection
|
||||
@subsection Customizing the IMAP Connection
|
||||
|
||||
Here's an example method that's more complex:
|
||||
|
||||
@example
|
||||
(nnimap "imap.gmail.com"
|
||||
(nnimap-inbox "INBOX")
|
||||
(nnimap-split-methods ,nnmail-split-methods)
|
||||
(nnimap-split-methods default)
|
||||
(nnimap-expunge t)
|
||||
(nnimap-stream 'ssl)
|
||||
(nnir-search-engine imap)
|
||||
|
|
@ -14878,11 +14878,17 @@ this should be set to @code{anonymous}.
|
|||
Virtually all @code{IMAP} server support fast streaming of data. If
|
||||
you have problems connecting to the server, try setting this to @code{nil}.
|
||||
|
||||
@item nnimap-fetch-partial-articles
|
||||
If non-@code{nil}, fetch partial articles from the server. If set to
|
||||
a string, then it's interpreted as a regexp, and parts that have
|
||||
matching types will be fetched. For instance, @samp{"text/"} will
|
||||
fetch all textual parts, while leaving the rest on the server.
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
@node Client-Side @acronym{IMAP} Splitting
|
||||
@subsection Client-Side @acronym{IMAP} Splitting
|
||||
@node Client-Side IMAP Splitting
|
||||
@subsection Client-Side IMAP Splitting
|
||||
|
||||
Many people prefer to do the sorting/splitting of mail into their mail
|
||||
boxes on the @acronym{IMAP} server. That way they don't have to
|
||||
|
|
@ -14897,7 +14903,8 @@ This is the @acronym{IMAP} mail box that will be scanned for new mail.
|
|||
|
||||
@item nnimap-split-methods
|
||||
Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting
|
||||
Mail}).
|
||||
Mail}), except the symbol @code{default}, which means that it should
|
||||
use the value of the @code{nnmail-split-methods} variable.
|
||||
|
||||
@end table
|
||||
|
||||
|
|
@ -15460,7 +15467,7 @@ Get mail from a @acronym{IMAP} server. If you don't want to use
|
|||
@acronym{IMAP} as intended, as a network mail reading protocol (ie
|
||||
with nnimap), for some reason or other, Gnus let you treat it similar
|
||||
to a @acronym{POP} server and fetches articles from a given
|
||||
@acronym{IMAP} mailbox. @xref{Using @acronym{IMAP}}, for more information.
|
||||
@acronym{IMAP} mailbox. @xref{Using IMAP}, for more information.
|
||||
|
||||
Keywords:
|
||||
|
||||
|
|
@ -15929,7 +15936,7 @@ after @code{save-excursion} and @code{save-restriction} in the example
|
|||
above. Also note that with the nnimap backend, message bodies will
|
||||
not be downloaded by default. You need to set
|
||||
@code{nnimap-split-download-body} to @code{t} to do that
|
||||
(@pxref{Client-Side @acronym{IMAP} Splitting}).
|
||||
(@pxref{Client-Side IMAP Splitting}).
|
||||
|
||||
@item (! @var{func} @var{split})
|
||||
If the split is a list, and the first element is @code{!}, then
|
||||
|
|
@ -23263,12 +23270,9 @@ The following variables offer control over how things are displayed.
|
|||
The size in pixels of gravatars. Gravatars are always square, so one
|
||||
number for the size is enough.
|
||||
|
||||
@item gnus-gravatar-relief
|
||||
@vindex gnus-gravatar-relief
|
||||
If non-nil, adds a shadow rectangle around the image. The value,
|
||||
relief, specifies the width of the shadow lines, in pixels. If relief
|
||||
is negative, shadows are drawn so that the image appears as a pressed
|
||||
button; otherwise, it appears as an unpressed button.
|
||||
@item gnus-gravatar-properties
|
||||
@vindex gnus-gravatar-properties
|
||||
List of image properties applied to Gravatar images.
|
||||
|
||||
@end table
|
||||
|
||||
|
|
@ -23618,7 +23622,7 @@ call the external tools during splitting. Example fancy split method:
|
|||
Note that with the nnimap back end, message bodies will not be
|
||||
downloaded by default. You need to set
|
||||
@code{nnimap-split-download-body} to @code{t} to do that
|
||||
(@pxref{Client-Side @acronym{IMAP} Splitting}).
|
||||
(@pxref{Client-Side IMAP Splitting}).
|
||||
|
||||
That is about it. As some spam is likely to get through anyway, you
|
||||
might want to have a nifty function to call when you happen to read
|
||||
|
|
@ -23907,7 +23911,7 @@ the message headers; @code{nnimap-split-download-body} tells it to
|
|||
retrieve the message bodies as well. We don't set this by default
|
||||
because it will slow @acronym{IMAP} down, and that is not an
|
||||
appropriate decision to make on behalf of the user. @xref{Client-Side
|
||||
@acronym{IMAP} Splitting}.
|
||||
IMAP Splitting}.
|
||||
|
||||
You have to specify one or more spam back ends for @code{spam-split}
|
||||
to use, by setting the @code{spam-use-*} variables. @xref{Spam Back
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@ support for DIGEST-MD5 and NTLM. *Note Emacs SASL: (sasl)Top.
|
|||
The primary change this brings is support for DIGEST-MD5 and NTLM, when
|
||||
the server supports it.
|
||||
|
||||
** Gnus includes a password cache mechanism in password.el.
|
||||
** Gnus includes a password cache mechanism in password-cache.el.
|
||||
|
||||
It is enabled by default (see `password-cache'), with a short timeout of
|
||||
16 seconds (see `password-cache-expiry'). If PGG is used as the PGP
|
||||
|
|
|
|||
|
|
@ -459,10 +459,7 @@ manipulated as follows:
|
|||
(let ((def (or (gnus-group-group-name) gnus-newsgroup-name)))
|
||||
(when def
|
||||
(setq def (gnus-group-decoded-name def)))
|
||||
(gnus-group-completing-read (if def
|
||||
(concat "Group Name (" def "): ")
|
||||
"Group Name: ")
|
||||
nil nil t nil nil def)))
|
||||
(gnus-group-completing-read nil nil t nil nil def)))
|
||||
|
||||
;;; Fetching setup functions.
|
||||
|
||||
|
|
@ -816,9 +813,9 @@ be a select method."
|
|||
(interactive
|
||||
(list
|
||||
(intern
|
||||
(completing-read
|
||||
"Add to category: "
|
||||
(mapcar (lambda (cat) (list (symbol-name (car cat))))
|
||||
(gnus-completing-read
|
||||
"Add to category"
|
||||
(mapcar (lambda (cat) (symbol-name (car cat)))
|
||||
gnus-category-alist)
|
||||
nil t))
|
||||
current-prefix-arg))
|
||||
|
|
|
|||
|
|
@ -5131,11 +5131,10 @@ available media-types."
|
|||
(unless mime-type
|
||||
(setq mime-type
|
||||
(let ((default (gnus-mime-view-part-as-type-internal)))
|
||||
(completing-read
|
||||
(format "View as MIME type (default %s): "
|
||||
(car default))
|
||||
(mapcar #'list (mailcap-mime-types))
|
||||
pred nil nil nil
|
||||
(gnus-completing-read
|
||||
"View as MIME type"
|
||||
(remove-if-not pred (mailcap-mime-types))
|
||||
nil nil nil
|
||||
(car default)))))
|
||||
(gnus-article-check-buffer)
|
||||
(let ((handle (get-text-property (point) 'gnus-data)))
|
||||
|
|
@ -5404,7 +5403,7 @@ If no internal viewer is available, use an external viewer."
|
|||
(defun gnus-mime-action-on-part (&optional action)
|
||||
"Do something with the MIME attachment at \(point\)."
|
||||
(interactive
|
||||
(list (completing-read "Action: " gnus-mime-action-alist nil t)))
|
||||
(list (gnus-completing-read "Action" (mapcar 'car gnus-mime-action-alist) t)))
|
||||
(gnus-article-check-buffer)
|
||||
(let ((action-pair (assoc action gnus-mime-action-alist)))
|
||||
(if action-pair
|
||||
|
|
@ -8370,9 +8369,9 @@ For example:
|
|||
(interactive
|
||||
(list
|
||||
(or gnus-article-encrypt-protocol
|
||||
(completing-read "Encrypt protocol: "
|
||||
gnus-article-encrypt-protocol-alist
|
||||
nil t))
|
||||
(gnus-completing-read "Encrypt protocol"
|
||||
(mapcar 'car gnus-article-encrypt-protocol-alist)
|
||||
t))
|
||||
current-prefix-arg))
|
||||
;; User might hit `K E' instead of `K e', so prompt once.
|
||||
(when (and gnus-article-encrypt-protocol
|
||||
|
|
|
|||
|
|
@ -289,8 +289,8 @@ So the cdr of each bookmark is an alist too.")
|
|||
(interactive)
|
||||
(gnus-bookmark-maybe-load-default-file)
|
||||
(let* ((bookmark (or bmk-name
|
||||
(completing-read "Jump to bookmarked article: "
|
||||
gnus-bookmark-alist)))
|
||||
(gnus-completing-read "Jump to bookmarked article"
|
||||
(mapcar 'car gnus-bookmark-alist))))
|
||||
(bmk-record (cadr (assoc bookmark gnus-bookmark-alist)))
|
||||
(group (cdr (assoc 'group bmk-record)))
|
||||
(message-id (cdr (assoc 'message-id bmk-record))))
|
||||
|
|
|
|||
|
|
@ -368,11 +368,11 @@ If ARG (or prefix) is non-nil, force prompting for all fields."
|
|||
header ": ")))
|
||||
(setq value
|
||||
(if (listp (nth 1 head))
|
||||
(completing-read prompt (cons '("*" nil) (nth 1 head))
|
||||
nil t value
|
||||
gnus-diary-header-value-history)
|
||||
(gnus-completing-read prompt (cons '("*" nil) (nth 1 head))
|
||||
t value
|
||||
'gnus-diary-header-value-history)
|
||||
(read-string prompt value
|
||||
gnus-diary-header-value-history))))
|
||||
'gnus-diary-header-value-history))))
|
||||
(setq ask nil)
|
||||
(setq invalid nil)
|
||||
(condition-case ()
|
||||
|
|
|
|||
|
|
@ -152,12 +152,8 @@ filenames."
|
|||
(setq destination
|
||||
(if (= (length bufs) 1)
|
||||
(get-buffer (car bufs))
|
||||
(completing-read "Attach to which mail composition buffer: "
|
||||
(mapcar
|
||||
(lambda (b)
|
||||
(cons b (get-buffer b)))
|
||||
bufs)
|
||||
nil t)))
|
||||
(gnus-completing-read "Attach to which mail composition buffer"
|
||||
bufs t)))
|
||||
;; setup a new mail composition buffer
|
||||
(let ((mail-user-agent gnus-dired-mail-mode)
|
||||
;; A workaround to prevent Gnus from displaying the Gnus
|
||||
|
|
|
|||
|
|
@ -33,14 +33,13 @@
|
|||
(defcustom gnus-gravatar-size 32
|
||||
"How big should gravatars be displayed."
|
||||
:type 'integer
|
||||
:version "24.1"
|
||||
:group 'gnus-gravatar)
|
||||
|
||||
(defcustom gnus-gravatar-relief 1
|
||||
"If non-nil, adds a shadow rectangle around the image. The
|
||||
value, relief, specifies the width of the shadow lines, in
|
||||
pixels. If relief is negative, shadows are drawn so that the
|
||||
image appears as a pressed button; otherwise, it appears as an
|
||||
unpressed button."
|
||||
(defcustom gnus-gravatar-properties '(:ascent center :relief 1)
|
||||
"List of image properties applied to Gravatar images."
|
||||
:type 'list
|
||||
:version "24.1"
|
||||
:group 'gnus-gravatar)
|
||||
|
||||
(defun gnus-gravatar-transform-address (header category)
|
||||
|
|
@ -88,7 +87,7 @@ Set image category to CATEGORY."
|
|||
(point (point))
|
||||
(gravatar (append
|
||||
gravatar
|
||||
`(:ascent center :relief ,gnus-gravatar-relief))))
|
||||
gnus-gravatar-properties)))
|
||||
(gnus-put-image gravatar nil category)
|
||||
(put-text-property point (point) 'gnus-gravatar address)
|
||||
(gnus-add-wash-type category)
|
||||
|
|
|
|||
|
|
@ -2164,44 +2164,35 @@ be permanent."
|
|||
group)))
|
||||
(goto-char start)))))
|
||||
|
||||
(defun gnus-group-completing-read (prompt &optional collection predicate
|
||||
require-match initial-input hist def
|
||||
&rest args)
|
||||
(defun gnus-group-completing-read (&optional prompt collection
|
||||
require-match initial-input hist def)
|
||||
"Read a group name with completion. Non-ASCII group names are allowed.
|
||||
The arguments are the same as `completing-read' except that COLLECTION
|
||||
and HIST default to `gnus-active-hashtb' and `gnus-group-history'
|
||||
respectively if they are omitted."
|
||||
(let ((completion-styles (and (boundp 'completion-styles)
|
||||
completion-styles))
|
||||
group)
|
||||
(push 'substring completion-styles)
|
||||
(mapatoms (lambda (symbol)
|
||||
(setq group (symbol-name symbol))
|
||||
(set (intern (if (string-match "[^\000-\177]" group)
|
||||
(gnus-group-decoded-name group)
|
||||
group)
|
||||
collection)
|
||||
group))
|
||||
(prog1
|
||||
(or collection
|
||||
(setq collection (or gnus-active-hashtb [0])))
|
||||
(setq collection (gnus-make-hashtable (length collection)))))
|
||||
(setq group (apply 'completing-read prompt collection predicate
|
||||
require-match initial-input
|
||||
(or hist 'gnus-group-history)
|
||||
def args))
|
||||
(or (prog1
|
||||
(symbol-value (intern-soft group collection))
|
||||
(setq collection nil))
|
||||
(mm-encode-coding-string group (gnus-group-name-charset nil group)))))
|
||||
(let* ((choices (mapcar (lambda (symbol)
|
||||
(let ((group (symbol-name symbol)))
|
||||
(if (string-match "[^\000-\177]" group)
|
||||
(gnus-group-decoded-name group)
|
||||
group)))
|
||||
(remove-if-not
|
||||
'symbolp
|
||||
(or collection (or gnus-active-hashtb [0])))))
|
||||
(group
|
||||
(gnus-completing-read (or prompt "Group") choices
|
||||
require-match initial-input
|
||||
(or hist 'gnus-group-history)
|
||||
def)))
|
||||
(or (symbol-value (intern-soft group collection))
|
||||
(mm-encode-coding-string group (gnus-group-name-charset nil group)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun gnus-fetch-group (group &optional articles)
|
||||
"Start Gnus if necessary and enter GROUP.
|
||||
If ARTICLES, display those articles.
|
||||
Returns whether the fetching was successful or not."
|
||||
(interactive (list (gnus-group-completing-read "Group name: "
|
||||
nil nil nil
|
||||
(interactive (list (gnus-group-completing-read nil
|
||||
nil nil
|
||||
(gnus-group-name-at-point))))
|
||||
(unless (gnus-alive-p)
|
||||
(gnus-no-server))
|
||||
|
|
@ -2261,7 +2252,7 @@ Return the name of the group if selection was successful."
|
|||
(interactive
|
||||
(list
|
||||
;; (gnus-read-group "Group name: ")
|
||||
(gnus-group-completing-read "Group: ")
|
||||
(gnus-group-completing-read)
|
||||
(gnus-read-method "From method: ")))
|
||||
;; Transform the select method into a unique server.
|
||||
(when (stringp method)
|
||||
|
|
@ -2328,7 +2319,7 @@ specified by `gnus-gmane-group-download-format'."
|
|||
;; See <http://gmane.org/export.php> for more information.
|
||||
(interactive
|
||||
(list
|
||||
(gnus-group-completing-read "Gmane group: ")
|
||||
(gnus-group-completing-read "Gmane group")
|
||||
(read-number "Start article number: ")
|
||||
(read-number "How many articles: ")))
|
||||
(unless range (setq range 500))
|
||||
|
|
@ -2362,7 +2353,7 @@ Valid input formats include:
|
|||
;; prompt the user to decide: "View via `browse-url' or in Gnus? "
|
||||
;; (`gnus-read-ephemeral-gmane-group-url')
|
||||
(interactive
|
||||
(list (gnus-group-completing-read "Gmane URL: ")))
|
||||
(list (gnus-group-completing-read "Gmane URL")))
|
||||
(let (group start range)
|
||||
(cond
|
||||
;; URLs providing `group', `start' and `range':
|
||||
|
|
@ -2456,13 +2447,13 @@ If PROMPT (the prefix) is a number, use the prompt specified in
|
|||
`gnus-group-jump-to-group-prompt'."
|
||||
(interactive
|
||||
(list (gnus-group-completing-read
|
||||
"Group: " nil nil (gnus-read-active-file-p)
|
||||
(if current-prefix-arg
|
||||
(cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
|
||||
(or (and (stringp gnus-group-jump-to-group-prompt)
|
||||
gnus-group-jump-to-group-prompt)
|
||||
(let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
|
||||
(and (stringp p) p)))))))
|
||||
nil nil (gnus-read-active-file-p)
|
||||
(if current-prefix-arg
|
||||
(cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
|
||||
(or (and (stringp gnus-group-jump-to-group-prompt)
|
||||
gnus-group-jump-to-group-prompt)
|
||||
(let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
|
||||
(and (stringp p) p)))))))
|
||||
|
||||
(when (equal group "")
|
||||
(error "Empty group name"))
|
||||
|
|
@ -2653,7 +2644,7 @@ If EXCLUDE-GROUP, do not go to that group."
|
|||
(defun gnus-group-make-group-simple (&optional group)
|
||||
"Add a new newsgroup.
|
||||
The user will be prompted for GROUP."
|
||||
(interactive (list (gnus-group-completing-read "Group: ")))
|
||||
(interactive (list (gnus-group-completing-read)))
|
||||
(gnus-group-make-group (gnus-group-real-name group)
|
||||
(gnus-group-server group)
|
||||
nil nil t))
|
||||
|
|
@ -2912,8 +2903,9 @@ and NEW-NAME will be prompted for."
|
|||
(defun gnus-group-make-useful-group (group method)
|
||||
"Create one of the groups described in `gnus-useful-groups'."
|
||||
(interactive
|
||||
(let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
|
||||
nil t)
|
||||
(let ((entry (assoc (gnus-completing-read "Create group"
|
||||
(mapcar 'car gnus-useful-groups)
|
||||
t)
|
||||
gnus-useful-groups)))
|
||||
(list (cadr entry)
|
||||
;; Don't use `caddr' here since macros within the `interactive'
|
||||
|
|
@ -3005,11 +2997,11 @@ If SOLID (the prefix), create a solid group."
|
|||
(symbol-name (caar nnweb-type-definition))))
|
||||
(type
|
||||
(gnus-string-or
|
||||
(completing-read
|
||||
(format "Search engine type (default %s): " default-type)
|
||||
(mapcar (lambda (elem) (list (symbol-name (car elem))))
|
||||
(gnus-completing-read
|
||||
"Search engine type"
|
||||
(mapcar (lambda (elem) (symbol-name (car elem)))
|
||||
nnweb-type-definition)
|
||||
nil t nil 'gnus-group-web-type-history)
|
||||
t nil 'gnus-group-web-type-history)
|
||||
default-type))
|
||||
(search
|
||||
(read-string
|
||||
|
|
@ -3100,8 +3092,8 @@ mail messages or news articles in files that have numeric names."
|
|||
"Add the current group to a virtual group."
|
||||
(interactive
|
||||
(list current-prefix-arg
|
||||
(completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
|
||||
"nnvirtual:")))
|
||||
(gnus-group-completing-read "Add to virtual group"
|
||||
nil t "nnvirtual:")))
|
||||
(unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
|
||||
(error "%s is not an nnvirtual group" vgroup))
|
||||
(gnus-close-group vgroup)
|
||||
|
|
@ -3672,7 +3664,7 @@ If given numerical prefix, toggle the N next groups."
|
|||
Killed newsgroups are subscribed. If SILENT, don't try to update the
|
||||
group line."
|
||||
(interactive (list (gnus-group-completing-read
|
||||
"Group: " nil nil (gnus-read-active-file-p))))
|
||||
nil (gnus-read-active-file-p))))
|
||||
(let ((newsrc (gnus-group-entry group)))
|
||||
(cond
|
||||
((string-match "^[ \t]*$" group)
|
||||
|
|
@ -4013,7 +4005,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
|
|||
If given a prefix argument, prompt for a group."
|
||||
(interactive
|
||||
(list (or (when current-prefix-arg
|
||||
(gnus-group-completing-read "Group: "))
|
||||
(gnus-group-completing-read))
|
||||
(gnus-group-group-name)
|
||||
gnus-newsgroup-name)))
|
||||
(unless group
|
||||
|
|
@ -4314,18 +4306,18 @@ If called interactively, this function will ask for a select method
|
|||
If not, METHOD should be a list where the first element is the method
|
||||
and the second element is the address."
|
||||
(interactive
|
||||
(list (let ((how (completing-read
|
||||
"Which back end: "
|
||||
(append gnus-valid-select-methods gnus-server-alist)
|
||||
nil t (cons "nntp" 0) 'gnus-method-history)))
|
||||
(list (let ((how (gnus-completing-read
|
||||
"Which back end"
|
||||
(mapcar 'car (append gnus-valid-select-methods gnus-server-alist))
|
||||
t (cons "nntp" 0) 'gnus-method-history)))
|
||||
;; We either got a back end name or a virtual server name.
|
||||
;; If the first, we also need an address.
|
||||
(if (assoc how gnus-valid-select-methods)
|
||||
(list (intern how)
|
||||
;; Suggested by mapjph@bath.ac.uk.
|
||||
(completing-read
|
||||
"Address: "
|
||||
(mapcar 'list gnus-secondary-servers)))
|
||||
(gnus-completing-read
|
||||
"Address"
|
||||
gnus-secondary-servers))
|
||||
;; We got a server name.
|
||||
how))))
|
||||
(gnus-browse-foreign-server method))
|
||||
|
|
|
|||
|
|
@ -94,11 +94,10 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
|
|||
(when confirm
|
||||
;; Read server name with completion.
|
||||
(setq gnus-nntp-server
|
||||
(completing-read "NNTP server: "
|
||||
(mapcar 'list
|
||||
(cons (list gnus-nntp-server)
|
||||
gnus-secondary-servers))
|
||||
nil nil gnus-nntp-server)))
|
||||
(gnus-completing-read "NNTP server"
|
||||
(cons gnus-nntp-server
|
||||
gnus-secondary-servers)
|
||||
nil gnus-nntp-server)))
|
||||
|
||||
(when (and gnus-nntp-server
|
||||
(stringp gnus-nntp-server)
|
||||
|
|
|
|||
|
|
@ -578,8 +578,8 @@ If ARG is 1, prompt for a group name to find the posting style."
|
|||
(if arg
|
||||
(if (= 1 (prefix-numeric-value arg))
|
||||
(gnus-group-completing-read
|
||||
"Use posting style of group: "
|
||||
nil nil (gnus-read-active-file-p))
|
||||
"Use posting style of group"
|
||||
nil (gnus-read-active-file-p))
|
||||
(gnus-group-group-name))
|
||||
""))
|
||||
;; #### see comment in gnus-setup-message -- drv
|
||||
|
|
@ -607,8 +607,8 @@ network. The corresponding back end must have a 'request-post method."
|
|||
(setq gnus-newsgroup-name
|
||||
(if arg
|
||||
(if (= 1 (prefix-numeric-value arg))
|
||||
(gnus-group-completing-read "Use group: "
|
||||
nil nil
|
||||
(gnus-group-completing-read "Use group"
|
||||
nil
|
||||
(gnus-read-active-file-p))
|
||||
(gnus-group-group-name))
|
||||
""))
|
||||
|
|
@ -628,7 +628,7 @@ a news."
|
|||
(let ((gnus-newsgroup-name
|
||||
(if arg
|
||||
(if (= 1 (prefix-numeric-value arg))
|
||||
(gnus-group-completing-read "Newsgroup: " nil nil
|
||||
(gnus-group-completing-read "Newsgroup" nil
|
||||
(gnus-read-active-file-p))
|
||||
(gnus-group-group-name))
|
||||
""))
|
||||
|
|
@ -654,8 +654,8 @@ posting style."
|
|||
(setq gnus-newsgroup-name
|
||||
(if arg
|
||||
(if (= 1 (prefix-numeric-value arg))
|
||||
(gnus-group-completing-read "Use group: "
|
||||
nil nil
|
||||
(gnus-group-completing-read "Use group"
|
||||
nil
|
||||
(gnus-read-active-file-p))
|
||||
"")
|
||||
gnus-newsgroup-name))
|
||||
|
|
@ -684,8 +684,8 @@ network. The corresponding back end must have a 'request-post method."
|
|||
(setq gnus-newsgroup-name
|
||||
(if arg
|
||||
(if (= 1 (prefix-numeric-value arg))
|
||||
(gnus-group-completing-read "Use group: "
|
||||
nil nil
|
||||
(gnus-group-completing-read "Use group"
|
||||
nil
|
||||
(gnus-read-active-file-p))
|
||||
"")
|
||||
gnus-newsgroup-name))
|
||||
|
|
@ -710,7 +710,7 @@ a news."
|
|||
(let ((gnus-newsgroup-name
|
||||
(if arg
|
||||
(if (= 1 (prefix-numeric-value arg))
|
||||
(gnus-group-completing-read "Newsgroup: " nil nil
|
||||
(gnus-group-completing-read "Newsgroup" nil
|
||||
(gnus-read-active-file-p))
|
||||
"")
|
||||
gnus-newsgroup-name))
|
||||
|
|
@ -1028,8 +1028,8 @@ If SILENT, don't prompt the user."
|
|||
gnus-last-posting-server)
|
||||
;; Just use the last value.
|
||||
gnus-last-posting-server
|
||||
(completing-read
|
||||
"Posting method: " method-alist nil t
|
||||
(gnus-completing-read
|
||||
"Posting method" (mapcar 'car method-alist) t
|
||||
(cons (or gnus-last-posting-server "") 0))))
|
||||
method-alist))))
|
||||
;; Override normal method.
|
||||
|
|
@ -1487,7 +1487,7 @@ If YANK is non-nil, include the original article."
|
|||
(defun gnus-summary-yank-message (buffer n)
|
||||
"Yank the current article into a composed message."
|
||||
(interactive
|
||||
(list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
|
||||
(list (gnus-completing-read "Buffer" (message-buffers) t)
|
||||
current-prefix-arg))
|
||||
(gnus-summary-iterate n
|
||||
(let ((gnus-inhibit-treatment t))
|
||||
|
|
|
|||
|
|
@ -857,12 +857,11 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
|
|||
|
||||
(defun gnus-registry-read-mark ()
|
||||
"Read a mark name from the user with completion."
|
||||
(let ((mark (gnus-completing-read-with-default
|
||||
(symbol-name gnus-registry-default-mark)
|
||||
"Label"
|
||||
(mapcar (lambda (x) ; completion list
|
||||
(cons (symbol-name (car-safe x)) (car-safe x)))
|
||||
gnus-registry-marks))))
|
||||
(let ((mark (gnus-completing-read
|
||||
"Label"
|
||||
(mapcar 'symbol-name (mapcar 'car gnus-registry-marks))
|
||||
nil nil nil
|
||||
(symbol-name gnus-registry-default-mark))))
|
||||
(when (stringp mark)
|
||||
(intern mark))))
|
||||
|
||||
|
|
@ -1173,10 +1172,6 @@ Returns the first place where the trail finds a group name."
|
|||
;;; we could call it here: (customize-variable 'gnus-registry-install)
|
||||
gnus-registry-install)
|
||||
|
||||
(when (or (eq gnus-registry-install t)
|
||||
(gnus-registry-install-p))
|
||||
(gnus-registry-initialize))
|
||||
|
||||
;; TODO: a few things
|
||||
|
||||
(provide 'gnus-registry)
|
||||
|
|
|
|||
|
|
@ -680,14 +680,14 @@ file for the command instead of the current score file."
|
|||
(and gnus-extra-headers
|
||||
(equal (nth 1 entry) "extra")
|
||||
(intern ; need symbol
|
||||
(gnus-completing-read-with-default
|
||||
(symbol-name (car gnus-extra-headers)) ; default response
|
||||
"Score extra header" ; prompt
|
||||
(mapcar (lambda (x) ; completion list
|
||||
(cons (symbol-name x) x))
|
||||
gnus-extra-headers)
|
||||
nil ; no completion limit
|
||||
t)))) ; require match
|
||||
(let ((collection (mapcar 'symbol-name gnus-extra-headers)))
|
||||
(gnus-completing-read
|
||||
"Score extra header" ; prompt
|
||||
collection ; completion list
|
||||
t ; require match
|
||||
nil ; no history
|
||||
nil ; no initial-input
|
||||
(car collection)))))) ; default value
|
||||
;; extra is now nil or a symbol.
|
||||
|
||||
;; We have all the data, so we enter this score.
|
||||
|
|
@ -913,10 +913,13 @@ MATCH is the string we are looking for.
|
|||
TYPE is the score type.
|
||||
SCORE is the score to add.
|
||||
EXTRA is the possible non-standard header."
|
||||
(interactive (list (completing-read "Header: "
|
||||
gnus-header-index
|
||||
(lambda (x) (fboundp (nth 2 x)))
|
||||
t)
|
||||
(interactive (list (gnus-completing-read "Header"
|
||||
(mapcar
|
||||
'car
|
||||
(remove-if-not
|
||||
(lambda (x) (fboundp (nth 2 x)))
|
||||
gnus-header-index))
|
||||
t)
|
||||
(read-string "Match: ")
|
||||
(if (y-or-n-p "Use regexp match? ") 'r 's)
|
||||
(string-to-number (read-string "Score: "))))
|
||||
|
|
|
|||
|
|
@ -571,8 +571,9 @@ The following commands are available:
|
|||
|
||||
(defun gnus-server-add-server (how where)
|
||||
(interactive
|
||||
(list (intern (completing-read "Server method: "
|
||||
gnus-valid-select-methods nil t))
|
||||
(list (intern (gnus-completing-read "Server method"
|
||||
(mapcar 'car gnus-valid-select-methods)
|
||||
t))
|
||||
(read-string "Server name: ")))
|
||||
(when (assq where gnus-server-alist)
|
||||
(error "Server with that name already defined"))
|
||||
|
|
@ -582,7 +583,7 @@ The following commands are available:
|
|||
(defun gnus-server-goto-server (server)
|
||||
"Jump to a server line."
|
||||
(interactive
|
||||
(list (completing-read "Goto server: " gnus-server-alist nil t)))
|
||||
(list (gnus-completing-read "Goto server" (mapcar 'car gnus-server-alist) t)))
|
||||
(let ((to (text-property-any (point-min) (point-max)
|
||||
'gnus-server (intern server))))
|
||||
(when to
|
||||
|
|
|
|||
|
|
@ -7999,10 +7999,9 @@ If FORCE, go to the article even if it isn't displayed. If FORCE
|
|||
is a number, it is the line the article is to be displayed on."
|
||||
(interactive
|
||||
(list
|
||||
(completing-read
|
||||
"Article number or Message-ID: "
|
||||
(mapcar (lambda (number) (list (int-to-string number)))
|
||||
gnus-newsgroup-limit))
|
||||
(gnus-completing-read
|
||||
"Article number or Message-ID"
|
||||
(mapcar 'int-to-string gnus-newsgroup-limit))
|
||||
current-prefix-arg
|
||||
t))
|
||||
(prog1
|
||||
|
|
@ -8256,16 +8255,13 @@ articles that are younger than AGE days."
|
|||
(interactive
|
||||
(let ((header
|
||||
(intern
|
||||
(gnus-completing-read-with-default
|
||||
(symbol-name (car gnus-extra-headers))
|
||||
(gnus-completing-read
|
||||
(if current-prefix-arg
|
||||
"Exclude extra header"
|
||||
"Limit extra header")
|
||||
(mapcar (lambda (x)
|
||||
(cons (symbol-name x) x))
|
||||
gnus-extra-headers)
|
||||
nil
|
||||
t))))
|
||||
(mapcar 'symbol-name gnus-extra-headers)
|
||||
t nil nil
|
||||
(symbol-name (car gnus-extra-headers))))))
|
||||
(list header
|
||||
(read-string (format "%s header %s (regexp): "
|
||||
(if current-prefix-arg "Exclude" "Limit to")
|
||||
|
|
@ -9234,14 +9230,14 @@ If HEADER is an empty string (or nil), the match is done on the entire
|
|||
article. If BACKWARD (the prefix) is non-nil, search backward instead."
|
||||
(interactive
|
||||
(list (let ((completion-ignore-case t))
|
||||
(completing-read
|
||||
"Header name: "
|
||||
(mapcar (lambda (header) (list (format "%s" header)))
|
||||
(gnus-completing-read
|
||||
"Header name"
|
||||
(mapcar 'symbol-name
|
||||
(append
|
||||
'("Number" "Subject" "From" "Lines" "Date"
|
||||
"Message-ID" "Xref" "References" "Body")
|
||||
'(Number Subject From Lines Date
|
||||
Message-ID Xref References Body)
|
||||
gnus-extra-headers))
|
||||
nil 'require-match))
|
||||
'require-match))
|
||||
(read-string "Regexp: ")
|
||||
(read-key-sequence "Command: ")
|
||||
current-prefix-arg))
|
||||
|
|
@ -9937,9 +9933,9 @@ latter case, they will be copied into the relevant groups."
|
|||
(car (gnus-find-method-for-group
|
||||
gnus-newsgroup-name)))))
|
||||
(method
|
||||
(gnus-completing-read-with-default
|
||||
methname "Backend to use when respooling"
|
||||
methods nil t nil 'gnus-mail-method-history))
|
||||
(gnus-completing-read
|
||||
"Backend to use when respooling"
|
||||
methods t nil 'gnus-mail-method-history methname))
|
||||
ms)
|
||||
(cond
|
||||
((zerop (length (setq ms (gnus-servers-using-backend
|
||||
|
|
@ -9949,7 +9945,7 @@ latter case, they will be copied into the relevant groups."
|
|||
(car ms))
|
||||
(t
|
||||
(let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
|
||||
(cdr (assoc (completing-read "Server name: " ms-alist nil t)
|
||||
(cdr (assoc (gnus-completing-read "Server name" ms-alist t)
|
||||
ms-alist))))))))
|
||||
(unless method
|
||||
(error "No method given for respooling"))
|
||||
|
|
@ -11904,7 +11900,8 @@ save those articles instead."
|
|||
(nreverse split-name)))
|
||||
|
||||
(defun gnus-valid-move-group-p (group)
|
||||
(and (boundp group)
|
||||
(and (symbolp group)
|
||||
(boundp group)
|
||||
(symbol-name group)
|
||||
(symbol-value group)
|
||||
(gnus-get-function (gnus-find-method-for-group
|
||||
|
|
@ -11921,29 +11918,20 @@ save those articles instead."
|
|||
(format "these %d articles" (length articles))
|
||||
"this article")))
|
||||
(to-newsgroup
|
||||
(let (active group)
|
||||
(when (or (null split-name) (= 1 (length split-name)))
|
||||
(setq active (gnus-make-hashtable (length gnus-active-hashtb)))
|
||||
(mapatoms (lambda (symbol)
|
||||
(setq group (symbol-name symbol))
|
||||
(when (string-match "[^\000-\177]" group)
|
||||
(setq group (gnus-group-decoded-name group)))
|
||||
(set (intern group active) group))
|
||||
gnus-active-hashtb))
|
||||
(cond
|
||||
((null split-name)
|
||||
(gnus-completing-read-with-default
|
||||
default prom active 'gnus-valid-move-group-p nil prefix
|
||||
'gnus-group-history))
|
||||
((= 1 (length split-name))
|
||||
(gnus-completing-read-with-default
|
||||
(car split-name) prom active 'gnus-valid-move-group-p nil nil
|
||||
'gnus-group-history))
|
||||
(t
|
||||
(gnus-completing-read-with-default
|
||||
nil prom (mapcar 'list (nreverse split-name)) nil nil nil
|
||||
'gnus-group-history)))))
|
||||
(to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
|
||||
(cond
|
||||
((null split-name)
|
||||
(gnus-group-completing-read
|
||||
prom
|
||||
(remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb)
|
||||
nil prefix nil default))
|
||||
((= 1 (length split-name))
|
||||
(gnus-group-completing-read
|
||||
prom (remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb)
|
||||
nil prefix 'gnus-group-history (car split-name)))
|
||||
(t
|
||||
(gnus-completing-read
|
||||
prom (nreverse split-name) nil nil 'gnus-group-history))))
|
||||
(to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
|
||||
encoded)
|
||||
(when to-newsgroup
|
||||
(if (or (string= to-newsgroup "")
|
||||
|
|
|
|||
|
|
@ -161,9 +161,7 @@ See Info node `(gnus)Formatting Variables'."
|
|||
(defun gnus-topic-jump-to-topic (topic)
|
||||
"Go to TOPIC."
|
||||
(interactive
|
||||
(list (completing-read "Go to topic: "
|
||||
(mapcar 'list (gnus-topic-list))
|
||||
nil t)))
|
||||
(list (gnus-completing-read "Go to topic" (gnus-topic-list) t)))
|
||||
(let ((buffer-read-only nil))
|
||||
(dolist (topic (gnus-current-topics topic))
|
||||
(unless (gnus-topic-goto-topic topic)
|
||||
|
|
@ -1303,7 +1301,7 @@ When used interactively, PARENT will be the topic under point."
|
|||
If COPYP, copy the groups instead."
|
||||
(interactive
|
||||
(list current-prefix-arg
|
||||
(gnus-completing-read "Move to topic" gnus-topic-alist nil t
|
||||
(gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t
|
||||
'gnus-topic-history)))
|
||||
(let ((use-marked (and (not n) (not (gnus-region-active-p))
|
||||
gnus-group-marked t))
|
||||
|
|
@ -1350,7 +1348,7 @@ If COPYP, copy the groups instead."
|
|||
"Copy the current group to a topic."
|
||||
(interactive
|
||||
(list current-prefix-arg
|
||||
(completing-read "Copy to topic: " gnus-topic-alist nil t)))
|
||||
(gnus-completing-read "Copy to topic" (mapcar 'car gnus-topic-alist) t)))
|
||||
(gnus-topic-move-group n topic t))
|
||||
|
||||
(defun gnus-topic-kill-group (&optional n discard)
|
||||
|
|
@ -1443,7 +1441,8 @@ If PERMANENT, make it stay shown in subsequent sessions as well."
|
|||
(gnus-topic-remove-topic t nil)
|
||||
(let ((topic
|
||||
(gnus-topic-find-topology
|
||||
(completing-read "Show topic: " gnus-topic-alist nil t))))
|
||||
(gnus-completing-read "Show topic"
|
||||
(mapcar 'car gnus-topic-alist) t))))
|
||||
(setcar (cddr (cadr topic)) nil)
|
||||
(setcar (cdr (cadr topic)) 'visible)
|
||||
(gnus-group-list-groups)))))
|
||||
|
|
@ -1491,7 +1490,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
|
|||
(let (topic)
|
||||
(nreverse
|
||||
(list
|
||||
(setq topic (completing-read "Move to topic: " gnus-topic-alist nil t))
|
||||
(setq topic (gnus-completing-read "Move to topic"
|
||||
(mapcar 'car gnus-topic-alist) t))
|
||||
(read-string (format "Move to %s (regexp): " topic))))))
|
||||
(gnus-group-mark-regexp regexp)
|
||||
(gnus-topic-move-group nil topic copyp))
|
||||
|
|
@ -1502,7 +1502,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
|
|||
(let (topic)
|
||||
(nreverse
|
||||
(list
|
||||
(setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t))
|
||||
(setq topic (gnus-completing-read "Copy to topic"
|
||||
(mapcar 'car gnus-topic-alist) t))
|
||||
(read-string (format "Copy to %s (regexp): " topic))))))
|
||||
(gnus-topic-move-matching regexp topic t))
|
||||
|
||||
|
|
@ -1723,8 +1724,9 @@ If REVERSE, sort in reverse order."
|
|||
"Sort topics in TOPIC alphabetically by topic name.
|
||||
If REVERSE, reverse the sorting order."
|
||||
(interactive
|
||||
(list (completing-read "Sort topics in : " gnus-topic-alist nil t
|
||||
(gnus-current-topic))
|
||||
(list (gnus-completing-read "Sort topics in"
|
||||
(mapcar 'car gnus-topic-alist) t
|
||||
(gnus-current-topic))
|
||||
current-prefix-arg))
|
||||
(let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic)))
|
||||
gnus-topic-topology)))
|
||||
|
|
@ -1738,7 +1740,7 @@ If REVERSE, reverse the sorting order."
|
|||
(interactive
|
||||
(list
|
||||
(gnus-group-topic-name)
|
||||
(completing-read "Move to topic: " gnus-topic-alist nil t)))
|
||||
(gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t)))
|
||||
(unless (and current to)
|
||||
(error "Can't find topic"))
|
||||
(let ((current-top (cdr (gnus-topic-find-topology current)))
|
||||
|
|
|
|||
|
|
@ -44,6 +44,32 @@
|
|||
(defmacro with-no-warnings (&rest body)
|
||||
`(progn ,@body))))
|
||||
|
||||
(defcustom gnus-completing-read-function
|
||||
#'gnus-std-completing-read
|
||||
"Function to do a completing read."
|
||||
:group 'gnus-meta
|
||||
:type '(radio (function-item
|
||||
:doc "Use Emacs' standard `completing-read' function."
|
||||
gnus-std-completing-read)
|
||||
(function-item :doc "Use iswitchb's completing-read function."
|
||||
gnus-icompleting-read)
|
||||
(function-item :doc "Use ido's completing-read function."
|
||||
gnus-ido-completing-read)
|
||||
(function)))
|
||||
|
||||
(defcustom gnus-completion-styles
|
||||
(if (and (boundp 'completion-styles-alist)
|
||||
(boundp 'completion-styles))
|
||||
(append (when (and (assq 'substring completion-styles-alist)
|
||||
(not (memq 'substring completion-styles)))
|
||||
(list 'substring))
|
||||
completion-styles)
|
||||
nil)
|
||||
"Value of `completion-styles' to use when completing."
|
||||
:version "24.1"
|
||||
:group 'gnus-meta
|
||||
:type 'list)
|
||||
|
||||
;; Fixme: this should be a gnus variable, not nnmail-.
|
||||
(defvar nnmail-pathname-coding-system)
|
||||
(defvar nnmail-active-file-coding-system)
|
||||
|
|
@ -344,16 +370,6 @@ TIME defaults to the current time."
|
|||
(define-key keymap key (pop plist))
|
||||
(pop plist)))))
|
||||
|
||||
(defun gnus-completing-read-with-default (default prompt &rest args)
|
||||
;; Like `completing-read', except that DEFAULT is the default argument.
|
||||
(let* ((prompt (if default
|
||||
(concat prompt " (default " default "): ")
|
||||
(concat prompt ": ")))
|
||||
(answer (apply 'completing-read prompt args)))
|
||||
(if (or (null answer) (zerop (length answer)))
|
||||
default
|
||||
answer)))
|
||||
|
||||
;; Two silly functions to ensure that all `y-or-n-p' questions clear
|
||||
;; the echo area.
|
||||
;;
|
||||
|
|
@ -1574,21 +1590,50 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
|
|||
`(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
|
||||
(error "Invalid predicate specifier: %s" spec)))))
|
||||
|
||||
(defun gnus-completing-read (prompt table &optional predicate require-match
|
||||
history)
|
||||
(when (and history
|
||||
(not (boundp history)))
|
||||
(set history nil))
|
||||
(completing-read
|
||||
(if (symbol-value history)
|
||||
(concat prompt " (" (car (symbol-value history)) "): ")
|
||||
(concat prompt ": "))
|
||||
table
|
||||
predicate
|
||||
require-match
|
||||
nil
|
||||
history
|
||||
(car (symbol-value history))))
|
||||
(defun gnus-std-completing-read (prompt collection &optional require-match
|
||||
initial-input history def)
|
||||
(completing-read prompt collection nil require-match
|
||||
initial-input history def))
|
||||
|
||||
(defun gnus-icompleting-read (prompt collection &optional require-match
|
||||
initial-input history def)
|
||||
(require 'iswitchb)
|
||||
(let ((iswitchb-make-buflist-hook
|
||||
(lambda ()
|
||||
(setq iswitchb-temp-buflist
|
||||
(let ((choices (append (list)
|
||||
(when initial-input (list initial-input))
|
||||
(symbol-value history) collection))
|
||||
filtered-choices)
|
||||
(while choices
|
||||
(when (and (car choices) (not (member (car choices) filtered-choices)))
|
||||
(setq filtered-choices (cons (car choices) filtered-choices)))
|
||||
(setq choices (cdr choices)))
|
||||
(nreverse filtered-choices))))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(when (not iswitchb-mode)
|
||||
(add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
|
||||
(iswitchb-read-buffer prompt def require-match))
|
||||
(when (not iswitchb-mode)
|
||||
(remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))
|
||||
|
||||
(defun gnus-ido-completing-read (prompt collection &optional require-match
|
||||
initial-input history def)
|
||||
(require 'ido)
|
||||
(ido-completing-read prompt collection nil require-match
|
||||
initial-input history def))
|
||||
|
||||
(defun gnus-completing-read (prompt collection &optional require-match
|
||||
initial-input history def)
|
||||
"Do a completing read with the configured `gnus-completing-read-function'."
|
||||
(let ((completion-styles gnus-completion-styles))
|
||||
(funcall
|
||||
gnus-completing-read-function
|
||||
(concat prompt (when def
|
||||
(concat " (default " def ")"))
|
||||
": ")
|
||||
collection require-match initial-input history def)))
|
||||
|
||||
(defun gnus-graphic-display-p ()
|
||||
(if (featurep 'xemacs)
|
||||
|
|
|
|||
|
|
@ -1427,6 +1427,7 @@ no need to set this variable."
|
|||
:group 'gnus-message
|
||||
:type '(choice (const :tag "default" nil)
|
||||
string))
|
||||
(make-obsolete-variable 'gnus-local-domain nil "24.1")
|
||||
|
||||
(defvar gnus-local-organization nil
|
||||
"String with a description of what organization (if any) the user belongs to.
|
||||
|
|
@ -4241,9 +4242,9 @@ Allow completion over sensible values."
|
|||
gnus-predefined-server-alist
|
||||
gnus-server-alist))
|
||||
(method
|
||||
(completing-read
|
||||
prompt servers
|
||||
nil t nil 'gnus-method-history)))
|
||||
(gnus-completing-read
|
||||
prompt (mapcar 'car servers)
|
||||
t nil 'gnus-method-history)))
|
||||
(cond
|
||||
((equal method "")
|
||||
(setq method gnus-select-method))
|
||||
|
|
|
|||
|
|
@ -1323,11 +1323,11 @@ Use CMD as the process."
|
|||
"Display HANDLE using METHOD."
|
||||
(let* ((type (mm-handle-media-type handle))
|
||||
(methods
|
||||
(mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
|
||||
(mapcar (lambda (i) (cdr (assoc 'viewer i)))
|
||||
(mailcap-mime-info type 'all)))
|
||||
(method (let ((minibuffer-local-completion-map
|
||||
mm-viewer-completion-map))
|
||||
(completing-read "Viewer: " methods))))
|
||||
(gnus-completing-read "Viewer" methods))))
|
||||
(when (string= method "")
|
||||
(error "No method given"))
|
||||
(if (string-match "^[^% \t]+$" method)
|
||||
|
|
|
|||
|
|
@ -68,11 +68,11 @@
|
|||
. ,(lambda (prompt)
|
||||
"Return a charset."
|
||||
(intern
|
||||
(completing-read
|
||||
(gnus-completing-read
|
||||
prompt
|
||||
(mapcar (lambda (e) (list (symbol-name (car e))))
|
||||
(mapcar (lambda (e) (symbol-name (car e)))
|
||||
mm-mime-mule-charset-alist)
|
||||
nil t))))
|
||||
t))))
|
||||
;; `subst-char-in-string' is not available in XEmacs 21.4.
|
||||
(subst-char-in-string
|
||||
. ,(lambda (from to string &optional inplace)
|
||||
|
|
@ -281,8 +281,8 @@ to the contents of the accessible portion of the buffer."
|
|||
'read-coding-system))
|
||||
(t (lambda (prompt &optional default-coding-system)
|
||||
"Prompt the user for a coding system."
|
||||
(completing-read
|
||||
prompt (mapcar (lambda (s) (list (symbol-name (car s))))
|
||||
(gnus-completing-read
|
||||
prompt (mapcar (lambda (s) (symbol-name (car s)))
|
||||
mm-mime-mule-charset-alist)))))))
|
||||
|
||||
(defvar mm-coding-system-list nil)
|
||||
|
|
@ -316,8 +316,8 @@ the alias. Else windows-NUMBER is used."
|
|||
(cp-supported-codepages)
|
||||
;; Removed in Emacs 23 (unicode), so signal an error:
|
||||
(error "`codepage-setup' not present in this Emacs version"))))
|
||||
(list (completing-read "Setup DOS Codepage: (default 437) " candidates
|
||||
nil t nil nil "437"))))
|
||||
(list (gnus-completing-read "Setup DOS Codepage" candidates
|
||||
t nil nil "437"))))
|
||||
(when alias
|
||||
(setq alias (if (stringp alias)
|
||||
(intern alias)
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@
|
|||
(require 'mm-decode)
|
||||
(require 'smime)
|
||||
|
||||
(autoload 'gnus-completing-read "gnus-util")
|
||||
(autoload 'gnus-article-prepare-display "gnus-art")
|
||||
(autoload 'vcard-parse-string "vcard")
|
||||
(autoload 'vcard-format-string "vcard")
|
||||
|
|
@ -676,11 +677,9 @@
|
|||
(if (= (length smime-keys) 1)
|
||||
(cadar smime-keys)
|
||||
(smime-get-key-by-email
|
||||
(completing-read
|
||||
(concat "Decipher using key"
|
||||
(if smime-keys (concat "(default " (caar smime-keys) "): ")
|
||||
": "))
|
||||
smime-keys nil nil nil nil (car-safe (car-safe smime-keys))))))
|
||||
(gnus-completing-read
|
||||
"Decipher using key"
|
||||
smime-keys nil nil nil (car-safe (car-safe smime-keys))))))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "\r\n" nil t)
|
||||
(replace-match "\n"))
|
||||
|
|
|
|||
|
|
@ -161,10 +161,10 @@ Whether the passphrase is cached at all is controlled by
|
|||
"")))))
|
||||
(and from (smime-get-key-by-email from)))
|
||||
(smime-get-key-by-email
|
||||
(completing-read "Sign this part with what signature? "
|
||||
smime-keys nil nil
|
||||
(and (listp (car-safe smime-keys))
|
||||
(caar smime-keys))))))))
|
||||
(gnus-completing-read "Sign this part with what signature"
|
||||
smime-keys nil nil
|
||||
(and (listp (car-safe smime-keys))
|
||||
(caar smime-keys))))))))
|
||||
|
||||
(defun mml-smime-get-file-cert ()
|
||||
(ignore-errors
|
||||
|
|
@ -213,15 +213,16 @@ Whether the passphrase is cached at all is controlled by
|
|||
(quit))
|
||||
result))
|
||||
|
||||
(autoload 'gnus-completing-read-with-default "gnus-util")
|
||||
(autoload 'gnus-completing-read "gnus-util")
|
||||
|
||||
(defun mml-smime-openssl-encrypt-query ()
|
||||
;; todo: try dns/ldap automatically first, before prompting user
|
||||
(let (certs done)
|
||||
(while (not done)
|
||||
(ecase (read (gnus-completing-read-with-default
|
||||
"ldap" "Fetch certificate from"
|
||||
'(("dns") ("ldap") ("file")) nil t))
|
||||
(ecase (read (gnus-completing-read
|
||||
"Fetch certificate from"
|
||||
'(("dns") ("ldap") ("file")) t nil nil
|
||||
"ldap"))
|
||||
(dns (setq certs (append certs
|
||||
(mml-smime-get-dns-cert))))
|
||||
(ldap (setq certs (append certs
|
||||
|
|
|
|||
|
|
@ -40,6 +40,7 @@
|
|||
(autoload 'message-make-message-id "message")
|
||||
(declare-function gnus-setup-posting-charset "gnus-msg" (group))
|
||||
(autoload 'gnus-make-local-hook "gnus-util")
|
||||
(autoload 'gnus-completing-read "gnus-util")
|
||||
(autoload 'message-fetch-field "message")
|
||||
(autoload 'message-mark-active-p "message")
|
||||
(autoload 'message-info "message")
|
||||
|
|
@ -1188,9 +1189,10 @@ If not set, `default-directory' will be used."
|
|||
;; looks like, and offer text/plain if it looks
|
||||
;; like text/plain.
|
||||
"application/octet-stream"))
|
||||
(string (completing-read
|
||||
(format "Content type (default %s): " default)
|
||||
(mapcar 'list (mailcap-mime-types)))))
|
||||
(string (gnus-completing-read
|
||||
"Content type"
|
||||
(mailcap-mime-types)
|
||||
nil nil nil default)))
|
||||
(if (not (equal string ""))
|
||||
string
|
||||
default)))
|
||||
|
|
@ -1204,10 +1206,10 @@ If not set, `default-directory' will be used."
|
|||
(defun mml-minibuffer-read-disposition (type &optional default filename)
|
||||
(unless default
|
||||
(setq default (mml-content-disposition type filename)))
|
||||
(let ((disposition (completing-read
|
||||
(format "Disposition (default %s): " default)
|
||||
'(("attachment") ("inline") (""))
|
||||
nil t nil nil default)))
|
||||
(let ((disposition (gnus-completing-read
|
||||
"Disposition"
|
||||
'("attachment" "inline")
|
||||
t nil nil default)))
|
||||
(if (not (equal disposition ""))
|
||||
disposition
|
||||
default)))
|
||||
|
|
@ -1395,11 +1397,11 @@ TYPE is the MIME type to use."
|
|||
|
||||
(defun mml-insert-multipart (&optional type)
|
||||
(interactive (if (message-in-body-p)
|
||||
(list (completing-read "Multipart type (default mixed): "
|
||||
'(("mixed") ("alternative")
|
||||
("digest") ("parallel")
|
||||
("signed") ("encrypted"))
|
||||
nil nil "mixed"))
|
||||
(list (gnus-completing-read "Multipart type"
|
||||
'("mixed" "alternative"
|
||||
"digest" "parallel"
|
||||
"signed" "encrypted")
|
||||
nil "mixed"))
|
||||
(error "Use this command in the message body")))
|
||||
(or type
|
||||
(setq type "mixed"))
|
||||
|
|
|
|||
|
|
@ -280,6 +280,11 @@ from the document.")
|
|||
(t
|
||||
(nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
|
||||
|
||||
(deffoo nndoc-retrieve-groups (groups &optional server)
|
||||
(dolist (group groups)
|
||||
(nndoc-request-group group server))
|
||||
t)
|
||||
|
||||
(deffoo nndoc-request-type (group &optional article)
|
||||
(cond ((not article) 'unknown)
|
||||
(nndoc-post-type nndoc-post-type)
|
||||
|
|
|
|||
|
|
@ -224,7 +224,7 @@ are generated if and only if they are also in `message-draft-headers'.")
|
|||
(let* ((nnmh-allow-delete-final t)
|
||||
(nnmail-expiry-target
|
||||
(or (gnus-group-find-parameter
|
||||
(gnus-group-prefixed-name "nndraft" (list 'nndraft server))
|
||||
(gnus-group-prefixed-name group (list 'nndraft server))
|
||||
'expiry-target t)
|
||||
nnmail-expiry-target))
|
||||
(res (nnoo-parent-function 'nndraft
|
||||
|
|
|
|||
|
|
@ -70,6 +70,9 @@ Values are `ssl', `network', `starttls' or `shell'.")
|
|||
"How mail is split.
|
||||
Uses the same syntax as nnmail-split-methods")
|
||||
|
||||
(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
|
||||
"Gnus 5.13")
|
||||
|
||||
(defvoo nnimap-authenticator nil
|
||||
"How nnimap authenticate itself to the server.
|
||||
Possible choices are nil (use default methods) or `anonymous'.")
|
||||
|
|
@ -342,15 +345,6 @@ textual parts.")
|
|||
(when (eq nnimap-stream 'starttls)
|
||||
(nnimap-command "STARTTLS")
|
||||
(starttls-negotiate (nnimap-process nnimap-object)))
|
||||
;; If this is a STARTTLS-capable server, then sever the
|
||||
;; connection and start a STARTTLS connection instead.
|
||||
(when (and (eq nnimap-stream 'network)
|
||||
(member "STARTTLS" (nnimap-capabilities nnimap-object)))
|
||||
(let ((nnimap-stream 'starttls))
|
||||
(delete-process (nnimap-process nnimap-object))
|
||||
(kill-buffer (current-buffer))
|
||||
(return
|
||||
(nnimap-open-connection buffer))))
|
||||
(when nnimap-server-port
|
||||
(push (format "%s" nnimap-server-port) ports))
|
||||
(unless (equal connection-result "PREAUTH")
|
||||
|
|
@ -428,7 +422,12 @@ textual parts.")
|
|||
(nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
|
||||
(setq structure (ignore-errors (read (current-buffer)))
|
||||
(setq structure (ignore-errors
|
||||
(let ((start (point)))
|
||||
(forward-sexp 1)
|
||||
(downcase-region start (point))
|
||||
(goto-char (point))
|
||||
(read (current-buffer))))
|
||||
parts (nnimap-find-wanted-parts structure))))
|
||||
(when (if parts
|
||||
(nnimap-get-partial-article article parts structure)
|
||||
|
|
@ -509,8 +508,15 @@ textual parts.")
|
|||
t))
|
||||
|
||||
(defun nnimap-insert-partial-structure (structure parts &optional subp)
|
||||
(let ((type (car (last structure 4)))
|
||||
(boundary (cadr (member "BOUNDARY" (car (last structure 3))))))
|
||||
(let (type boundary)
|
||||
(let ((bstruc structure))
|
||||
(while (consp (car bstruc))
|
||||
(pop bstruc))
|
||||
(setq type (car bstruc))
|
||||
(setq bstruc (car (cdr bstruc)))
|
||||
(when (and (stringp (car bstruc))
|
||||
(string= (downcase (car bstruc)) "boundary"))
|
||||
(setq boundary (cadr bstruc))))
|
||||
(when subp
|
||||
(insert (format "Content-type: multipart/%s; boundary=%S\n\n"
|
||||
(downcase type) boundary)))
|
||||
|
|
@ -768,6 +774,7 @@ textual parts.")
|
|||
(when (nnimap-possibly-change-group group server)
|
||||
(let (sequence)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(erase-buffer)
|
||||
;; Just send all the STORE commands without waiting for
|
||||
;; response. If they're successful, they're successful.
|
||||
(dolist (action actions)
|
||||
|
|
@ -789,6 +796,7 @@ textual parts.")
|
|||
(deffoo nnimap-request-accept-article (group &optional server last)
|
||||
(when (nnimap-possibly-change-group nil server)
|
||||
(nnmail-check-syntax)
|
||||
(nnimap-add-cr)
|
||||
(let ((message (buffer-string))
|
||||
(message-id (message-field-value "message-id"))
|
||||
sequence)
|
||||
|
|
@ -1288,7 +1296,9 @@ textual parts.")
|
|||
(defun nnimap-split-incoming-mail ()
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(let ((nnimap-incoming-split-list nil)
|
||||
(nnmail-split-methods nnimap-split-methods)
|
||||
(nnmail-split-methods (if (eq nnimap-split-methods 'default)
|
||||
nnmail-split-methods
|
||||
nnimap-split-methods))
|
||||
(nnmail-inhibit-default-split-group t)
|
||||
(groups (nnimap-get-groups))
|
||||
new-articles)
|
||||
|
|
@ -1339,6 +1349,7 @@ textual parts.")
|
|||
(defun nnimap-mark-and-expunge-incoming (range)
|
||||
(when range
|
||||
(setq range (nnimap-article-ranges range))
|
||||
(erase-buffer)
|
||||
(let ((sequence
|
||||
(nnimap-send-command
|
||||
"UID STORE %s +FLAGS.SILENT (\\Deleted)" range)))
|
||||
|
|
|
|||
|
|
@ -1588,7 +1588,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
|
|||
(let ((sym (car parmspec))
|
||||
(prompt (cdr parmspec)))
|
||||
(if (listp prompt)
|
||||
(let* ((result (apply 'completing-read prompt))
|
||||
(let* ((result (gnus-completing-read prompt nil))
|
||||
(mapping (or (assoc result nnir-imap-search-arguments)
|
||||
(assoc nil nnir-imap-search-arguments))))
|
||||
(cons sym (format (cdr mapping) result)))
|
||||
|
|
|
|||
|
|
@ -848,8 +848,8 @@ called interactively, user will be asked for parameters."
|
|||
All necessary information will be queried from the user."
|
||||
(interactive)
|
||||
(let* ((name (read-string "Name of the mairix server: "))
|
||||
(server (completing-read "Back end server (TAB for completion): "
|
||||
(nnmairix-get-valid-servers) nil 1))
|
||||
(server (gnus-completing-read "Back end server"
|
||||
(nnmairix-get-valid-servers) t))
|
||||
(mairix (read-string "Command to call mairix: " "mairix"))
|
||||
(defaultgroup (read-string "Default search group: "))
|
||||
(backend (symbol-name (car (gnus-server-to-method server))))
|
||||
|
|
@ -1165,7 +1165,7 @@ nnmairix server. Only marks from current session will be set."
|
|||
If SKIPDEFAULT is t, the default search group will not be
|
||||
updated.
|
||||
If UPDATEDB is t, database for SERVERNAME will be updated first."
|
||||
(interactive (list (completing-read "Update groups on server: "
|
||||
(interactive (list (gnus-completing-read "Update groups on server"
|
||||
(nnmairix-get-nnmairix-servers))))
|
||||
(save-excursion
|
||||
(when (string-match ".*:\\(.*\\)" servername)
|
||||
|
|
@ -1302,7 +1302,7 @@ Otherwise, ask user for server."
|
|||
(while
|
||||
(equal '("")
|
||||
(setq nnmairix-last-server
|
||||
(list (completing-read "Server: " openedserver nil 1
|
||||
(list (gnus-completing-read "Server" openedserver t
|
||||
(or nnmairix-last-server
|
||||
"nnmairix:"))))))
|
||||
nnmairix-last-server)
|
||||
|
|
@ -1492,10 +1492,10 @@ group."
|
|||
(when (not found)
|
||||
(setq mairixserver
|
||||
(gnus-server-to-method
|
||||
(completing-read
|
||||
(format "Cannot determine which nnmairix server indexes %s. Please specify: "
|
||||
(gnus-completing-read
|
||||
(format "Cannot determine which nnmairix server indexes %s. Please specify"
|
||||
(gnus-method-to-server server))
|
||||
(nnmairix-get-nnmairix-servers) nil nil "nnmairix:")))
|
||||
(nnmairix-get-nnmairix-servers) nil "nnmairix:")))
|
||||
;; Save result in parameter of default search group so that
|
||||
;; we don't have to ask again
|
||||
(setq defaultgroup (gnus-group-prefixed-name
|
||||
|
|
@ -1643,9 +1643,9 @@ search in raw mode."
|
|||
(gnus-registry-add-group mid cur)))))
|
||||
(if (> (length allgroups) 1)
|
||||
(setq group
|
||||
(completing-read
|
||||
"Message exists in more than one group. Choose: "
|
||||
allgroups nil t))
|
||||
(gnus-completing-read
|
||||
"Message exists in more than one group. Choose"
|
||||
allgroups t))
|
||||
(setq group (car allgroups))))
|
||||
(if group
|
||||
;; show article in summary buffer
|
||||
|
|
@ -1748,9 +1748,9 @@ SERVER."
|
|||
(gnus-group-prefixed-name group (car cur))
|
||||
allgroups))))
|
||||
(if (> (length allgroups) 1)
|
||||
(setq group (completing-read
|
||||
"Group %s exists on more than one IMAP server. Choose: "
|
||||
allgroups nil t))
|
||||
(setq group (gnus-completing-read
|
||||
"Group %s exists on more than one IMAP server. Choose"
|
||||
allgroups t))
|
||||
(setq group (car allgroups))))
|
||||
group))
|
||||
|
||||
|
|
|
|||
|
|
@ -1048,9 +1048,9 @@ whether they are `offsite' or `onsite'."
|
|||
(cdr (assoc "feedid" listinfo)))))
|
||||
feedinfo)))
|
||||
(cdr (assoc
|
||||
(completing-read
|
||||
"Multiple feeds found. Select one: "
|
||||
selection nil t) urllist)))))))))
|
||||
(gnus-completing-read
|
||||
"Multiple feeds found. Select one"
|
||||
selection t) urllist)))))))))
|
||||
|
||||
(defun nnrss-rss-p (data)
|
||||
"Test if DATA is an RSS feed.
|
||||
|
|
|
|||
|
|
@ -82,6 +82,15 @@ valid value is 'apop'."
|
|||
:version "22.1" ;; Oort Gnus
|
||||
:group 'pop3)
|
||||
|
||||
(defcustom pop3-stream-length 100
|
||||
"How many messages should be requested at one time.
|
||||
The lower the number, the more latency-sensitive the fetching
|
||||
will be. If your pop3 server doesn't support streaming at all,
|
||||
set this to 1."
|
||||
:type 'number
|
||||
:version "24.1"
|
||||
:group 'pop3)
|
||||
|
||||
(defcustom pop3-leave-mail-on-server nil
|
||||
"*Non-nil if the mail is to be left on the POP server after fetching.
|
||||
|
||||
|
|
@ -156,7 +165,7 @@ Use streaming commands."
|
|||
(while (>= count i)
|
||||
(process-send-string process (format "%s %d\r\n" command i))
|
||||
;; Only do 100 messages at a time to avoid pipe stalls.
|
||||
(when (zerop (% i 100))
|
||||
(when (zerop (% i pop3-stream-length))
|
||||
(pop3-wait-for-messages process i total-size))
|
||||
(incf i)))
|
||||
(pop3-wait-for-messages process count total-size))
|
||||
|
|
|
|||
|
|
@ -371,12 +371,9 @@ KEYFILE should contain a PEM encoded key and certificate."
|
|||
(if keyfile
|
||||
keyfile
|
||||
(smime-get-key-with-certs-by-email
|
||||
(completing-read
|
||||
(concat "Sign using key"
|
||||
(if smime-keys
|
||||
(concat " (default " (caar smime-keys) "): ")
|
||||
": "))
|
||||
smime-keys nil nil (car-safe (car-safe smime-keys))))))
|
||||
(gnus-completing-read
|
||||
"Sign using key"
|
||||
smime-keys nil (car-safe (car-safe smime-keys))))))
|
||||
(error "Signing failed"))))
|
||||
|
||||
(defun smime-encrypt-buffer (&optional certfiles buffer)
|
||||
|
|
@ -502,11 +499,9 @@ in the buffer specified by `smime-details-buffer'."
|
|||
(expand-file-name
|
||||
(or keyfile
|
||||
(smime-get-key-by-email
|
||||
(completing-read
|
||||
(concat "Decipher using key"
|
||||
(if smime-keys (concat " (default " (caar smime-keys) "): ")
|
||||
": "))
|
||||
smime-keys nil nil (car-safe (car-safe smime-keys)))))))))
|
||||
(gnus-completing-read
|
||||
"Decipher using key"
|
||||
smime-keys nil (car-safe (car-safe smime-keys)))))))))
|
||||
|
||||
;; Various operations
|
||||
|
||||
|
|
@ -660,6 +655,7 @@ A string or a list of strings is returned."
|
|||
(define-key smime-mode-map "f" 'smime-certificate-info))
|
||||
|
||||
(autoload 'gnus-run-mode-hooks "gnus-util")
|
||||
(autoload 'gnus-completing-read "gnus-util")
|
||||
|
||||
(defun smime-mode ()
|
||||
"Major mode for browsing, viewing and fetching certificates.
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
|
||||
;; Keywords: hotmail netaddress my-deja netscape
|
||||
;; Keywords: hotmail netaddress
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
|
|
@ -115,39 +115,7 @@
|
|||
(article-snarf . webmail-netaddress-article)
|
||||
(trash-url
|
||||
"http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
|
||||
webmail-session id))
|
||||
(netscape
|
||||
(paranoid cookie post agent)
|
||||
(address . "webmail.netscape.com")
|
||||
(open-url "http://ureg.netscape.com/iiop/UReg2/login/login?U2_LA=en&U2_BACK_FROM_CJ=true&U2_CS=iso-8859-1&U2_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_NEW_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_EXITURL=http://home.netscape.com/&U2_SOURCE=Webmail")
|
||||
(open-snarf . webmail-netscape-open)
|
||||
(login-url
|
||||
content
|
||||
("http://ureg.netscape.com/iiop/UReg2/login/loginform")
|
||||
"U2_USERNAME=%s&U2_PASSWORD=%s%s"
|
||||
user password webmail-aux)
|
||||
(login-snarf . webmail-netaddress-login)
|
||||
(list-url
|
||||
"http://webmail.netscape.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
|
||||
webmail-session)
|
||||
(list-snarf . webmail-netaddress-list)
|
||||
(article-url "http://webmail.netscape.com/")
|
||||
(article-snarf . webmail-netscape-article)
|
||||
(trash-url
|
||||
"http://webmail.netscape.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
|
||||
webmail-session id))
|
||||
(my-deja
|
||||
(paranoid cookie post)
|
||||
(address . "www.my-deja.com")
|
||||
;;(open-snarf . webmail-my-deja-open)
|
||||
(login-url
|
||||
content
|
||||
("http://mydeja.google.com/cgi-bin/deja/maillogin.py")
|
||||
"userid=%s&password=%s"
|
||||
user password)
|
||||
(list-snarf . webmail-my-deja-list)
|
||||
(article-snarf . webmail-my-deja-article)
|
||||
(trash-url webmail-aux id))))
|
||||
webmail-session id))))
|
||||
|
||||
(defvar webmail-variables
|
||||
'(address article-snarf article-url list-snarf list-url
|
||||
|
|
@ -683,15 +651,6 @@
|
|||
|
||||
;;; netaddress
|
||||
|
||||
(defun webmail-netscape-open ()
|
||||
(goto-char (point-min))
|
||||
(setq webmail-aux "")
|
||||
(while (re-search-forward
|
||||
"TYPE=hidden *NAME=\\([^ ]+\\) *VALUE=\"\\([^\"]+\\)"
|
||||
nil t)
|
||||
(setq webmail-aux (concat webmail-aux "&" (match-string 1) "="
|
||||
(match-string 2)))))
|
||||
|
||||
(defun webmail-netaddress-open ()
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
|
||||
|
|
@ -872,280 +831,6 @@
|
|||
(insert ">"))))
|
||||
(mm-append-to-file (point-min) (point-max) file)))
|
||||
|
||||
(defun webmail-netscape-article (file id)
|
||||
(let (p p1 attachment count mime type)
|
||||
(save-restriction
|
||||
(webmail-encode-8bit)
|
||||
(goto-char (point-min))
|
||||
(if (not (search-forward "Trash" nil t))
|
||||
(webmail-error "article@1"))
|
||||
(if (not (search-forward "<form>" nil t))
|
||||
(webmail-error "article@2"))
|
||||
(delete-region (point-min) (match-beginning 0))
|
||||
(if (not (search-forward "</form>" nil t))
|
||||
(webmail-error "article@3"))
|
||||
(narrow-to-region (point-min) (match-end 0))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "[\040\t\r\n]+" nil t)
|
||||
(replace-match " "))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "<a href=[^>]*>[^<]*</a>" nil t)
|
||||
(replace-match ""))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "<b>" nil t)
|
||||
(replace-match "\n"))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities-nbsp)
|
||||
(goto-char (point-min))
|
||||
(delete-blank-lines)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^\040+\\|\040+$" nil t)
|
||||
(replace-match ""))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\040+" nil t)
|
||||
(replace-match " "))
|
||||
(goto-char (point-max))
|
||||
(widen)
|
||||
(insert "\n\n")
|
||||
(setq p (point))
|
||||
(unless (search-forward "<!-- Data -->" nil t)
|
||||
(webmail-error "article@4"))
|
||||
(forward-line 14)
|
||||
(delete-region p (point))
|
||||
(goto-char (point-max))
|
||||
(unless (re-search-backward
|
||||
"<form name=\"Transfer2\"" p t)
|
||||
(webmail-error "article@5"))
|
||||
(delete-region (point) (point-max))
|
||||
(goto-char p)
|
||||
(while (search-forward
|
||||
"<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
|
||||
nil t 2)
|
||||
(setq mime t)
|
||||
(unless (search-forward "</TABLE>" nil t)
|
||||
(webmail-error "article@6"))
|
||||
(setq p1 (point))
|
||||
(if (search-backward "<IMG " p t)
|
||||
(progn
|
||||
(unless (re-search-forward "HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t)
|
||||
(webmail-error "article@7"))
|
||||
(setq attachment (match-string 1))
|
||||
(setq type (match-string 2))
|
||||
(unless (search-forward "</TABLE>" nil t)
|
||||
(webmail-error "article@8"))
|
||||
(delete-region p (point))
|
||||
(let (bufname);; Attachment
|
||||
(save-excursion
|
||||
(set-buffer (generate-new-buffer " *webmail-att*"))
|
||||
(mm-url-insert (concat (car webmail-open-url) attachment))
|
||||
(push (current-buffer) webmail-buffer-list)
|
||||
(setq bufname (buffer-name)))
|
||||
(insert "<#part type=" type)
|
||||
(insert " buffer=\"" bufname "\"")
|
||||
(insert " disposition=\"inline\"")
|
||||
(insert "><#/part>\n")
|
||||
(setq p (point))))
|
||||
(delete-region p p1)
|
||||
(narrow-to-region
|
||||
p
|
||||
(if (search-forward
|
||||
"<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
|
||||
nil t)
|
||||
(match-beginning 0)
|
||||
(point-max)))
|
||||
(webmail-netaddress-single-part)
|
||||
(goto-char (point-max))
|
||||
(setq p (point))
|
||||
(widen)))
|
||||
(unless mime
|
||||
(narrow-to-region p (point-max))
|
||||
(setq mime (webmail-netaddress-single-part))
|
||||
(widen))
|
||||
(goto-char (point-min))
|
||||
;; Some blank line to separate mails.
|
||||
(insert "\n\nFrom nobody " (current-time-string) "\n")
|
||||
(insert "X-Gnus-Webmail: " (symbol-value 'user)
|
||||
"@" (symbol-name webmail-type) "\n")
|
||||
(if id
|
||||
(insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
|
||||
(unless (looking-at "$")
|
||||
(if (search-forward "\n\n" nil t)
|
||||
(forward-line -1)
|
||||
(webmail-error "article@2")))
|
||||
(when mime
|
||||
(narrow-to-region (point-min) (point))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(if (looking-at "MIME-Version\\|Content-Type")
|
||||
(delete-region (point)
|
||||
(progn
|
||||
(forward-line 1)
|
||||
(if (re-search-forward "^[^ \t]" nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(point-max))))
|
||||
(forward-line 1)))
|
||||
(goto-char (point-max))
|
||||
(widen)
|
||||
(narrow-to-region (point) (point-max))
|
||||
(insert "MIME-Version: 1.0\n"
|
||||
(prog1
|
||||
(mml-generate-mime)
|
||||
(delete-region (point-min) (point-max))))
|
||||
(goto-char (point-min))
|
||||
(widen))
|
||||
(let (case-fold-search)
|
||||
(while (re-search-forward "^From " nil t)
|
||||
(beginning-of-line)
|
||||
(insert ">"))))
|
||||
(mm-append-to-file (point-min) (point-max) file)))
|
||||
|
||||
;;; my-deja
|
||||
|
||||
(defun webmail-my-deja-open ()
|
||||
(webmail-refresh-redirect)
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "action=\"\\([^\"]+maillogin\\.py[^\"]*\\)\""
|
||||
nil t)
|
||||
(setq webmail-aux (match-string 1))
|
||||
(webmail-error "open@1")))
|
||||
|
||||
(defun webmail-my-deja-list ()
|
||||
(let (item id newp base)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "href=\"\\(\\([^\"]*\\)/mailnf\\.[^\"]*\\)\""
|
||||
nil t)
|
||||
(let ((url (match-string 1)))
|
||||
(setq base (match-string 2))
|
||||
(erase-buffer)
|
||||
(mm-url-insert url)))
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward
|
||||
"(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New"
|
||||
nil t)
|
||||
(message "Found %s mail(s), %s unread"
|
||||
(match-string 1) (match-string 2)))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
"newmail\\.gif\\|href=\"[^\"]*\\(mailnf\\.[^\"]+act=view[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
|
||||
nil t)
|
||||
(if (setq id (match-string 2))
|
||||
(when (and (or newp (not webmail-newmail-only))
|
||||
(not (assoc id webmail-articles)))
|
||||
(push (cons id (setq webmail-aux
|
||||
(concat base "/" (match-string 1))))
|
||||
webmail-articles)
|
||||
(setq newp nil))
|
||||
(setq newp t)))
|
||||
(setq webmail-articles (nreverse webmail-articles))))
|
||||
|
||||
(defun webmail-my-deja-article-part (base)
|
||||
(let (p)
|
||||
(cond
|
||||
((looking-at "[\t\040\r\n]*<!--[^>]*>")
|
||||
(replace-match ""))
|
||||
((looking-at "[\t\040\r\n]*</PRE>")
|
||||
(replace-match ""))
|
||||
((looking-at "[\t\040\r\n]*<PRE>")
|
||||
;; text/plain
|
||||
(replace-match "")
|
||||
(save-restriction
|
||||
(narrow-to-region (point)
|
||||
(if (re-search-forward "</?PRE>" nil t)
|
||||
(match-beginning 0)
|
||||
(point-max)))
|
||||
(goto-char (point-min))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities-nbsp)
|
||||
(goto-char (point-max))))
|
||||
((looking-at "[\t\040\r\n]*<TABLE")
|
||||
(save-restriction
|
||||
(narrow-to-region (point)
|
||||
(if (search-forward "</TABLE>" nil t 2)
|
||||
(point)
|
||||
(point-max)))
|
||||
(goto-char (point-min))
|
||||
(let (name type url bufname)
|
||||
(if (and (search-forward "File Name:" nil t)
|
||||
(re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
|
||||
(setq name (match-string 1)))
|
||||
(if (and (search-forward "File Type:" nil t)
|
||||
(re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
|
||||
(setq type (match-string 1)))
|
||||
(unless (re-search-forward "action=\"getattach\\.cgi/\\([^\"]+\\)"
|
||||
nil t)
|
||||
(webmail-error "article@5"))
|
||||
(setq url (concat base "/getattach.cgi/" (match-string 1)
|
||||
"?sm=Download"))
|
||||
(while (re-search-forward
|
||||
"type=hidden name=\"\\([^\"]+\\)\" value=\"\\([^\"]+\\)"
|
||||
nil t)
|
||||
(setq url (concat url "&" (match-string 1) "="
|
||||
(match-string 2))))
|
||||
(delete-region (point-min) (point-max))
|
||||
(save-excursion
|
||||
(set-buffer (generate-new-buffer " *webmail-att*"))
|
||||
(mm-url-insert url)
|
||||
(push (current-buffer) webmail-buffer-list)
|
||||
(setq bufname (buffer-name)))
|
||||
(insert "<#part type=\"" type "\"")
|
||||
(if name (insert " filename=\"" name "\""))
|
||||
(insert " buffer=\"" bufname "\"")
|
||||
(insert " disposition=inline><#/part>"))))
|
||||
(t
|
||||
(insert "<#part type=\"text/html\" disposition=inline>")
|
||||
(goto-char (point-max))
|
||||
(insert "<#/part>")))))
|
||||
|
||||
(defun webmail-my-deja-article (file id)
|
||||
(let (base)
|
||||
(goto-char (point-min))
|
||||
(unless (string-match "\\([^\"]+\\)/mail" webmail-aux)
|
||||
(webmail-error "article@0"))
|
||||
(setq base (match-string 1 webmail-aux))
|
||||
(when (re-search-forward
|
||||
"href=\"[^\"]*\\(mailnf\\.[^\"]+act=move[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
|
||||
nil t)
|
||||
(setq webmail-aux (concat base "/" (match-string 1)))
|
||||
(string-match "mid=[^\"&]+" webmail-aux)
|
||||
(setq webmail-aux (replace-match "mid=%s" nil nil webmail-aux)))
|
||||
(unless (search-forward "<HR noshade>" nil t)
|
||||
(webmail-error "article@1"))
|
||||
(delete-region (point-min) (point))
|
||||
(unless (search-forward "<HR noshade>" nil t)
|
||||
(webmail-error "article@2"))
|
||||
(save-restriction
|
||||
(narrow-to-region (point-min) (point))
|
||||
(while (search-forward "\r\n" nil t)
|
||||
(replace-match "\n"))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities-nbsp)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\n\n+" nil t)
|
||||
(replace-match "\n"))
|
||||
(goto-char (point-max)))
|
||||
(save-restriction
|
||||
(narrow-to-region (point) (point-max))
|
||||
(goto-char (point-max))
|
||||
(unless (search-backward "<HR noshade>" nil t)
|
||||
(webmail-error "article@3"))
|
||||
(unless (search-backward "</TT>" nil t)
|
||||
(webmail-error "article@4"))
|
||||
(delete-region (point) (point-max))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(webmail-my-deja-article-part base))
|
||||
(insert "MIME-Version: 1.0\n"
|
||||
(prog1
|
||||
(mml-generate-mime)
|
||||
(delete-region (point-min) (point-max)))))
|
||||
(goto-char (point-min))
|
||||
(insert "\n\nFrom nobody " (current-time-string) "\n")
|
||||
(insert "X-Gnus-Webmail: " (symbol-value 'user)
|
||||
"@" (symbol-name webmail-type) "\n")
|
||||
(if (eq (char-after) ?\n)
|
||||
(delete-char 1))
|
||||
(mm-append-to-file (point-min) (point-max) file)))
|
||||
|
||||
(provide 'webmail)
|
||||
|
||||
;;; webmail.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue