Skip to content

Commit 7204755

Browse files
committed
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.
1 parent 7083974 commit 7204755

File tree

1 file changed

+78
-83
lines changed

1 file changed

+78
-83
lines changed

lisp/url/url-handlers.el

Lines changed: 78 additions & 83 deletions
Original file line numberDiff line numberDiff line change
@@ -23,17 +23,17 @@
2323

2424
;;; Code:
2525

26-
;; (require 'url)
2726
(require 'url-parse)
28-
;; (require 'url-util)
2927
(eval-when-compile (require 'mm-decode))
30-
;; (require 'mailcap)
3128
(eval-when-compile (require 'subr-x))
3229
;; The following are autoloaded instead of `require'd to avoid eagerly
3330
;; 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.")
35-
(autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.")
36-
(autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.")
31+
(autoload 'url-expand-file-name "url-expand"
32+
"Convert URL to a fully specified URL, and canonicalize it.")
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.")
3737

3838
;; Always used after mm-dissect-buffer and defined in the same file.
3939
(declare-function mm-save-part-to-file "mm-decode" (handle file))
@@ -112,15 +112,16 @@
112112
(push (cons url-handler-regexp 'url-file-handler)
113113
file-name-handler-alist)))
114114

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\\)://"
116117
"Regular expression for URLs handled by `url-handler-mode'.
117118
When URL Handler mode is enabled, this regular expression is
118119
added to `file-name-handler-alist'.
119120
120121
Some valid URL protocols just do not make sense to visit
121-
interactively \(about, data, info, irc, mailto, etc.). This
122+
interactively (about, data, info, irc, mailto, etc.). This
122123
regular expression avoids conflicts with local files that look
123-
like URLs \(Gnus is particularly bad at this)."
124+
like URLs (Gnus is particularly bad at this)."
124125
:group 'url
125126
:type 'regexp
126127
:version "25.1"
@@ -144,57 +145,55 @@ like URLs \(Gnus is particularly bad at this)."
144145
;;;###autoload
145146
(defun url-file-handler (operation &rest args)
146147
"Function called from the `file-name-handler-alist' routines.
147-
OPERATION is what needs to be done (`file-exists-p', etc). ARGS are
148-
the arguments that would have been passed to OPERATION."
148+
OPERATION is what needs to be done (`file-exists-p', etc.).
149+
ARGS are the arguments that would have been passed to OPERATION."
149150
;; Avoid recursive load.
150151
(if (and load-in-progress url-file-handler-load-in-progress)
151152
(url-run-real-handler operation args)
152153
(let ((url-file-handler-load-in-progress load-in-progress))
153154
;; Check, whether there are arguments we want pass to Tramp.
154155
(if (catch :do
155156
(dolist (url (cons default-directory args))
156-
(and (member
157-
(url-type (url-generic-parse-url (and (stringp url) url)))
158-
url-tramp-protocols)
157+
(and (stringp url)
158+
(member (url-type (url-generic-parse-url url))
159+
url-tramp-protocols)
159160
(throw :do t))))
160-
(apply 'url-tramp-file-handler operation args)
161+
(apply #'url-tramp-file-handler operation args)
161162
;; Otherwise, let's do the job.
162163
(let ((fn (get operation 'url-file-handlers))
163-
(val nil)
164-
(hooked nil))
165-
(if (and (not fn) (intern-soft (format "url-%s" operation))
164+
val)
165+
(if (and (not fn)
166166
(fboundp (intern-soft (format "url-%s" operation))))
167167
(error "Missing URL handler mapping for %s" operation))
168-
(if fn
169-
(setq hooked t
170-
val (save-match-data (apply fn args)))
171-
(setq hooked nil
172-
val (url-run-real-handler operation args)))
173-
(url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real")
168+
(setq val (if fn (save-match-data (apply fn args))
169+
(url-run-real-handler operation args)))
170+
(url-debug 'handlers "%s %S%S => %S" (if fn "Hooked" "Real")
174171
operation args val)
175172
val)))))
176173

177-
(defun url-file-handler-identity (&rest args)
178-
;; Identity function
179-
(car args))
180-
181-
;; These are operations that we can fully support
182-
(put 'file-readable-p 'url-file-handlers 'url-file-exists-p)
183-
(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))
185-
(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)
187-
(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)
189-
(put 'file-remote-p 'url-file-handlers 'url-handler-file-remote-p)
190-
;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory)
174+
(defun url-file-handler-identity (arg &rest _ignored)
175+
;; Identity function.
176+
arg)
177+
178+
;; These are operations that we can fully support.
179+
(put 'file-readable-p 'url-file-handlers #'url-file-exists-p)
180+
(put 'substitute-in-file-name 'url-file-handlers #'url-file-handler-identity)
181+
(put 'file-name-absolute-p 'url-file-handlers (lambda (&rest _ignored) t))
182+
(put 'expand-file-name 'url-file-handlers #'url-handler-expand-file-name)
183+
(put 'directory-file-name 'url-file-handlers #'url-handler-directory-file-name)
184+
(put 'file-name-directory 'url-file-handlers #'url-handler-file-name-directory)
185+
(put 'unhandled-file-name-directory 'url-file-handlers
186+
#'url-handler-unhandled-file-name-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)
191190

192191
;; These are operations that we do not support yet (DAV!!!)
193-
(put 'file-writable-p 'url-file-handlers 'ignore)
194-
(put 'file-symlink-p 'url-file-handlers 'ignore)
192+
(put 'file-writable-p 'url-file-handlers #'ignore)
193+
(put 'file-symlink-p 'url-file-handlers #'ignore)
195194
;; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v
196195
;; 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)
198197

199198
(defun url-handler-expand-file-name (file &optional base)
200199
;; 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."
215214
;; reversible: (f-n-a-d (d-f-n (f-n-a-d X))) == (f-n-a-d X)
216215
(defun url-handler-directory-file-name (dir)
217216
;; 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
219218
(url-run-real-handler 'directory-file-name (list dir))))
220219

221220
(defun url-handler-unhandled-file-name-directory (filename)
@@ -257,44 +256,42 @@ the arguments that would have been passed to OPERATION."
257256
;; `url-handler-unhandled-file-name-directory'.
258257
nil)))
259258

260-
;; The actual implementation
259+
;; The actual implementation.
261260
;;;###autoload
262-
(defun url-copy-file (url newname &optional ok-if-already-exists
263-
_keep-time _preserve-uid-gid _preserve-permissions)
264-
"Copy URL to NEWNAME. Both args must be strings.
265-
Signal a `file-already-exists' error if file NEWNAME already exists,
266-
unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
267-
A number as third arg means request confirmation if NEWNAME already exists.
268-
This is what happens in interactive use with M-x.
269-
Fourth arg KEEP-TIME non-nil means give the new file the same
270-
last-modified time as the old one. (This works on only some systems.)
271-
Args PRESERVE-UID-GID and PRESERVE-PERMISSIONS are ignored.
272-
A prefix arg makes KEEP-TIME non-nil."
273-
(if (and (file-exists-p newname)
274-
(not ok-if-already-exists))
275-
(signal 'file-already-exists (list "File exists" newname)))
276-
(let ((buffer (url-retrieve-synchronously url))
277-
(handle nil))
278-
(if (not buffer)
279-
(signal 'file-missing (list "Opening URL" "No such file or directory"
280-
url)))
281-
(with-current-buffer buffer
282-
(setq handle (mm-dissect-buffer t)))
261+
(defun url-copy-file (url newname &optional ok-if-already-exists &rest _ignored)
262+
"Copy URL to NEWNAME. Both arguments must be strings.
263+
Signal a `file-already-exists' error if file NEWNAME already
264+
exists, unless a third argument OK-IF-ALREADY-EXISTS is supplied
265+
and non-nil. An integer as third argument means request
266+
confirmation if NEWNAME already exists."
267+
(and (file-exists-p newname)
268+
(or (not ok-if-already-exists)
269+
(and (integerp ok-if-already-exists)
270+
(not (yes-or-no-p
271+
(format "File %s already exists; copy to it anyway? "
272+
newname)))))
273+
(signal 'file-already-exists (list "File already exists" newname)))
274+
(let* ((buffer (or (url-retrieve-synchronously url)
275+
(signal 'file-missing
276+
(list "Opening URL"
277+
"No such file or directory" url))))
278+
(handle (with-current-buffer buffer
279+
(mm-dissect-buffer t))))
283280
(let ((mm-attachment-file-modes (default-file-modes)))
284281
(mm-save-part-to-file handle newname))
285282
(kill-buffer buffer)
286283
(mm-destroy-parts handle)))
287-
(put 'copy-file 'url-file-handlers 'url-copy-file)
284+
(put 'copy-file 'url-file-handlers #'url-copy-file)
288285

289286
;;;###autoload
290-
(defun url-file-local-copy (url &rest ignored)
287+
(defun url-file-local-copy (url &rest _ignored)
291288
"Copy URL into a temporary file on this machine.
292289
Returns the name of the local copy, or nil, if FILE is directly
293290
accessible."
294291
(let ((filename (make-temp-file "url")))
295292
(url-copy-file url filename 'ok-if-already-exists)
296293
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)
298295

299296
(defun url-insert (buffer &optional beg end)
300297
"Insert the body of a URL object.
@@ -330,8 +327,8 @@ This is like `url-insert', but also decodes the current buffer as
330327
if it had been inserted from a file named URL."
331328
(if visit (setq buffer-file-name url))
332329
(save-excursion
333-
(let* ((start (point))
334-
(size-and-charset (url-insert buffer beg end)))
330+
(let ((start (point))
331+
(size-and-charset (url-insert buffer beg end)))
335332
(kill-buffer buffer)
336333
(when replace
337334
(delete-region (point-min) start)
@@ -342,10 +339,9 @@ if it had been inserted from a file named URL."
342339
(decode-coding-inserted-region (point-min) (point) url
343340
visit beg end replace))
344341
(let ((inserted (car size-and-charset)))
345-
(when (fboundp 'after-insert-file-set-coding)
346-
(let ((insval (after-insert-file-set-coding inserted visit)))
347-
(if insval (setq inserted insval))))
348-
(list url inserted)))))
342+
(list url (or (and (fboundp 'after-insert-file-set-coding)
343+
(after-insert-file-set-coding inserted visit))
344+
inserted))))))
349345

350346
;;;###autoload
351347
(defun url-insert-file-contents (url &optional visit beg end replace)
@@ -356,23 +352,22 @@ if it had been inserted from a file named URL."
356352
;; instead. See bug#17549.
357353
(url-http--insert-file-helper buffer url visit))
358354
(url-insert-buffer-contents buffer url visit beg end replace)))
359-
360-
(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
355+
(put 'insert-file-contents 'url-file-handlers #'url-insert-file-contents)
361356

362357
(defun url-file-name-completion (url _directory &optional _predicate)
363358
;; Even if it's not implemented, it's not an error to ask for completion,
364359
;; in case it's available (bug#14806).
365360
;; (error "Unimplemented")
366361
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)
368363

369364
(defun url-file-name-all-completions (_file _directory)
370365
;; Even if it's not implemented, it's not an error to ask for completion,
371366
;; in case it's available (bug#14806).
372367
;; (error "Unimplemented")
373368
nil)
374369
(put 'file-name-all-completions
375-
'url-file-handlers 'url-file-name-all-completions)
370+
'url-file-handlers #'url-file-name-all-completions)
376371

377372
;; All other handlers map onto their respective backends.
378373
(defmacro url-handlers-create-wrapper (method args)
@@ -382,10 +377,10 @@ if it had been inserted from a file named URL."
382377
(or (documentation method t) "No original documentation."))
383378
(setq url (url-generic-parse-url url))
384379
(when (url-type url)
385-
(funcall (url-scheme-get-property (url-type url) (quote ,method))
386-
,@(remove '&rest (remove '&optional args)))))
380+
(funcall (url-scheme-get-property (url-type url) ',method)
381+
,@(remq '&rest (remq '&optional args)))))
387382
(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))))))
389384

390385
(url-handlers-create-wrapper file-exists-p (url))
391386
(url-handlers-create-wrapper file-attributes (url &optional id-format))
@@ -396,12 +391,12 @@ if it had been inserted from a file named URL."
396391
(url-handlers-create-wrapper directory-files (url &optional full match nosort))
397392
(url-handlers-create-wrapper file-truename (url &optional counter prev-dirs))
398393

399-
(add-hook 'find-file-hook 'url-handlers-set-buffer-mode)
394+
(add-hook 'find-file-hook #'url-handlers-set-buffer-mode)
400395

401396
(defun url-handlers-set-buffer-mode ()
402397
"Set correct modes for the current buffer if visiting a remote file."
403-
(and (stringp buffer-file-name)
404-
(string-match url-handler-regexp buffer-file-name)
398+
(and buffer-file-name
399+
(string-match-p url-handler-regexp buffer-file-name)
405400
(auto-save-mode 0)))
406401

407402
(provide 'url-handlers)

0 commit comments

Comments
 (0)