1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-03-01 03:11:09 -08:00

Merge remote-tracking branch 'savannah/master' into HEAD

This commit is contained in:
Andrea Corallo 2020-05-07 10:24:30 +01:00
commit 92dc81f85e
5 changed files with 53 additions and 40 deletions

View file

@ -92,7 +92,6 @@ If no match is found here, `browse-url-handlers' and
If no match is found, just call `dnd-insert-text'. WINDOW is
where the drop happened, ACTION is the action for the drop, URL
is what has been dropped. Returns ACTION."
(require 'browse-url)
(let (ret)
(or
(catch 'done
@ -102,19 +101,11 @@ is what has been dropped. Returns ACTION."
(throw 'done t)))
nil)
(catch 'done
(require 'browse-url) ;; browse-url-handlers is not autoloaded.
(dolist (bf (append
;; The alist choice of browse-url-browser-function
;; is deprecated since 28.1, so the (unless ...)
;; can be removed at some point in time.
(unless (functionp browse-url-browser-function)
browse-url-browser-function)
browse-url-handlers
browse-url-default-handlers))
(when (string-match (car bf) url)
(setq ret 'private)
(funcall (cdr bf) url action)
(throw 'done t)))
(let ((browser (browse-url-select-handler url)))
(when browser
(setq ret 'private)
(funcall browser url action)
(throw 'done t)))
nil)
(progn
(dnd-insert-text window action url)

View file

@ -601,10 +601,17 @@ down (this *won't* always work)."
"Calls `browse-url-man-function' with URL and ARGS."
(funcall browse-url-man-function url args))
(defun browse-url--browser (url &rest args)
"Calls `browse-url-browser-function' with URL and ARGS."
(funcall browse-url-browser-function url args))
;;;###autoload
(defvar browse-url-default-handlers
'(("\\`mailto:" . browse-url--mailto)
("\\`man:" . browse-url--man)
;; Render file:// URLs if they are HTML pages, otherwise just find
;; the file.
("\\`file://.*\\.html?\\b" . browse-url--browser)
("\\`file://" . browse-url-emacs))
"Like `browse-url-handlers' but populated by Emacs and packages.
@ -628,6 +635,32 @@ match, the URL is opened using the value of
:value-type (function :tag "Handler"))
:version "28.1")
;;;###autoload
(defun browse-url-select-handler (url)
"Return a handler suitable for browsing URL.
This searches `browse-url-handlers', and
`browse-url-default-handlers' for a matching handler. Return nil
if no handler is found.
Currently, it also consults `browse-url-browser-function' first
if it is set to an alist, although this usage is deprecated since
Emacs 28.1 and will be removed in a future release."
(catch 'custom-url-handler
(dolist (regex-handler
(append
;; The alist choice of browse-url-browser-function
;; is deprecated since 28.1, so the (unless ...)
;; can be removed at some point in time.
(when (and (consp browse-url-browser-function)
(not (functionp browse-url-browser-function)))
(warn "Having `browse-url-browser-function' set to an
alist is deprecated. Use `browse-url-handlers' instead.")
browse-url-browser-function)
browse-url-handlers
browse-url-default-handlers))
(when (string-match-p (car regex-handler) url)
(throw 'custom-url-handler (cdr regex-handler))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL encoding
@ -821,14 +854,8 @@ If ARGS are omitted, the default is to pass
(not (string-match "\\`[a-z]+:" url)))
(setq url (expand-file-name url)))
(let ((process-environment (copy-sequence process-environment))
(function
(catch 'custom-url-handler
(dolist (regex-handler (append browse-url-handlers
browse-url-default-handlers))
(when (string-match-p (car regex-handler) url)
(throw 'custom-url-handler (cdr regex-handler))))
;; No special handler found.
browse-url-browser-function))
(function (or (browse-url-select-handler url)
browse-url-browser-function))
;; Ensure that `default-directory' exists and is readable (bug#6077).
(default-directory (or (unhandled-file-name-directory default-directory)
(expand-file-name "~/"))))
@ -837,24 +864,9 @@ If ARGS are omitted, the default is to pass
;; which may not even exist any more.
(if (stringp (frame-parameter nil 'display))
(setenv "DISPLAY" (frame-parameter nil 'display)))
(if (and (consp function)
(not (functionp function)))
;; The `function' can be an alist; look down it for first
;; match and apply the function (which might be a lambda).
;; However, this usage is deprecated as of Emacs 28.1.
(progn
(warn "Having `browse-url-browser-function' set to an
alist is deprecated. Use `browse-url-handlers' instead.")
(catch 'done
(dolist (bf function)
(when (string-match (car bf) url)
(apply (cdr bf) url args)
(throw 'done t)))
(error "No browse-url-browser-function matching URL %s"
url)))
;; Unbound symbols go down this leg, since void-function from
;; apply is clearer than wrong-type-argument from dolist.
(apply function url args))))
(if (functionp nil)
(apply function url args)
(error "No suitable browser for URL %s" url))))
;;;###autoload
(defun browse-url-at-point (&optional arg)

View file

@ -918,6 +918,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(kill-buffer (tramp-get-connection-buffer v))
(setq ret 1)))
;; Handle signals.
(when (and (natnump ret) (> ret 128))
(setq ret (format "Signal %d" (- ret 128))))
;; Provide error file.
(when tmpstderr (rename-file tmpstderr (cadr destination) t))

View file

@ -3159,6 +3159,10 @@ STDERR can also be a file name."
(kill-buffer (tramp-get-connection-buffer v))
(setq ret 1)))
;; Handle signals.
(when (and (natnump ret) (> ret 128))
(setq ret (format "Signal %d" (- ret 128))))
;; Provide error file.
(when tmpstderr (rename-file tmpstderr (cadr destination) t))

View file

@ -4209,6 +4209,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should-not (zerop (process-file "false")))
(should-not (zerop (process-file "binary-does-not-exist")))
(should (= 42 (process-file "sh" nil nil nil "-c" "exit 42")))
;; Return string in case the process is interrupted.
(should (stringp (process-file "sh" nil nil nil "-c" "kill -2 $$")))
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))