Merge from trunk.

11 files changed, 302 insertions, 61 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 07f700f6987..8f96a838cc5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,31 @@
 2011-05-31  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        * minibuffer.el (complete-with-action): Return nil for the metadata and
+        boundaries of non-functional tables.
+        (completion-table-dynamic): Return nil for the metadata.
+        (completion-table-with-terminator): Add default case, using
+        complete-with-action.
+        (completion--metadata): New function.
+        (completion-all-sorted-completions, minibuffer-completion-help): Use it
+        to try and avoid pathological performance problems.
+        (completion--embedded-envvar-table): Return `category' metadata.
+
+2011-05-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * subr.el (process-alive-p): New tiny convenience function.
+
+2011-05-31  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/debug.el (debug): Save&restore not just the buffer's
+        content but also its previous major mode.
+
+2011-05-31  Helmut Eller  <eller.helmut@gmail.com>
+
+        * debug.el (debug): Restore the previous content of the
+        *Backtrace* buffer when we exit with C-M-c.
+
+2011-05-31  Stefan Monnier  <monnier@iro.umontreal.ca>
+
         * minibuffer.el: Add metadata method to completion tables.
         (completion-category-overrides): New defcustom.
         (completion-metadata, completion--field-metadata)
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 88633eaaa46..28962595ace 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -118,6 +118,10 @@ first will be printed into the backtrace buffer."
     (let (debugger-value
           (debug-on-error nil)
           (debug-on-quit nil)
+          (debugger-previous-state
+           (if (get-buffer "*Backtrace*")
+               (with-current-buffer (get-buffer "*Backtrace*")
+                 (list major-mode (buffer-string)))))
           (debugger-buffer (get-buffer-create "*Backtrace*"))
           (debugger-old-buffer (current-buffer))
           (debugger-step-after-exit nil)
@@ -214,8 +218,6 @@ first will be printed into the backtrace buffer."
               ;; recreate it every time the debugger stops, so instead we'll
               ;; erase it (and maybe hide it) but keep it alive.
               (with-current-buffer debugger-buffer
-                (erase-buffer)
-                (fundamental-mode)
                 (with-selected-window (get-buffer-window debugger-buffer 0)
                   (when (and (window-dedicated-p (selected-window))
                              (not debugger-will-be-back))
@@ -232,7 +234,17 @@ first will be printed into the backtrace buffer."
                     ;; to be left at the top-level, still working on how
                     ;; best to do that.
                     (bury-buffer))))
-            (kill-buffer debugger-buffer))
+            (unless debugger-previous-state
+              (kill-buffer debugger-buffer)))
+          ;; Restore the previous state of the debugger-buffer, in case we were
+          ;; in a recursive invocation of the debugger.
+          (when (and debugger-previous-state
+                     (buffer-live-p debugger-buffer))
+            (with-current-buffer debugger-buffer
+              (let ((inhibit-read-only t))
+                (erase-buffer)
+                (insert (nth 1 debugger-previous-state))
+                (funcall (nth 0 debugger-previous-state)))))
           (with-timeout-unsuspend debugger-with-timeout-suspend)
           (set-match-data debugger-outer-match-data)))
       ;; Put into effect the modified values of these variables
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index dcbc647950f..4cf21f65597 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,24 @@
+2011-05-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * shr.el (shr-rescale-image): Add an :ascent of 100 to images so that
+        the underline comes at the bottom.
+
+2011-05-31  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * gnus-registry.el (gnus-registry-article-marks-to-chars): Rename from
+        `gnus-registry-user-format-function-M' and declare the latter obsolete.
+        (gnus-registry-article-marks-to-names): Rename from
+        `gnus-registry-user-format-function-M2'.
+
+2011-05-31  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * gnus-sum.el (gnus-summary-exit): Make sure to kill article buffer in
+        ephemeral group.
+
+2011-05-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * shr.el (shr-browse-image): Copy the URL if called interactively.
+
 2011-05-30  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
         * gnus-group.el (gnus-group-mark-article-read): It's possible that we
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index e0efbaf4f30..f6c0daaaa93 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -62,10 +62,10 @@
 
 ;; show the marks as single characters (see the :char property in
 ;; `gnus-registry-marks'):
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M)
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
 
 ;; show the marks by name (see `gnus-registry-marks'):
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M2)
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
 
 ;; TODO:
 
@@ -897,9 +897,12 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
                  nil
                  (cons "Registry Marks" gnus-registry-misc-menus))))))
 
+(make-obsolete 'gnus-registry-user-format-function-M
+               'gnus-registry-article-marks-to-chars "24.1") ?
+
 ;; use like this:
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M)
-(defun gnus-registry-user-format-function-M (headers)
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
+(defun gnus-registry-article-marks-to-chars (headers)
   "Show the marks for an article by the :char property"
   (let* ((id (mail-header-message-id headers))
          (marks (when id (gnus-registry-get-id-key id 'mark))))
@@ -911,8 +914,8 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
                marks "")))
 
 ;; use like this:
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M2)
-(defun gnus-registry-user-format-function-M2 (headers)
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
+(defun gnus-registry-article-marks-to-names (headers)
   "Show the marks for an article by name"
   (let* ((id (mail-header-message-id headers))
          (marks (when id (gnus-registry-get-id-key id 'mark))))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 2d75c35158a..1c4382b24a6 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -7194,7 +7194,11 @@ If FORCE (the prefix), also save the .newsrc file(s)."
          (article-buffer gnus-article-buffer)
          (mode major-mode)
          (group-point nil)
-         (buf (current-buffer)))
+         (buf (current-buffer))
+         ;; `gnus-single-article-buffer' is nil buffer-locally in
+         ;; ephemeral group of which summary buffer will be killed,
+         ;; but the global value may be non-nil.
+         (single-article-buffer gnus-single-article-buffer))
     (unless quit-config
       ;; Do adaptive scoring, and possibly save score files.
       (when gnus-newsgroup-adaptive
@@ -7257,7 +7261,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
           (gnus-configure-windows 'group 'force)))
 
       ;; If we have several article buffers, we kill them at exit.
-      (unless gnus-single-article-buffer
+      (unless single-article-buffer
         (when (gnus-buffer-live-p article-buffer)
           (with-current-buffer article-buffer
             ;; Don't kill sticky article buffers
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index ebd854930df..67effc07ee2 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -183,14 +183,23 @@ redirects somewhere else."
         (message "No image under point")
       (message "%s" text))))
 
-(defun shr-browse-image ()
-  "Browse the image under point."
-  (interactive)
+(defun shr-browse-image (&optional copy-url)
+  "Browse the image under point.
+If COPY-URL (the prefix if called interactively) is non-nil, copy
+the URL of the image to the kill buffer instead."
+  (interactive "P")
   (let ((url (get-text-property (point) 'image-url)))
-    (if (not url)
-        (message "No image under point")
+    (cond
+     ((not url)
+      (message "No image under point"))
+     (copy-url
+      (with-temp-buffer
+        (insert url)
+        (copy-region-as-kill (point-min) (point-max))
+        (message "Copied %s" url)))
+     (t
       (message "Browsing %s..." url)
-      (browse-url url))))
+      (browse-url url)))))
 
 (defun shr-insert-image ()
   "Insert the image under point into the buffer."
@@ -524,8 +533,9 @@ redirects somewhere else."
 (defun shr-rescale-image (data)
   (if (or (not (fboundp 'imagemagick-types))
           (not (get-buffer-window (current-buffer))))
-      (create-image data nil t)
-    (let* ((image (create-image data nil t))
+      (create-image data nil t
+                    :ascent 100)
+    (let* ((image (create-image data nil t :ascent 100))
            (size (image-size image t))
            (width (car size))
            (height (cdr size))
@@ -544,11 +554,13 @@ redirects somewhere else."
       (when (> (car size) window-width)
         (setq image (or
                      (create-image data 'imagemagick t
-                                   :width window-width)
+                                   :width window-width
+                                   :ascent 100)
                      image)))
       (when (and (fboundp 'create-animated-image)
                  (eq (image-type data nil t) 'gif))
-        (setq image (create-animated-image data 'gif t)))
+        (setq image (create-animated-image data 'gif t
+                                           :ascent 100)))
       image)))
 
 ;; url-cache-extract autoloads url-cache.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 0f96f7905eb..972c65f62e3 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -26,11 +26,15 @@
 ;; internal use only.
 
 ;; Functional completion tables have an extended calling conventions:
-;; - The `action' can be (additionally to nil, t, and lambda) of the form
-;;   (boundaries . SUFFIX) in which case it should return
+;; The `action' can be (additionally to nil, t, and lambda) of the form
+;; - (boundaries . SUFFIX) in which case it should return
 ;;   (boundaries START . END).  See `completion-boundaries'.
 ;;   Any other return value should be ignored (so we ignore values returned
 ;;   from completion tables that don't know about this new `action' form).
+;; - `metadata' in which case it should return (metadata . ALIST) where
+;;   ALIST is the metadata of this table.  See `completion-metadata'.
+;;   Any other return value should be ignored (so we ignore values returned
+;;   from completion tables that don't know about this new `action' form).
 
 ;;; Bugs:
 
@@ -107,7 +111,8 @@ E.g. for simple completion tables, the result is always (0 . (length SUFFIX))
 and for file names the result is the positions delimited by
 the closest directory separators."
   (let ((boundaries (if (functionp table)
-                        (funcall table string pred (cons 'boundaries suffix)))))
+                        (funcall table string pred
+                                 (cons 'boundaries suffix)))))
     (if (not (eq (car-safe boundaries) 'boundaries))
         (setq boundaries nil))
     (cons (or (cadr boundaries) 0)
@@ -125,7 +130,8 @@ This metadata is an alist.  Currently understood keys are:
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
 - `cycle-sort-function': function to sort entries when cycling.
-   Works like `display-sort-function'."
+   Works like `display-sort-function'.
+The metadata of a completion table should be constant between two boundaries."
   (let ((metadata (if (functionp table)
                       (funcall table string pred 'metadata))))
     (if (eq (car-safe metadata) 'metadata)
@@ -160,8 +166,8 @@ PRED is a completion predicate.
 ACTION can be one of nil, t or `lambda'."
   (cond
    ((functionp table) (funcall table string pred action))
-   ((eq (car-safe action) 'boundaries)
-    (cons 'boundaries (completion-boundaries string table pred (cdr action))))
+   ((eq (car-safe action) 'boundaries) nil)
+   ((eq action 'metadata) nil)
    (t
     (funcall
      (cond
@@ -182,7 +188,7 @@ The result of the `completion-table-dynamic' form is a function
 that can be used as the COLLECTION argument to `try-completion' and
 `all-completions'.  See Info node `(elisp)Programmed Completion'."
   (lambda (string pred action)
-    (if (eq (car-safe action) 'boundaries)
+    (if (or (eq (car-safe action) 'boundaries) (eq action 'metadata))
         ;; `fun' is not supposed to return another function but a plain old
         ;; completion table, whose boundaries are always trivial.
         nil
@@ -287,18 +293,18 @@ instead of a string, a function that takes the completion and returns the
                 (funcall terminator comp)
               (concat comp terminator))
           comp))))
-   ((eq action t)
+   ;; completion-table-with-terminator is always used for
+   ;; "sub-completions" so it's only called if the terminator is missing,
+   ;; in which case `test-completion' should return nil.
+   ((eq action 'lambda) nil)
+   (t
     ;; FIXME: We generally want the `try' and `all' behaviors to be
     ;; consistent so pcm can merge the `all' output to get the `try' output,
     ;; but that sometimes clashes with the need for `all' output to look
     ;; good in *Completions*.
     ;; (mapcar (lambda (s) (concat s terminator))
     ;;         (all-completions string table pred))))
-    (all-completions string table pred))
-   ;; completion-table-with-terminator is always used for
-   ;; "sub-completions" so it's only called if the terminator is missing,
-   ;; in which case `test-completion' should return nil.
-   ((eq action 'lambda) nil)))
+    (complete-with-action action table string pred))))
 
 (defun completion-table-with-predicate (table pred1 strict string pred2 action)
   "Make a completion table equivalent to TABLE but filtered through PRED1.
@@ -769,22 +775,33 @@ scroll the window of possible completions."
   (setq completion-cycling nil)
   (setq completion-all-sorted-completions nil))
 
+(defun completion--metadata (string base md-at-point table pred)
+  ;; Like completion-metadata, but for the specific case of getting the
+  ;; metadata at `base', which tends to trigger pathological behavior for old
+  ;; completion tables which don't understand `metadata'.
+  (let ((bounds (completion-boundaries string table pred "")))
+    (if (eq (car bounds) base) md-at-point
+      (completion-metadata (substring string 0 base) table pred))))
+
 (defun completion-all-sorted-completions ()
   (or completion-all-sorted-completions
       (let* ((start (field-beginning))
              (end (field-end))
              (string (buffer-substring start end))
+             (md (completion--field-metadata start))
              (all (completion-all-completions
                    string
                    minibuffer-completion-table
                    minibuffer-completion-predicate
                    (- (point) start)
-                   (completion--field-metadata start)))
+                   md))
              (last (last all))
              (base-size (or (cdr last) 0))
-             (all-md (completion-metadata (substring string 0 base-size)
-                                          minibuffer-completion-table
-                                          minibuffer-completion-predicate))
+             (all-md (completion--metadata (buffer-substring-no-properties
+                                            start (point))
+                                           base-size md
+                                           minibuffer-completion-table
+                                           minibuffer-completion-predicate))
              (sort-fun (completion-metadata-get all-md 'cycle-sort-function)))
         (when last
           (setcdr last nil)
@@ -1272,12 +1289,13 @@ variables.")
   (let* ((start (field-beginning))
          (end (field-end))
          (string (field-string))
+         (md (completion--field-metadata start))
          (completions (completion-all-completions
                        string
                        minibuffer-completion-table
                        minibuffer-completion-predicate
                        (- (point) (field-beginning))
-                       (completion--field-metadata start))))
+                       md)))
     (message nil)
     (if (or (null completions)
             (and (not (consp (cdr completions)))
@@ -1293,12 +1311,11 @@ variables.")
       (let* ((last (last completions))
              (base-size (cdr last))
              (prefix (unless (zerop base-size) (substring string 0 base-size)))
-             ;; FIXME: This function is for the output of all-completions,
-             ;; not completion-all-completions.  Often it's the same, but
-             ;; not always.
-             (all-md (completion-metadata (substring string 0 base-size)
-                                          minibuffer-completion-table
-                                          minibuffer-completion-predicate))
+             (all-md (completion--metadata (buffer-substring-no-properties
+                                            start (point))
+                                           base-size md
+                                           minibuffer-completion-table
+                                           minibuffer-completion-predicate))
              (afun (or (completion-metadata-get all-md 'annotation-function)
                        (plist-get completion-extra-properties
                                   :annotation-function)
@@ -1673,8 +1690,8 @@ same as `substitute-in-file-name'."
         ;; other table that provides the "main" completion.  Let the
         ;; other table handle the test-completion case.
         nil)
-       ((eq (car-safe action) 'boundaries)
-        ;; Only return boundaries if there's something to complete,
+       ((or (eq (car-safe action) 'boundaries) (eq action 'metadata))
+        ;; Only return boundaries/metadata if there's something to complete,
         ;; since otherwise when we're used in
         ;; completion-table-in-turn, we could return boundaries and
         ;; let some subsequent table return a list of completions.
@@ -1684,11 +1701,13 @@ same as `substitute-in-file-name'."
         (when (try-completion (substring string beg) table nil)
           ;; Compute the boundaries of the subfield to which this
           ;; completion applies.
-          (let ((suffix (cdr action)))
-            (list* 'boundaries
-                   (or (match-beginning 2) (match-beginning 1))
-                   (when (string-match "[^[:alnum:]_]" suffix)
-                     (match-beginning 0))))))
+          (if (eq action 'metadata)
+              '(metadata (category . environment-variable))
+            (let ((suffix (cdr action)))
+              (list* 'boundaries
+                     (or (match-beginning 2) (match-beginning 1))
+                     (when (string-match "[^[:alnum:]_]" suffix)
+                       (match-beginning 0)))))))
        (t
         (if (eq (aref string (1- beg)) ?{)
             (setq table (apply-partially 'completion-table-with-terminator
@@ -2299,7 +2318,8 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
            (case-fold-search completion-ignore-case)
            (completion-regexp-list (cons regex completion-regexp-list))
            (compl (all-completions
-                   (concat prefix (if (stringp (car pattern)) (car pattern) ""))
+                   (concat prefix
+                           (if (stringp (car pattern)) (car pattern) ""))
                    table pred)))
       (if (not (functionp table))
           ;; The internal functions already obeyed completion-regexp-list.
@@ -2397,13 +2417,14 @@ filter out additional entries (because TABLE migth not obey PRED)."
                                    (- (length newbeforepoint)
                                       (car newbounds)))))
                   (dolist (submatch suball)
-                    (setq all (nconc (mapcar
-                                      (lambda (s) (concat submatch between s))
-                                      (funcall filter
-                                               (completion-pcm--all-completions
-                                                (concat subprefix submatch between)
-                                                pattern table pred)))
-                                     all)))
+                    (setq all (nconc
+                               (mapcar
+                                (lambda (s) (concat submatch between s))
+                                (funcall filter
+                                         (completion-pcm--all-completions
+                                          (concat subprefix submatch between)
+                                          pattern table pred)))
+                               all)))
                   ;; FIXME: This can come in handy for try-completion,
                   ;; but isn't right for all-completions, since it lists
                   ;; invalid completions.
diff --git a/lisp/subr.el b/lisp/subr.el
index 4fe9987b95b..08099dc1fdd 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1805,6 +1805,13 @@ Signal an error if the program returns with a non-zero exit status."
           (forward-line 1))
         (nreverse lines)))))
 
+(defun process-alive-p (process)
+  "Returns non-nil if PROCESS is alive.
+A process is considered alive if its status is `run', `open',
+`listen', `connect' or `stop'."
+  (memq (process-status process)
+        '(run open listen connect stop)))
+
 ;; compatibility
 
 (make-obsolete
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 37a9fb8ffe2..1f2784fe656 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,12 @@
+2011-05-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * url-queue.el (url-queue-parallel-processes): Increase the
+        default to 6, since 2 seems too conservative for normal usage.
+
+2011-05-31  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * url-future.el: Add general futures facility.
+
 2011-05-29  Leo Liu  <sdl.web@gmail.com>
 
         * url-cookie.el (url-cookie): Add option :named so that
diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el
new file mode 100644
index 00000000000..334c4fa9126
--- /dev/null
+++ b/lisp/url/url-future.el
@@ -0,0 +1,126 @@
+;;; url-future.el --- general futures facility for url.el
+
+;; Copyright (C) 2011  Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Keywords: data
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Make a url-future (basically a defstruct):
+;; (make-url-future :value (lambda () (calculation goes here))
+;;   :callback (lambda (future) (use future on success))
+;;   :errorback (lambda (future &rest error) (error handler)))
+
+;; Then either call it with `url-future-call' or cancel it with
+;; `url-future-cancel'.  Generally the functions will return the
+;; future itself, not the value it holds.  Also the functions will
+;; throw a url-future-already-done error if you try to call or cancel
+;; a future more than once.
+
+;; So, to get the value:
+;; (when (url-future-completed-p future) (url-future-value future))
+
+;; See the ERT tests and the code for futher details.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'ert))
+
+(defstruct url-future callback errorback status value)
+
+(defmacro url-future-done-p (url-future)
+  `(url-future-status ,url-future))
+
+(defmacro url-future-completed-p (url-future)
+  `(eq (url-future-status ,url-future) t))
+
+(defmacro url-future-errored-p (url-future)
+  `(eq (url-future-status ,url-future) 'error))
+
+(defmacro url-future-cancelled-p (url-future)
+  `(eq (url-future-status ,url-future) 'cancel))
+
+(defun url-future-finish (url-future &optional status)
+  (if (url-future-done-p url-future)
+      (signal 'error 'url-future-already-done)
+    (setf (url-future-status url-future) (or status t))
+    ;; the status must be such that the future was completed
+    ;; to run the callback
+    (when (url-future-completed-p url-future)
+      (funcall (or (url-future-callback url-future) 'ignore)
+               url-future))
+    url-future))
+
+(defun url-future-errored (url-future errorcons)
+  (if (url-future-done-p url-future)
+      (signal 'error 'url-future-already-done)
+    (setf (url-future-status url-future) 'error)
+    (setf (url-future-value url-future) errorcons)
+    (funcall (or (url-future-errorback url-future) 'ignore)
+             url-future errorcons)))
+
+(defun url-future-call (url-future)
+  (if (url-future-done-p url-future)
+      (signal 'error 'url-future-already-done)
+    (let ((ff (url-future-value url-future)))
+      (when (functionp ff)
+        (condition-case catcher
+            (setf (url-future-value url-future)
+                  (funcall ff))
+          (error (url-future-errored url-future catcher)))
+        (url-future-value url-future)))
+    (if (url-future-errored-p url-future)
+        url-future
+      (url-future-finish url-future))))
+
+(defun url-future-cancel (url-future)
+  (if (url-future-done-p url-future)
+      (signal 'error 'url-future-already-done)
+    (url-future-finish url-future 'cancel)))
+
+(ert-deftest url-future-test ()
+  (let* ((text "running future")
+         (good (make-url-future :value (lambda () (format text))
+                                :callback (lambda (f) (set 'saver f))))
+         (bad (make-url-future :value (lambda () (/ 1 0))
+                               :errorback (lambda (&rest d) (set 'saver d))))
+         (tocancel (make-url-future :value (lambda () (/ 1 0))
+                                    :callback (lambda (f) (set 'saver f))
+                                    :errorback (lambda (&rest d)
+                                                 (set 'saver d))))
+         saver)
+    (should (equal good (url-future-call good)))
+    (should (equal good saver))
+    (should (equal text (url-future-value good)))
+    (should (url-future-completed-p good))
+    (should-error (url-future-call good))
+    (setq saver nil)
+    (should (equal bad (url-future-call bad)))
+    (should-error (url-future-call bad))
+    (should (equal saver (list bad '(arith-error))))
+    (should (url-future-errored-p bad))
+    (setq saver nil)
+    (should (equal (url-future-cancel tocancel) tocancel))
+    (should-error (url-future-call tocancel))
+    (should (null saver))
+    (should (url-future-cancelled-p tocancel))))
+
+(provide 'url-future)
+;;; url-future.el ends here
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index 08496ad5afb..e6c8537c469 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -31,7 +31,7 @@
 (eval-when-compile (require 'cl))
 (require 'browse-url)
 
-(defcustom url-queue-parallel-processes 2
+(defcustom url-queue-parallel-processes 6
   "The number of concurrent processes."
   :type 'integer
   :group 'url)