[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r101689: Merge changes made in Gnus t
|
From: |
Katsumi Yamaoka |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r101689: Merge changes made in Gnus trunk. |
|
Date: |
Thu, 30 Sep 2010 08:39:23 +0000 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 101689
author: Gnus developers
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Thu 2010-09-30 08:39:23 +0000
message:
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.
modified:
doc/misc/gnus.texi
etc/GNUS-NEWS
lisp/gnus/gnus-agent.el
lisp/gnus/gnus-art.el
lisp/gnus/gnus-bookmark.el
lisp/gnus/gnus-diary.el
lisp/gnus/gnus-dired.el
lisp/gnus/gnus-gravatar.el
lisp/gnus/gnus-group.el
lisp/gnus/gnus-int.el
lisp/gnus/gnus-msg.el
lisp/gnus/gnus-registry.el
lisp/gnus/gnus-score.el
lisp/gnus/gnus-srvr.el
lisp/gnus/gnus-sum.el
lisp/gnus/gnus-topic.el
lisp/gnus/gnus-util.el
lisp/gnus/gnus.el
lisp/gnus/mm-decode.el
lisp/gnus/mm-util.el
lisp/gnus/mm-view.el
lisp/gnus/mml-smime.el
lisp/gnus/mml.el
lisp/gnus/nndoc.el
lisp/gnus/nndraft.el
lisp/gnus/nnimap.el
lisp/gnus/nnir.el
lisp/gnus/nnmairix.el
lisp/gnus/nnrss.el
lisp/gnus/pop3.el
lisp/gnus/smime.el
lisp/gnus/webmail.el
=== modified file 'doc/misc/gnus.texi'
--- a/doc/misc/gnus.texi 2010-09-26 23:01:31 +0000
+++ b/doc/misc/gnus.texi 2010-09-30 08:39:23 +0000
@@ -629,7 +629,7 @@
* 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 @@
@item A C
@vindex gnus-fetch-partial-articles
@findex gnus-summary-show-complete-article
-If @code{gnus-fetch-partial-articles} is address@hidden, Gnus will
+If @code{<backend>-fetch-partial-articles} is address@hidden, 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 @@
@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 @@
@end table
address@hidden Using @acronym{IMAP}
address@hidden Using @acronym{IMAP}
address@hidden Using IMAP
address@hidden Using IMAP
@cindex imap
The most popular mail backend is probably @code{nnimap}, which
@@ -14798,14 +14798,14 @@
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
address@hidden Connecting to an @acronym{IMAP} Server
address@hidden Connecting to an @acronym{IMAP} Server
address@hidden Connecting to an IMAP Server
address@hidden 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 @@
That should basically be it for most users.
address@hidden Customizing the @acronym{IMAP} Connection
address@hidden Customizing the @acronym{IMAP} Connection
address@hidden Customizing the IMAP Connection
address@hidden 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 @@
Virtually all @code{IMAP} server support fast streaming of data. If
you have problems connecting to the server, try setting this to @code{nil}.
address@hidden nnimap-fetch-partial-articles
+If address@hidden, 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
address@hidden Client-Side @acronym{IMAP} Splitting
address@hidden Client-Side @acronym{IMAP} Splitting
address@hidden Client-Side IMAP Splitting
address@hidden 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 @@
@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 @@
@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
address@hidden mailbox. @xref{Using @acronym{IMAP}}, for more information.
address@hidden mailbox. @xref{Using IMAP}, for more information.
Keywords:
@@ -15929,7 +15936,7 @@
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 size in pixels of gravatars. Gravatars are always square, so one
number for the size is enough.
address@hidden gnus-gravatar-relief
address@hidden 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.
address@hidden gnus-gravatar-properties
address@hidden gnus-gravatar-properties
+List of image properties applied to Gravatar images.
@end table
@@ -23618,7 +23622,7 @@
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 @@
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
address@hidden 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
=== modified file 'etc/GNUS-NEWS'
--- a/etc/GNUS-NEWS 2010-01-13 08:35:10 +0000
+++ b/etc/GNUS-NEWS 2010-09-30 08:39:23 +0000
@@ -50,7 +50,7 @@
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
=== modified file 'lisp/gnus/gnus-agent.el'
--- a/lisp/gnus/gnus-agent.el 2010-09-26 23:01:31 +0000
+++ b/lisp/gnus/gnus-agent.el 2010-09-30 08:39:23 +0000
@@ -459,10 +459,7 @@
(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 @@
(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))
=== modified file 'lisp/gnus/gnus-art.el'
--- a/lisp/gnus/gnus-art.el 2010-09-27 23:07:47 +0000
+++ b/lisp/gnus/gnus-art.el 2010-09-30 08:39:23 +0000
@@ -5131,11 +5131,10 @@
(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 @@
(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 @@
(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
=== modified file 'lisp/gnus/gnus-bookmark.el'
--- a/lisp/gnus/gnus-bookmark.el 2010-09-25 13:28:07 +0000
+++ b/lisp/gnus/gnus-bookmark.el 2010-09-30 08:39:23 +0000
@@ -289,8 +289,8 @@
(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))))
=== modified file 'lisp/gnus/gnus-diary.el'
--- a/lisp/gnus/gnus-diary.el 2010-09-02 00:55:51 +0000
+++ b/lisp/gnus/gnus-diary.el 2010-09-30 08:39:23 +0000
@@ -368,11 +368,11 @@
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 ()
=== modified file 'lisp/gnus/gnus-dired.el'
--- a/lisp/gnus/gnus-dired.el 2010-09-02 01:42:32 +0000
+++ b/lisp/gnus/gnus-dired.el 2010-09-30 08:39:23 +0000
@@ -152,12 +152,8 @@
(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
=== modified file 'lisp/gnus/gnus-gravatar.el'
--- a/lisp/gnus/gnus-gravatar.el 2010-09-28 11:47:12 +0000
+++ b/lisp/gnus/gnus-gravatar.el 2010-09-30 08:39:23 +0000
@@ -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 @@
(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)
=== modified file 'lisp/gnus/gnus-group.el'
--- a/lisp/gnus/gnus-group.el 2010-09-26 04:03:19 +0000
+++ b/lisp/gnus/gnus-group.el 2010-09-30 08:39:23 +0000
@@ -2164,44 +2164,35 @@
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 @@
(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 @@
;; 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 @@
;; 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 @@
`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 @@
(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 @@
(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 @@
(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 @@
"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 @@
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 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 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 address@hidden
- (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))
=== modified file 'lisp/gnus/gnus-int.el'
--- a/lisp/gnus/gnus-int.el 2010-09-26 04:03:19 +0000
+++ b/lisp/gnus/gnus-int.el 2010-09-30 08:39:23 +0000
@@ -94,11 +94,10 @@
(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)
=== modified file 'lisp/gnus/gnus-msg.el'
--- a/lisp/gnus/gnus-msg.el 2010-09-02 00:55:51 +0000
+++ b/lisp/gnus/gnus-msg.el 2010-09-30 08:39:23 +0000
@@ -578,8 +578,8 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
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 @@
(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))
=== modified file 'lisp/gnus/gnus-registry.el'
--- a/lisp/gnus/gnus-registry.el 2010-09-18 10:02:19 +0000
+++ b/lisp/gnus/gnus-registry.el 2010-09-30 08:39:23 +0000
@@ -857,12 +857,11 @@
(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 @@
;;; 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)
=== modified file 'lisp/gnus/gnus-score.el'
--- a/lisp/gnus/gnus-score.el 2010-09-20 00:36:54 +0000
+++ b/lisp/gnus/gnus-score.el 2010-09-30 08:39:23 +0000
@@ -680,14 +680,14 @@
(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 @@
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: "))))
=== modified file 'lisp/gnus/gnus-srvr.el'
--- a/lisp/gnus/gnus-srvr.el 2010-09-26 04:03:19 +0000
+++ b/lisp/gnus/gnus-srvr.el 2010-09-30 08:39:23 +0000
@@ -571,8 +571,9 @@
(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 @@
(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
=== modified file 'lisp/gnus/gnus-sum.el'
--- a/lisp/gnus/gnus-sum.el 2010-09-27 23:07:47 +0000
+++ b/lisp/gnus/gnus-sum.el 2010-09-30 08:39:23 +0000
@@ -7999,10 +7999,9 @@
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 @@
(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 @@
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 @@
(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 @@
(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 @@
(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 @@
(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 "")
=== modified file 'lisp/gnus/gnus-topic.el'
--- a/lisp/gnus/gnus-topic.el 2010-09-18 10:02:19 +0000
+++ b/lisp/gnus/gnus-topic.el 2010-09-30 08:39:23 +0000
@@ -161,9 +161,7 @@
(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 @@
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 @@
"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 @@
(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 @@
(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 @@
(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 @@
"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 @@
(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)))
=== modified file 'lisp/gnus/gnus-util.el'
--- a/lisp/gnus/gnus-util.el 2010-09-26 23:01:31 +0000
+++ b/lisp/gnus/gnus-util.el 2010-09-30 08:39:23 +0000
@@ -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 @@
(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 @@
`(,(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)
=== modified file 'lisp/gnus/gnus.el'
--- a/lisp/gnus/gnus.el 2010-09-26 23:01:31 +0000
+++ b/lisp/gnus/gnus.el 2010-09-30 08:39:23 +0000
@@ -1427,6 +1427,7 @@
: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 @@
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))
=== modified file 'lisp/gnus/mm-decode.el'
--- a/lisp/gnus/mm-decode.el 2010-09-28 12:35:18 +0000
+++ b/lisp/gnus/mm-decode.el 2010-09-30 08:39:23 +0000
@@ -1323,11 +1323,11 @@
"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)
=== modified file 'lisp/gnus/mm-util.el'
--- a/lisp/gnus/mm-util.el 2010-09-29 01:09:50 +0000
+++ b/lisp/gnus/mm-util.el 2010-09-30 08:39:23 +0000
@@ -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 @@
'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 @@
(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)
=== modified file 'lisp/gnus/mm-view.el'
--- a/lisp/gnus/mm-view.el 2010-09-02 00:55:51 +0000
+++ b/lisp/gnus/mm-view.el 2010-09-30 08:39:23 +0000
@@ -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"))
=== modified file 'lisp/gnus/mml-smime.el'
--- a/lisp/gnus/mml-smime.el 2010-09-25 12:49:02 +0000
+++ b/lisp/gnus/mml-smime.el 2010-09-30 08:39:23 +0000
@@ -161,10 +161,10 @@
"")))))
(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 @@
(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
=== modified file 'lisp/gnus/mml.el'
--- a/lisp/gnus/mml.el 2010-09-02 00:55:51 +0000
+++ b/lisp/gnus/mml.el 2010-09-30 08:39:23 +0000
@@ -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 @@
;; 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 @@
(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 @@
(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"))
=== modified file 'lisp/gnus/nndoc.el'
--- a/lisp/gnus/nndoc.el 2010-09-26 23:01:31 +0000
+++ b/lisp/gnus/nndoc.el 2010-09-30 08:39:23 +0000
@@ -280,6 +280,11 @@
(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)
=== modified file 'lisp/gnus/nndraft.el'
--- a/lisp/gnus/nndraft.el 2010-09-26 23:01:31 +0000
+++ b/lisp/gnus/nndraft.el 2010-09-30 08:39:23 +0000
@@ -224,7 +224,7 @@
(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
=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el 2010-09-28 05:12:21 +0000
+++ b/lisp/gnus/nnimap.el 2010-09-30 08:39:23 +0000
@@ -70,6 +70,9 @@
"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 @@
(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 @@
(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 @@
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 @@
(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 @@
(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 @@
(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 @@
(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)))
=== modified file 'lisp/gnus/nnir.el'
--- a/lisp/gnus/nnir.el 2010-09-25 14:24:54 +0000
+++ b/lisp/gnus/nnir.el 2010-09-30 08:39:23 +0000
@@ -1588,7 +1588,7 @@
(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)))
=== modified file 'lisp/gnus/nnmairix.el'
--- a/lisp/gnus/nnmairix.el 2010-09-27 23:07:47 +0000
+++ b/lisp/gnus/nnmairix.el 2010-09-30 08:39:23 +0000
@@ -848,8 +848,8 @@
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 @@
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 @@
(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 @@
(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 @@
(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 @@
(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))
=== modified file 'lisp/gnus/nnrss.el'
--- a/lisp/gnus/nnrss.el 2010-09-29 01:09:50 +0000
+++ b/lisp/gnus/nnrss.el 2010-09-30 08:39:23 +0000
@@ -1048,9 +1048,9 @@
(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.
=== modified file 'lisp/gnus/pop3.el'
--- a/lisp/gnus/pop3.el 2010-09-22 06:01:22 +0000
+++ b/lisp/gnus/pop3.el 2010-09-30 08:39:23 +0000
@@ -82,6 +82,15 @@
: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 @@
(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))
=== modified file 'lisp/gnus/smime.el'
--- a/lisp/gnus/smime.el 2010-09-18 10:02:19 +0000
+++ b/lisp/gnus/smime.el 2010-09-30 08:39:23 +0000
@@ -371,12 +371,9 @@
(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 @@
(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 @@
(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.
=== modified file 'lisp/gnus/webmail.el'
--- a/lisp/gnus/webmail.el 2010-09-02 00:55:51 +0000
+++ b/lisp/gnus/webmail.el 2010-09-30 08:39:23 +0000
@@ -4,7 +4,7 @@
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <address@hidden>
-;; 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 "address@hidden"))
- (if (not (search-forward "<form>" nil t))
- (webmail-error "address@hidden"))
- (delete-region (point-min) (match-beginning 0))
- (if (not (search-forward "</form>" nil t))
- (webmail-error "address@hidden"))
- (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 "address@hidden"))
- (forward-line 14)
- (delete-region p (point))
- (goto-char (point-max))
- (unless (re-search-backward
- "<form name=\"Transfer2\"" p t)
- (webmail-error "address@hidden"))
- (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 "address@hidden"))
- (setq p1 (point))
- (if (search-backward "<IMG " p t)
- (progn
- (unless (re-search-forward
"HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t)
- (webmail-error "address@hidden"))
- (setq attachment (match-string 1))
- (setq type (match-string 2))
- (unless (search-forward "</TABLE>" nil t)
- (webmail-error "address@hidden"))
- (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: <address@hidden>\n" id
webmail-address)))
- (unless (looking-at "$")
- (if (search-forward "\n\n" nil t)
- (forward-line -1)
- (webmail-error "address@hidden")))
- (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 "address@hidden")))
-
-(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 "address@hidden"))
- (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 "address@hidden"))
- (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 "address@hidden"))
- (delete-region (point-min) (point))
- (unless (search-forward "<HR noshade>" nil t)
- (webmail-error "address@hidden"))
- (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 "address@hidden"))
- (unless (search-backward "</TT>" nil t)
- (webmail-error "address@hidden"))
- (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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r101689: Merge changes made in Gnus trunk.,
Katsumi Yamaoka <=