bug#74208: 31.0.50; minibuffer read-file-name-default mutates global value of default-directory incorrectly

[Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

>>> The problem is that the parameter DIR == "http://example.com" was
>>> getting bound to default-directory with undesirable results.
>
>> It can also have desirable results sometimes (depends on the URL at point
>> and what kind of support for URLs you have in your Emacs, admittedly).
>> Do you happen to have a more realistic scenario than your "echo foo"
>> that lets us better judge the severity of the problem, and maybe other
>> ways to solve the actual problem?
>
> Are you saying it is ok for emacs to make all calls to `call-prcoess'
> to unconditionally fail --- when emacs is waiting for input at the
> minibuffer?  the calls to call-process can come from anywhere, from
> timers, or from outside via emacsclient, etc.

`default-directory` can point to random places, including non-existing
directories, HTTP places (e.g. if you enable `url-handler-mode`), so
code like timers need to take this possibility into account, yes.
The ffap minibuffer discussed here is just one of many other ways to get
into this situation.

> I already posted that any hypothetical completion facilites are
> singularly useless for the task of ffap (url) -- to get the url at
> point into the minibuffer and maybe manually edit it.  If these
> facilities exist and you are using them, I'd like to see an example.

diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 9edc7865a74..17013345c25 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -375,18 +375,48 @@ url-insert-file-contents-literally
     (kill-buffer buffer)
     nil))
 
-(defun url-file-name-completion (url _directory &optional _predicate)
-  ;; Even if it's not implemented, it's not an error to ask for completion,
-  ;; in case it's available (bug#14806).
-  ;; (error "Unimplemented")
-  url)
+(defun url-file-name-completion (url directory &optional predicate)
+  (let ((all (url-file-name-all-completions url directory)))
+    (if (null all)
+        ;; If `url' is the empty string, don't return nil, so as to prevent
+        ;; partial-completion from recursing into the parent directory.
+        (if (equal url "") url)
+      (try-completion url all predicate))))
 (put 'file-name-completion 'url-file-handlers #'url-file-name-completion)
 
-(defun url-file-name-all-completions (_file _directory)
-  ;; Even if it's not implemented, it's not an error to ask for completion,
-  ;; in case it's available (bug#14806).
-  ;; (error "Unimplemented")
-  nil)
+(defvar url-handler-temp-buf)
+
+(defun url-file-name-all-completions (file directory)
+  ;; FIXME: Cache the "directory" buffers between completion requests.
+  (let ((buf (get-file-buffer directory)))
+    (unless buf
+      (setq buf (ignore-errors (find-file-noselect directory)))
+      (when buf
+        (with-current-buffer buf
+          (set (make-local-variable 'url-handler-temp-buf) t))))
+    (when buf
+      (unwind-protect
+          (with-current-buffer buf
+            (save-excursion
+              (let ((all ())
+                    (case-fold-search t)
+                    ;; FIXME: Handle URL-quoting.
+                    (regexp (format "<a href=\"\\(%s[^\"]+\\)\"" file)))
+                (goto-char (point-min))
+                (while (re-search-forward regexp nil t)
+                  (let ((url (match-string 1)))
+                    (unless (string-match
+                             "\\`\\(?:\\.\\.\\|[#?/]\\|[-a-z]+:/\\)\\|" url)
+                      ;; It's a relative URL.
+                      (when (string-match "[#?]\\|/\\(.\\)" url)
+                        (setq url (substring url (or (match-beginning 1)
+                                                     (match-beginning 0)))))
+                      ;; FIXME: Handle URL-unquoting.
+                      (push url all))))
+                all)))
+        (and (buffer-live-p buf)
+             (buffer-local-value 'url-handler-temp-buf buf)
+             (kill-buffer buf))))))
 (put 'file-name-all-completions
      'url-file-handlers #'url-file-name-all-completions)