aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBasil L. Contovounesios2019-05-16 16:29:49 +0100
committerBasil L. Contovounesios2019-05-23 01:41:00 +0100
commit72047556fa391016ab507c02c2f489c97b53f088 (patch)
treeb21262c27747e6231fc3bfc518922b5e711a2184
parent70839740214c5fac91536df8bd4cd7af23afa3b2 (diff)
downloademacs-72047556fa391016ab507c02c2f489c97b53f088.tar.gz
emacs-72047556fa391016ab507c02c2f489c97b53f088.zip
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.
-rw-r--r--lisp/url/url-handlers.el161
1 files changed, 78 insertions, 83 deletions
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 4988068293e..9d7837d8a7e 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -23,17 +23,17 @@
23 23
24;;; Code: 24;;; Code:
25 25
26;; (require 'url)
27(require 'url-parse) 26(require 'url-parse)
28;; (require 'url-util)
29(eval-when-compile (require 'mm-decode)) 27(eval-when-compile (require 'mm-decode))
30;; (require 'mailcap)
31(eval-when-compile (require 'subr-x)) 28(eval-when-compile (require 'subr-x))
32;; The following are autoloaded instead of `require'd to avoid eagerly 29;; The following are autoloaded instead of `require'd to avoid eagerly
33;; loading all of URL when turning on url-handler-mode in the .emacs. 30;; loading all of URL when turning on url-handler-mode in the .emacs.
34(autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") 31(autoload 'url-expand-file-name "url-expand"
35(autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") 32 "Convert URL to a fully specified URL, and canonicalize it.")
36(autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") 33(autoload 'mm-dissect-buffer "mm-decode"
34 "Dissect the current buffer and return a list of MIME handles.")
35(autoload 'url-scheme-get-property "url-methods"
36 "Get PROPERTY of a URL SCHEME.")
37 37
38;; Always used after mm-dissect-buffer and defined in the same file. 38;; Always used after mm-dissect-buffer and defined in the same file.
39(declare-function mm-save-part-to-file "mm-decode" (handle file)) 39(declare-function mm-save-part-to-file "mm-decode" (handle file))
@@ -112,15 +112,16 @@
112 (push (cons url-handler-regexp 'url-file-handler) 112 (push (cons url-handler-regexp 'url-file-handler)
113 file-name-handler-alist))) 113 file-name-handler-alist)))
114 114
115(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://" 115(defcustom url-handler-regexp
116 "\\`\\(?:https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://"
116 "Regular expression for URLs handled by `url-handler-mode'. 117 "Regular expression for URLs handled by `url-handler-mode'.
117When URL Handler mode is enabled, this regular expression is 118When URL Handler mode is enabled, this regular expression is
118added to `file-name-handler-alist'. 119added to `file-name-handler-alist'.
119 120
120Some valid URL protocols just do not make sense to visit 121Some valid URL protocols just do not make sense to visit
121interactively \(about, data, info, irc, mailto, etc.). This 122interactively (about, data, info, irc, mailto, etc.). This
122regular expression avoids conflicts with local files that look 123regular expression avoids conflicts with local files that look
123like URLs \(Gnus is particularly bad at this)." 124like URLs (Gnus is particularly bad at this)."
124 :group 'url 125 :group 'url
125 :type 'regexp 126 :type 'regexp
126 :version "25.1" 127 :version "25.1"
@@ -144,8 +145,8 @@ like URLs \(Gnus is particularly bad at this)."
144;;;###autoload 145;;;###autoload
145(defun url-file-handler (operation &rest args) 146(defun url-file-handler (operation &rest args)
146 "Function called from the `file-name-handler-alist' routines. 147 "Function called from the `file-name-handler-alist' routines.
147OPERATION is what needs to be done (`file-exists-p', etc). ARGS are 148OPERATION is what needs to be done (`file-exists-p', etc.).
148the arguments that would have been passed to OPERATION." 149ARGS are the arguments that would have been passed to OPERATION."
149 ;; Avoid recursive load. 150 ;; Avoid recursive load.
150 (if (and load-in-progress url-file-handler-load-in-progress) 151 (if (and load-in-progress url-file-handler-load-in-progress)
151 (url-run-real-handler operation args) 152 (url-run-real-handler operation args)
@@ -153,48 +154,46 @@ the arguments that would have been passed to OPERATION."
153 ;; Check, whether there are arguments we want pass to Tramp. 154 ;; Check, whether there are arguments we want pass to Tramp.
154 (if (catch :do 155 (if (catch :do
155 (dolist (url (cons default-directory args)) 156 (dolist (url (cons default-directory args))
156 (and (member 157 (and (stringp url)
157 (url-type (url-generic-parse-url (and (stringp url) url))) 158 (member (url-type (url-generic-parse-url url))
158 url-tramp-protocols) 159 url-tramp-protocols)
159 (throw :do t)))) 160 (throw :do t))))
160 (apply 'url-tramp-file-handler operation args) 161 (apply #'url-tramp-file-handler operation args)
161 ;; Otherwise, let's do the job. 162 ;; Otherwise, let's do the job.
162 (let ((fn (get operation 'url-file-handlers)) 163 (let ((fn (get operation 'url-file-handlers))
163 (val nil) 164 val)
164 (hooked nil)) 165 (if (and (not fn)
165 (if (and (not fn) (intern-soft (format "url-%s" operation))
166 (fboundp (intern-soft (format "url-%s" operation)))) 166 (fboundp (intern-soft (format "url-%s" operation))))
167 (error "Missing URL handler mapping for %s" operation)) 167 (error "Missing URL handler mapping for %s" operation))
168 (if fn 168 (setq val (if fn (save-match-data (apply fn args))
169 (setq hooked t 169 (url-run-real-handler operation args)))
170 val (save-match-data (apply fn args))) 170 (url-debug 'handlers "%s %S%S => %S" (if fn "Hooked" "Real")
171 (setq hooked nil
172 val (url-run-real-handler operation args)))
173 (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real")
174 operation args val) 171 operation args val)
175 val))))) 172 val)))))
176 173
177(defun url-file-handler-identity (&rest args) 174(defun url-file-handler-identity (arg &rest _ignored)
178 ;; Identity function 175 ;; Identity function.
179 (car args)) 176 arg)
180 177
181;; These are operations that we can fully support 178;; These are operations that we can fully support.
182(put 'file-readable-p 'url-file-handlers 'url-file-exists-p) 179(put 'file-readable-p 'url-file-handlers #'url-file-exists-p)
183(put 'substitute-in-file-name 'url-file-handlers 'url-file-handler-identity) 180(put 'substitute-in-file-name 'url-file-handlers #'url-file-handler-identity)
184(put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t)) 181(put 'file-name-absolute-p 'url-file-handlers (lambda (&rest _ignored) t))
185(put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name) 182(put 'expand-file-name 'url-file-handlers #'url-handler-expand-file-name)
186(put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name) 183(put 'directory-file-name 'url-file-handlers #'url-handler-directory-file-name)
187(put 'file-name-directory 'url-file-handlers 'url-handler-file-name-directory) 184(put 'file-name-directory 'url-file-handlers #'url-handler-file-name-directory)
188(put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory) 185(put 'unhandled-file-name-directory 'url-file-handlers
189(put 'file-remote-p 'url-file-handlers 'url-handler-file-remote-p) 186 #'url-handler-unhandled-file-name-directory)
190;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory) 187(put 'file-remote-p 'url-file-handlers #'url-handler-file-remote-p)
188;; (put 'file-name-as-directory 'url-file-handlers
189;; #'url-handler-file-name-as-directory)
191 190
192;; These are operations that we do not support yet (DAV!!!) 191;; These are operations that we do not support yet (DAV!!!)
193(put 'file-writable-p 'url-file-handlers 'ignore) 192(put 'file-writable-p 'url-file-handlers #'ignore)
194(put 'file-symlink-p 'url-file-handlers 'ignore) 193(put 'file-symlink-p 'url-file-handlers #'ignore)
195;; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v 194;; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v
196;; files and such since we can't do anything clever with them anyway. 195;; files and such since we can't do anything clever with them anyway.
197(put 'vc-registered 'url-file-handlers 'ignore) 196(put 'vc-registered 'url-file-handlers #'ignore)
198 197
199(defun url-handler-expand-file-name (file &optional base) 198(defun url-handler-expand-file-name (file &optional base)
200 ;; When we see "/foo/bar" in a file whose working dir is "http://bla/bla", 199 ;; 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."
215;; reversible: (f-n-a-d (d-f-n (f-n-a-d X))) == (f-n-a-d X) 214;; reversible: (f-n-a-d (d-f-n (f-n-a-d X))) == (f-n-a-d X)
216(defun url-handler-directory-file-name (dir) 215(defun url-handler-directory-file-name (dir)
217 ;; When there's more than a single /, just don't touch the slashes at all. 216 ;; When there's more than a single /, just don't touch the slashes at all.
218 (if (string-match "//\\'" dir) dir 217 (if (string-suffix-p "//" dir) dir
219 (url-run-real-handler 'directory-file-name (list dir)))) 218 (url-run-real-handler 'directory-file-name (list dir))))
220 219
221(defun url-handler-unhandled-file-name-directory (filename) 220(defun url-handler-unhandled-file-name-directory (filename)
@@ -257,44 +256,42 @@ the arguments that would have been passed to OPERATION."
257 ;; `url-handler-unhandled-file-name-directory'. 256 ;; `url-handler-unhandled-file-name-directory'.
258 nil))) 257 nil)))
259 258
260;; The actual implementation 259;; The actual implementation.
261;;;###autoload 260;;;###autoload
262(defun url-copy-file (url newname &optional ok-if-already-exists 261(defun url-copy-file (url newname &optional ok-if-already-exists &rest _ignored)
263 _keep-time _preserve-uid-gid _preserve-permissions) 262 "Copy URL to NEWNAME. Both arguments must be strings.
264 "Copy URL to NEWNAME. Both args must be strings. 263Signal a `file-already-exists' error if file NEWNAME already
265Signal a `file-already-exists' error if file NEWNAME already exists, 264exists, unless a third argument OK-IF-ALREADY-EXISTS is supplied
266unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. 265and non-nil. An integer as third argument means request
267A number as third arg means request confirmation if NEWNAME already exists. 266confirmation if NEWNAME already exists."
268This is what happens in interactive use with M-x. 267 (and (file-exists-p newname)
269Fourth arg KEEP-TIME non-nil means give the new file the same 268 (or (not ok-if-already-exists)
270last-modified time as the old one. (This works on only some systems.) 269 (and (integerp ok-if-already-exists)
271Args PRESERVE-UID-GID and PRESERVE-PERMISSIONS are ignored. 270 (not (yes-or-no-p
272A prefix arg makes KEEP-TIME non-nil." 271 (format "File %s already exists; copy to it anyway? "
273 (if (and (file-exists-p newname) 272 newname)))))
274 (not ok-if-already-exists)) 273 (signal 'file-already-exists (list "File already exists" newname)))
275 (signal 'file-already-exists (list "File exists" newname))) 274 (let* ((buffer (or (url-retrieve-synchronously url)
276 (let ((buffer (url-retrieve-synchronously url)) 275 (signal 'file-missing
277 (handle nil)) 276 (list "Opening URL"
278 (if (not buffer) 277 "No such file or directory" url))))
279 (signal 'file-missing (list "Opening URL" "No such file or directory" 278 (handle (with-current-buffer buffer
280 url))) 279 (mm-dissect-buffer t))))
281 (with-current-buffer buffer
282 (setq handle (mm-dissect-buffer t)))
283 (let ((mm-attachment-file-modes (default-file-modes))) 280 (let ((mm-attachment-file-modes (default-file-modes)))
284 (mm-save-part-to-file handle newname)) 281 (mm-save-part-to-file handle newname))
285 (kill-buffer buffer) 282 (kill-buffer buffer)
286 (mm-destroy-parts handle))) 283 (mm-destroy-parts handle)))
287(put 'copy-file 'url-file-handlers 'url-copy-file) 284(put 'copy-file 'url-file-handlers #'url-copy-file)
288 285
289;;;###autoload 286;;;###autoload
290(defun url-file-local-copy (url &rest ignored) 287(defun url-file-local-copy (url &rest _ignored)
291 "Copy URL into a temporary file on this machine. 288 "Copy URL into a temporary file on this machine.
292Returns the name of the local copy, or nil, if FILE is directly 289Returns the name of the local copy, or nil, if FILE is directly
293accessible." 290accessible."
294 (let ((filename (make-temp-file "url"))) 291 (let ((filename (make-temp-file "url")))
295 (url-copy-file url filename 'ok-if-already-exists) 292 (url-copy-file url filename 'ok-if-already-exists)
296 filename)) 293 filename))
297(put 'file-local-copy 'url-file-handlers 'url-file-local-copy) 294(put 'file-local-copy 'url-file-handlers #'url-file-local-copy)
298 295
299(defun url-insert (buffer &optional beg end) 296(defun url-insert (buffer &optional beg end)
300 "Insert the body of a URL object. 297 "Insert the body of a URL object.
@@ -330,8 +327,8 @@ This is like `url-insert', but also decodes the current buffer as
330if it had been inserted from a file named URL." 327if it had been inserted from a file named URL."
331 (if visit (setq buffer-file-name url)) 328 (if visit (setq buffer-file-name url))
332 (save-excursion 329 (save-excursion
333 (let* ((start (point)) 330 (let ((start (point))
334 (size-and-charset (url-insert buffer beg end))) 331 (size-and-charset (url-insert buffer beg end)))
335 (kill-buffer buffer) 332 (kill-buffer buffer)
336 (when replace 333 (when replace
337 (delete-region (point-min) start) 334 (delete-region (point-min) start)
@@ -342,10 +339,9 @@ if it had been inserted from a file named URL."
342 (decode-coding-inserted-region (point-min) (point) url 339 (decode-coding-inserted-region (point-min) (point) url
343 visit beg end replace)) 340 visit beg end replace))
344 (let ((inserted (car size-and-charset))) 341 (let ((inserted (car size-and-charset)))
345 (when (fboundp 'after-insert-file-set-coding) 342 (list url (or (and (fboundp 'after-insert-file-set-coding)
346 (let ((insval (after-insert-file-set-coding inserted visit))) 343 (after-insert-file-set-coding inserted visit))
347 (if insval (setq inserted insval)))) 344 inserted))))))
348 (list url inserted)))))
349 345
350;;;###autoload 346;;;###autoload
351(defun url-insert-file-contents (url &optional visit beg end replace) 347(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."
356 ;; instead. See bug#17549. 352 ;; instead. See bug#17549.
357 (url-http--insert-file-helper buffer url visit)) 353 (url-http--insert-file-helper buffer url visit))
358 (url-insert-buffer-contents buffer url visit beg end replace))) 354 (url-insert-buffer-contents buffer url visit beg end replace)))
359 355(put 'insert-file-contents 'url-file-handlers #'url-insert-file-contents)
360(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
361 356
362(defun url-file-name-completion (url _directory &optional _predicate) 357(defun url-file-name-completion (url _directory &optional _predicate)
363 ;; Even if it's not implemented, it's not an error to ask for completion, 358 ;; Even if it's not implemented, it's not an error to ask for completion,
364 ;; in case it's available (bug#14806). 359 ;; in case it's available (bug#14806).
365 ;; (error "Unimplemented") 360 ;; (error "Unimplemented")
366 url) 361 url)
367(put 'file-name-completion 'url-file-handlers 'url-file-name-completion) 362(put 'file-name-completion 'url-file-handlers #'url-file-name-completion)
368 363
369(defun url-file-name-all-completions (_file _directory) 364(defun url-file-name-all-completions (_file _directory)
370 ;; Even if it's not implemented, it's not an error to ask for completion, 365 ;; 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."
372 ;; (error "Unimplemented") 367 ;; (error "Unimplemented")
373 nil) 368 nil)
374(put 'file-name-all-completions 369(put 'file-name-all-completions
375 'url-file-handlers 'url-file-name-all-completions) 370 'url-file-handlers #'url-file-name-all-completions)
376 371
377;; All other handlers map onto their respective backends. 372;; All other handlers map onto their respective backends.
378(defmacro url-handlers-create-wrapper (method args) 373(defmacro url-handlers-create-wrapper (method args)
@@ -382,10 +377,10 @@ if it had been inserted from a file named URL."
382 (or (documentation method t) "No original documentation.")) 377 (or (documentation method t) "No original documentation."))
383 (setq url (url-generic-parse-url url)) 378 (setq url (url-generic-parse-url url))
384 (when (url-type url) 379 (when (url-type url)
385 (funcall (url-scheme-get-property (url-type url) (quote ,method)) 380 (funcall (url-scheme-get-property (url-type url) ',method)
386 ,@(remove '&rest (remove '&optional args))))) 381 ,@(remq '&rest (remq '&optional args)))))
387 (unless (get ',method 'url-file-handlers) 382 (unless (get ',method 'url-file-handlers)
388 (put ',method 'url-file-handlers ',(intern (format "url-%s" method)))))) 383 (put ',method 'url-file-handlers #',(intern (format "url-%s" method))))))
389 384
390(url-handlers-create-wrapper file-exists-p (url)) 385(url-handlers-create-wrapper file-exists-p (url))
391(url-handlers-create-wrapper file-attributes (url &optional id-format)) 386(url-handlers-create-wrapper file-attributes (url &optional id-format))
@@ -396,12 +391,12 @@ if it had been inserted from a file named URL."
396(url-handlers-create-wrapper directory-files (url &optional full match nosort)) 391(url-handlers-create-wrapper directory-files (url &optional full match nosort))
397(url-handlers-create-wrapper file-truename (url &optional counter prev-dirs)) 392(url-handlers-create-wrapper file-truename (url &optional counter prev-dirs))
398 393
399(add-hook 'find-file-hook 'url-handlers-set-buffer-mode) 394(add-hook 'find-file-hook #'url-handlers-set-buffer-mode)
400 395
401(defun url-handlers-set-buffer-mode () 396(defun url-handlers-set-buffer-mode ()
402 "Set correct modes for the current buffer if visiting a remote file." 397 "Set correct modes for the current buffer if visiting a remote file."
403 (and (stringp buffer-file-name) 398 (and buffer-file-name
404 (string-match url-handler-regexp buffer-file-name) 399 (string-match-p url-handler-regexp buffer-file-name)
405 (auto-save-mode 0))) 400 (auto-save-mode 0)))
406 401
407(provide 'url-handlers) 402(provide 'url-handlers)