* Re: [Emacs-diffs] emacs-26 bd5795e: Fix url-copy-file arglist
2019-03-20 2:25 ` [Emacs-diffs] emacs-26 bd5795e: Fix url-copy-file arglist Stefan Monnier
@ 2019-05-16 15:50 ` Basil L. Contovounesios
2019-05-23 0:48 ` Basil L. Contovounesios
0 siblings, 1 reply; 3+ messages in thread
From: Basil L. Contovounesios @ 2019-05-16 15:50 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 471 bytes --]
Stefan Monnier <monnier@iro.umontreal.ca> writes:
>> (defun url-copy-file (url newname &optional ok-if-already-exists
>> - _keep-time _preserve-uid-gid)
>> + _keep-time _preserve-uid-gid _preserve-permissions)
>
> Maybe we should just do
>
> (defun url-copy-file (url newname &optional ok-if-already-exists &rest _)
I agree. More importantly, an integral ok-if-already-exists should be
handled as in copy-file. How's the following?
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-url-copy-file-argument-handling.patch --]
[-- Type: text/x-diff, Size: 13294 bytes --]
From 0174440692fccb4ffce902f8dfbfb597a08cc3df Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Thu, 16 May 2019 16:29:49 +0100
Subject: [PATCH] Fix url-copy-file argument handling
* lisp/url/url-handlers.el: Update autoloaded docstrings.
(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.
(url-insert): Fix indentation.
---
lisp/url/url-handlers.el | 137 +++++++++++++++++++--------------------
1 file changed, 66 insertions(+), 71 deletions(-)
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index e35d999e0f..9385e93d79 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 @@ url-handler-mode
(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 @@ url-file-handler-load-in-progress
;;;###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,41 +154,39 @@ url-file-handler
;; 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))
+(defun url-file-handler-identity (arg &rest _ignored)
+ ;; Identity function.
+ arg)
-;; These are operations that we can fully support
+;; 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 '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 '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)
+;; (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)
@@ -215,7 +214,7 @@ url-handler-expand-file-name
;; 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,29 +256,27 @@ url-handler-file-remote-p
;; `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)
@@ -287,7 +284,7 @@ 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."
@@ -312,11 +309,11 @@ url-insert
(if end (+ (point-min) end) (point-max)))
(buffer-string))))
(charset (mail-content-type-get (mm-handle-type handle)
- 'charset)))
+ 'charset)))
(mm-destroy-parts handle)
- (if charset
- (insert (mm-decode-string data (mm-charset-to-coding-system charset)))
- (insert data))
+ (insert (if charset
+ (mm-decode-string data (mm-charset-to-coding-system charset))
+ data))
(list (length data) charset)))
(defvar url-http-codes)
@@ -328,8 +325,8 @@ url-insert-buffer-contents
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)
@@ -340,10 +337,9 @@ url-insert-buffer-contents
(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)
@@ -367,7 +363,6 @@ url-insert-file-contents
;; Signal file-error per bug#16733.
(signal 'file-error (list url desc))))))
(url-insert-buffer-contents buffer url visit beg end replace)))
-
(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
(defun url-file-name-completion (url _directory &optional _predicate)
@@ -393,8 +388,8 @@ url-handlers-create-wrapper
(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))))))
@@ -407,12 +402,12 @@ url-handlers-create-wrapper
(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)
--
2.20.1
[-- Attachment #3: Type: text/plain, Size: 20 bytes --]
Thanks,
--
Basil
^ permalink raw reply related [flat|nested] 3+ messages in thread