From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: "Basil L. Contovounesios" Newsgroups: gmane.emacs.devel Subject: Re: [Emacs-diffs] emacs-26 bd5795e: Fix url-copy-file arglist Date: Thu, 16 May 2019 16:50:21 +0100 Message-ID: <874l5uv1oi.fsf@tcd.ie> References: <20190320015752.17217.37491@vcs0.savannah.gnu.org> <20190320015752.D768B20552@vcs0.savannah.gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="69934"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu May 16 17:50:46 2019 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:256) (Exim 4.89) (envelope-from ) id 1hRIeb-000I5v-Ki for ged-emacs-devel@m.gmane.org; Thu, 16 May 2019 17:50:45 +0200 Original-Received: from localhost ([127.0.0.1]:60195 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hRIea-0005iW-K0 for ged-emacs-devel@m.gmane.org; Thu, 16 May 2019 11:50:44 -0400 Original-Received: from eggs.gnu.org ([209.51.188.92]:42112) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hRIeL-0005cJ-EP for emacs-devel@gnu.org; Thu, 16 May 2019 11:50:31 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hRIeJ-0005YP-6u for emacs-devel@gnu.org; Thu, 16 May 2019 11:50:29 -0400 Original-Received: from mail-ed1-x52c.google.com ([2a00:1450:4864:20::52c]:36272) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hRIeH-0005UN-2M for emacs-devel@gnu.org; Thu, 16 May 2019 11:50:25 -0400 Original-Received: by mail-ed1-x52c.google.com with SMTP id a8so5946700edx.3 for ; Thu, 16 May 2019 08:50:24 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tcd-ie.20150623.gappssmtp.com; s=20150623; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=TU7cLzoBfpmxi5UPU0YwKft/gvglHPhsdepcny1E/nM=; b=dIQ7FQh+aCBgsxx+RiWFWTCO52uBt1ygRkHrHL6kj5bDa4GZ5qTe0agx4r9zyqBOex +DZ4thmA+Z4l/avYZTaTmc19GE4QKtWE3wOl2avm96uJv3bFEdTfyptmtMICURzgs5ZQ USH4WUYKL8Gwj58njbyXg98L2c8pyMbhETbxKO3473SZo5+sIbLcrcrJyeqUtf3BZXsj +lfaCwauth8ex04Np2P2NzszGG7GDCbq8jZWcjYPlwP8nfjpHLgwpKYFUkNVYunqeTc/ NwrJW+5Js1DomueQYVqT0QoQoSaELWDJb5kIzm3mVh3uV1YjeTh4pLBXT3Yjkuf1ZczL +mqA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=TU7cLzoBfpmxi5UPU0YwKft/gvglHPhsdepcny1E/nM=; b=YECO2IOrLyv95kI/Au0F9DhJBUhvS5mICWOPWoPMbP1mOw1idhXtEn2R5XMbI9kJZ2 4r/pUUwYXl2N1RIVov1Q/tw7OjZtV0IyWGb5SqYmznD0908Vcyq8A4gbZKwM57CBalRZ 0Bcu2AVfF0hl5BH8nGUoSC71BrZ1CIsNvKadHxjRmuyDWLJzK0RjB4dZK03z2B2eFaAq l75HG6zBvV31ogV2S2BZNVhZipL7uVWK5mK/wJ9aehelbdnzf7rUtkqcLE5XEt1EaHMF BC+tcJyposUz/29GeVNZZkePffE1N7wY9S3sdEJWqvaaZE6ZNdOJZoG1Evqk1oyrsPut b5Fw== X-Gm-Message-State: APjAAAW+PvAVATeEhs27OhWNFpFoYhMhed52+WFl416i1VyAQ1SSblb1 UM8vOH/Dt79iClA1qc9tjxTbOL/ms48= X-Google-Smtp-Source: APXvYqzuMbH01GWVA+nUwsDj3t9sld6+q3Ep5Gd5IDzOtevNI+i/Fji/iNenGOY7358m6cQBql+J8A== X-Received: by 2002:aa7:c391:: with SMTP id k17mr51124548edq.166.1558021823365; Thu, 16 May 2019 08:50:23 -0700 (PDT) Original-Received: from localhost ([134.226.214.210]) by smtp.gmail.com with ESMTPSA id k18sm1963722eda.92.2019.05.16.08.50.22 (version=TLS1_3 cipher=AEAD-AES256-GCM-SHA384 bits=256/256); Thu, 16 May 2019 08:50:22 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Tue, 19 Mar 2019 22:25:38 -0400") X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:4864:20::52c X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:236586 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier 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? --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Fix-url-copy-file-argument-handling.patch >From 0174440692fccb4ffce902f8dfbfb597a08cc3df Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" 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 --=-=-= Content-Type: text/plain Thanks, -- Basil --=-=-=--