[Emacs-diffs] master 7204755: Fix url-copy-file argument handling

[Basil L. Contovounesios]

branch: master
commit 72047556fa391016ab507c02c2f489c97b53f088
Author: Basil L. Contovounesios <address@hidden>
Commit: Basil L. Contovounesios <address@hidden>

    Fix url-copy-file argument handling
    
    For discussion, see the following thread:
    https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00500.html
    * lisp/url/url-handlers.el: Update autoloaded docstrings.
    Quote function symbols as such.
    (url-handler-regexp): Make grouping construct shy.
    (url-file-handler, url-insert-buffer-contents)
    (url-handlers-create-wrapper, url-handlers-set-buffer-mode):
    Simplify.
    (url-file-handler-identity): Clarify calling convention.
    (file-name-absolute-p, url-file-local-copy): Mark ignored arguments
    as such.
    (url-handler-directory-file-name): Prefer string comparison over
    regexp match where either will do.
    (url-copy-file): Handle integer as third argument as per copy-file.
---
 lisp/url/url-handlers.el | 161 +++++++++++++++++++++++------------------------
 1 file changed, 78 insertions(+), 83 deletions(-)

diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 4988068..9d7837d 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -23,17 +23,17 @@
 
 ;;; Code:
 
-;; (require 'url)
 (require 'url-parse)
-;; (require 'url-util)
 (eval-when-compile (require 'mm-decode))
-;; (require 'mailcap)
 (eval-when-compile (require 'subr-x))
 ;; The following are autoloaded instead of `require'd to avoid eagerly
 ;; loading all of URL when turning on url-handler-mode in the .emacs.
-(autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified 
url, and canonicalize it.")
-(autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and 
return a list of MIME handles.")
-(autoload 'url-scheme-get-property "url-methods" "Get property of a URL 
SCHEME.")
+(autoload 'url-expand-file-name "url-expand"
+  "Convert URL to a fully specified URL, and canonicalize it.")
+(autoload 'mm-dissect-buffer "mm-decode"
+  "Dissect the current buffer and return a list of MIME handles.")
+(autoload 'url-scheme-get-property "url-methods"
+  "Get PROPERTY of a URL SCHEME.")
 
 ;; Always used after mm-dissect-buffer and defined in the same file.
 (declare-function mm-save-part-to-file "mm-decode" (handle file))
@@ -112,15 +112,16 @@
       (push (cons url-handler-regexp 'url-file-handler)
            file-name-handler-alist)))
 
-(defcustom url-handler-regexp 
"\\`\\(https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://"
+(defcustom url-handler-regexp
+  "\\`\\(?:https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://"
   "Regular expression for URLs handled by `url-handler-mode'.
 When URL Handler mode is enabled, this regular expression is
 added to `file-name-handler-alist'.
 
 Some valid URL protocols just do not make sense to visit
-interactively \(about, data, info, irc, mailto, etc.).  This
+interactively (about, data, info, irc, mailto, etc.).  This
 regular expression avoids conflicts with local files that look
-like URLs \(Gnus is particularly bad at this)."
+like URLs (Gnus is particularly bad at this)."
   :group 'url
   :type 'regexp
   :version "25.1"
@@ -144,8 +145,8 @@ like URLs \(Gnus is particularly bad at this)."
 ;;;###autoload
 (defun url-file-handler (operation &rest args)
   "Function called from the `file-name-handler-alist' routines.
-OPERATION is what needs to be done (`file-exists-p', etc).  ARGS are
-the arguments that would have been passed to OPERATION."
+OPERATION is what needs to be done (`file-exists-p', etc.).
+ARGS are the arguments that would have been passed to OPERATION."
   ;; Avoid recursive load.
   (if (and load-in-progress url-file-handler-load-in-progress)
       (url-run-real-handler operation args)
@@ -153,48 +154,46 @@ the arguments that would have been passed to OPERATION."
       ;; Check, whether there are arguments we want pass to Tramp.
       (if (catch :do
             (dolist (url (cons default-directory args))
-              (and (member
-                    (url-type (url-generic-parse-url (and (stringp url) url)))
-                    url-tramp-protocols)
+              (and (stringp url)
+                   (member (url-type (url-generic-parse-url url))
+                           url-tramp-protocols)
                    (throw :do t))))
-          (apply 'url-tramp-file-handler operation args)
+          (apply #'url-tramp-file-handler operation args)
         ;; Otherwise, let's do the job.
         (let ((fn (get operation 'url-file-handlers))
-              (val nil)
-              (hooked nil))
-          (if (and (not fn) (intern-soft (format "url-%s" operation))
+              val)
+          (if (and (not fn)
                    (fboundp (intern-soft (format "url-%s" operation))))
               (error "Missing URL handler mapping for %s" operation))
-          (if fn
-              (setq hooked t
-                    val (save-match-data (apply fn args)))
-            (setq hooked nil
-                  val (url-run-real-handler operation args)))
-          (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real")
+          (setq val (if fn (save-match-data (apply fn args))
+                      (url-run-real-handler operation args)))
+          (url-debug 'handlers "%s %S%S => %S" (if fn "Hooked" "Real")
                      operation args val)
           val)))))
 
-(defun url-file-handler-identity (&rest args)
-  ;; Identity function
-  (car args))
-
-;; These are operations that we can fully support
-(put 'file-readable-p 'url-file-handlers 'url-file-exists-p)
-(put 'substitute-in-file-name 'url-file-handlers 'url-file-handler-identity)
-(put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t))
-(put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name)
-(put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name)
-(put 'file-name-directory 'url-file-handlers 'url-handler-file-name-directory)
-(put 'unhandled-file-name-directory 'url-file-handlers 
'url-handler-unhandled-file-name-directory)
-(put 'file-remote-p 'url-file-handlers 'url-handler-file-remote-p)
-;; (put 'file-name-as-directory 'url-file-handlers 
'url-handler-file-name-as-directory)
+(defun url-file-handler-identity (arg &rest _ignored)
+  ;; Identity function.
+  arg)
+
+;; These are operations that we can fully support.
+(put 'file-readable-p 'url-file-handlers #'url-file-exists-p)
+(put 'substitute-in-file-name 'url-file-handlers #'url-file-handler-identity)
+(put 'file-name-absolute-p 'url-file-handlers (lambda (&rest _ignored) t))
+(put 'expand-file-name 'url-file-handlers #'url-handler-expand-file-name)
+(put 'directory-file-name 'url-file-handlers #'url-handler-directory-file-name)
+(put 'file-name-directory 'url-file-handlers #'url-handler-file-name-directory)
+(put 'unhandled-file-name-directory 'url-file-handlers
+     #'url-handler-unhandled-file-name-directory)
+(put 'file-remote-p 'url-file-handlers #'url-handler-file-remote-p)
+;; (put 'file-name-as-directory 'url-file-handlers
+;;      #'url-handler-file-name-as-directory)
 
 ;; These are operations that we do not support yet (DAV!!!)
-(put 'file-writable-p 'url-file-handlers 'ignore)
-(put 'file-symlink-p 'url-file-handlers 'ignore)
+(put 'file-writable-p 'url-file-handlers #'ignore)
+(put 'file-symlink-p 'url-file-handlers #'ignore)
 ;; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v
 ;; files and such since we can't do anything clever with them anyway.
-(put 'vc-registered 'url-file-handlers 'ignore)
+(put 'vc-registered 'url-file-handlers #'ignore)
 
 (defun url-handler-expand-file-name (file &optional base)
   ;; When we see "/foo/bar" in a file whose working dir is "http://bla/bla";,
@@ -215,7 +214,7 @@ the arguments that would have been passed to OPERATION."
 ;; reversible:  (f-n-a-d (d-f-n (f-n-a-d X))) == (f-n-a-d X)
 (defun url-handler-directory-file-name (dir)
   ;; When there's more than a single /, just don't touch the slashes at all.
-  (if (string-match "//\\'" dir) dir
+  (if (string-suffix-p "//" dir) dir
     (url-run-real-handler 'directory-file-name (list dir))))
 
 (defun url-handler-unhandled-file-name-directory (filename)
@@ -257,44 +256,42 @@ the arguments that would have been passed to OPERATION."
       ;; `url-handler-unhandled-file-name-directory'.
       nil)))
 
-;; The actual implementation
+;; The actual implementation.
 ;;;###autoload
-(defun url-copy-file (url newname &optional ok-if-already-exists
-                          _keep-time _preserve-uid-gid _preserve-permissions)
-  "Copy URL to NEWNAME.  Both args must be strings.
-Signal a `file-already-exists' error if file NEWNAME already exists,
-unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
-A number as third arg means request confirmation if NEWNAME already exists.
-This is what happens in interactive use with M-x.
-Fourth arg KEEP-TIME non-nil means give the new file the same
-last-modified time as the old one.  (This works on only some systems.)
-Args PRESERVE-UID-GID and PRESERVE-PERMISSIONS are ignored.
-A prefix arg makes KEEP-TIME non-nil."
-  (if (and (file-exists-p newname)
-          (not ok-if-already-exists))
-      (signal 'file-already-exists (list "File exists" newname)))
-  (let ((buffer (url-retrieve-synchronously url))
-       (handle nil))
-    (if (not buffer)
-        (signal 'file-missing (list "Opening URL" "No such file or directory"
-                                    url)))
-    (with-current-buffer buffer
-      (setq handle (mm-dissect-buffer t)))
+(defun url-copy-file (url newname &optional ok-if-already-exists &rest 
_ignored)
+  "Copy URL to NEWNAME.  Both arguments must be strings.
+Signal a `file-already-exists' error if file NEWNAME already
+exists, unless a third argument OK-IF-ALREADY-EXISTS is supplied
+and non-nil.  An integer as third argument means request
+confirmation if NEWNAME already exists."
+  (and (file-exists-p newname)
+       (or (not ok-if-already-exists)
+           (and (integerp ok-if-already-exists)
+                (not (yes-or-no-p
+                      (format "File %s already exists; copy to it anyway? "
+                              newname)))))
+       (signal 'file-already-exists (list "File already exists" newname)))
+  (let* ((buffer (or (url-retrieve-synchronously url)
+                     (signal 'file-missing
+                             (list "Opening URL"
+                                   "No such file or directory" url))))
+         (handle (with-current-buffer buffer
+                   (mm-dissect-buffer t))))
     (let ((mm-attachment-file-modes (default-file-modes)))
       (mm-save-part-to-file handle newname))
     (kill-buffer buffer)
     (mm-destroy-parts handle)))
-(put 'copy-file 'url-file-handlers 'url-copy-file)
+(put 'copy-file 'url-file-handlers #'url-copy-file)
 
 ;;;###autoload
-(defun url-file-local-copy (url &rest ignored)
+(defun url-file-local-copy (url &rest _ignored)
   "Copy URL into a temporary file on this machine.
 Returns the name of the local copy, or nil, if FILE is directly
 accessible."
   (let ((filename (make-temp-file "url")))
     (url-copy-file url filename 'ok-if-already-exists)
     filename))
-(put 'file-local-copy 'url-file-handlers 'url-file-local-copy)
+(put 'file-local-copy 'url-file-handlers #'url-file-local-copy)
 
 (defun url-insert (buffer &optional beg end)
   "Insert the body of a URL object.
@@ -330,8 +327,8 @@ This is like `url-insert', but also decodes the current 
buffer as
 if it had been inserted from a file named URL."
   (if visit (setq buffer-file-name url))
   (save-excursion
-    (let* ((start (point))
-           (size-and-charset (url-insert buffer beg end)))
+    (let ((start (point))
+          (size-and-charset (url-insert buffer beg end)))
       (kill-buffer buffer)
       (when replace
         (delete-region (point-min) start)
@@ -342,10 +339,9 @@ if it had been inserted from a file named URL."
         (decode-coding-inserted-region (point-min) (point) url
                                        visit beg end replace))
       (let ((inserted (car size-and-charset)))
-        (when (fboundp 'after-insert-file-set-coding)
-          (let ((insval (after-insert-file-set-coding inserted visit)))
-            (if insval (setq inserted insval))))
-        (list url inserted)))))
+        (list url (or (and (fboundp 'after-insert-file-set-coding)
+                           (after-insert-file-set-coding inserted visit))
+                      inserted))))))
 
 ;;;###autoload
 (defun url-insert-file-contents (url &optional visit beg end replace)
@@ -356,15 +352,14 @@ if it had been inserted from a file named URL."
       ;; instead.  See bug#17549.
       (url-http--insert-file-helper buffer url visit))
     (url-insert-buffer-contents buffer url visit beg end replace)))
-
-(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
+(put 'insert-file-contents 'url-file-handlers #'url-insert-file-contents)
 
 (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)
-(put 'file-name-completion 'url-file-handlers 'url-file-name-completion)
+(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,
@@ -372,7 +367,7 @@ if it had been inserted from a file named URL."
   ;; (error "Unimplemented")
   nil)
 (put 'file-name-all-completions
-     'url-file-handlers 'url-file-name-all-completions)
+     'url-file-handlers #'url-file-name-all-completions)
 
 ;; All other handlers map onto their respective backends.
 (defmacro url-handlers-create-wrapper (method args)
@@ -382,10 +377,10 @@ if it had been inserted from a file named URL."
                 (or (documentation method t) "No original documentation."))
        (setq url (url-generic-parse-url url))
        (when (url-type url)
-         (funcall (url-scheme-get-property (url-type url) (quote ,method))
-                  ,@(remove '&rest (remove '&optional args)))))
+         (funcall (url-scheme-get-property (url-type url) ',method)
+                  ,@(remq '&rest (remq '&optional args)))))
      (unless (get ',method 'url-file-handlers)
-       (put ',method 'url-file-handlers ',(intern (format "url-%s" method))))))
+       (put ',method 'url-file-handlers #',(intern (format "url-%s" 
method))))))
 
 (url-handlers-create-wrapper file-exists-p (url))
 (url-handlers-create-wrapper file-attributes (url &optional id-format))
@@ -396,12 +391,12 @@ if it had been inserted from a file named URL."
 (url-handlers-create-wrapper directory-files (url &optional full match nosort))
 (url-handlers-create-wrapper file-truename (url &optional counter prev-dirs))
 
-(add-hook 'find-file-hook 'url-handlers-set-buffer-mode)
+(add-hook 'find-file-hook #'url-handlers-set-buffer-mode)
 
 (defun url-handlers-set-buffer-mode ()
   "Set correct modes for the current buffer if visiting a remote file."
-  (and (stringp buffer-file-name)
-       (string-match url-handler-regexp buffer-file-name)
+  (and buffer-file-name
+       (string-match-p url-handler-regexp buffer-file-name)
        (auto-save-mode 0)))
 
 (provide 'url-handlers)