diff options
| author | Basil L. Contovounesios | 2019-05-16 16:29:49 +0100 |
|---|---|---|
| committer | Basil L. Contovounesios | 2019-05-23 01:41:00 +0100 |
| commit | 72047556fa391016ab507c02c2f489c97b53f088 (patch) | |
| tree | b21262c27747e6231fc3bfc518922b5e711a2184 | |
| parent | 70839740214c5fac91536df8bd4cd7af23afa3b2 (diff) | |
| download | emacs-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.el | 161 |
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'. |
| 117 | When URL Handler mode is enabled, this regular expression is | 118 | When URL Handler mode is enabled, this regular expression is |
| 118 | added to `file-name-handler-alist'. | 119 | added to `file-name-handler-alist'. |
| 119 | 120 | ||
| 120 | Some valid URL protocols just do not make sense to visit | 121 | 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 |
| 122 | regular expression avoids conflicts with local files that look | 123 | 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)." |
| 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. |
| 147 | OPERATION is what needs to be done (`file-exists-p', etc). ARGS are | 148 | OPERATION is what needs to be done (`file-exists-p', etc.). |
| 148 | the arguments that would have been passed to OPERATION." | 149 | ARGS 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. | 263 | Signal a `file-already-exists' error if file NEWNAME already |
| 265 | Signal a `file-already-exists' error if file NEWNAME already exists, | 264 | exists, unless a third argument OK-IF-ALREADY-EXISTS is supplied |
| 266 | unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. | 265 | and non-nil. An integer as third argument means request |
| 267 | A number as third arg means request confirmation if NEWNAME already exists. | 266 | confirmation if NEWNAME already exists." |
| 268 | This is what happens in interactive use with M-x. | 267 | (and (file-exists-p newname) |
| 269 | Fourth arg KEEP-TIME non-nil means give the new file the same | 268 | (or (not ok-if-already-exists) |
| 270 | last-modified time as the old one. (This works on only some systems.) | 269 | (and (integerp ok-if-already-exists) |
| 271 | Args PRESERVE-UID-GID and PRESERVE-PERMISSIONS are ignored. | 270 | (not (yes-or-no-p |
| 272 | A 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. |
| 292 | Returns the name of the local copy, or nil, if FILE is directly | 289 | Returns the name of the local copy, or nil, if FILE is directly |
| 293 | accessible." | 290 | accessible." |
| 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 | |||
| 330 | if it had been inserted from a file named URL." | 327 | if 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) |