mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-30 04:10:54 -08:00
ffap: Don't switch window unless needed
When using ffap-other-window, don't change the window configuration unless a new buffer has actually been created (Bug#25352). * lisp/ffap.el (ffap-other-frame): Don't change the window configuration if no new buffer has been created. * test/lisp/ffap-tests.el (ffap-other-window--bug-25352): Add unit test.
This commit is contained in:
parent
d354fc3828
commit
ace38bafa6
2 changed files with 16 additions and 8 deletions
11
lisp/ffap.el
11
lisp/ffap.el
|
|
@ -1768,14 +1768,9 @@ Return value:
|
|||
"Like `ffap', but put buffer in another window.
|
||||
Only intended for interactive use."
|
||||
(interactive)
|
||||
(let (value)
|
||||
(switch-to-buffer-other-window
|
||||
(save-window-excursion
|
||||
(setq value (call-interactively 'ffap))
|
||||
(unless (or (bufferp value) (bufferp (car-safe value)))
|
||||
(setq value (current-buffer)))
|
||||
(current-buffer)))
|
||||
value))
|
||||
(pcase (save-window-excursion (call-interactively 'ffap))
|
||||
((or (and (pred bufferp) b) `(,(and (pred bufferp) b) . ,_))
|
||||
(switch-to-buffer-other-window b))))
|
||||
|
||||
(defun ffap-other-frame ()
|
||||
"Like `ffap', but put buffer in another frame.
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'ert)
|
||||
(require 'ffap)
|
||||
|
||||
|
|
@ -66,6 +67,18 @@ Host = example.com\n")
|
|||
(let ((ffap-gopher-regexp nil))
|
||||
(should-not (ffap-gopher-at-point)))))
|
||||
|
||||
(ert-deftest ffap-other-window--bug-25352 ()
|
||||
"Test for Bug#25352. Checks that the window configuration is
|
||||
left alone when opening a URL in an external browser."
|
||||
(cl-letf* ((old (current-window-configuration))
|
||||
((symbol-function 'ffap-prompter)
|
||||
(lambda () "http://www.gnu.org"))
|
||||
(urls nil)
|
||||
(ffap-url-fetcher (lambda (url) (push url urls) nil)))
|
||||
(should-not (ffap-other-window))
|
||||
(should (equal (current-window-configuration) old))
|
||||
(should (equal urls '("http://www.gnu.org")))))
|
||||
|
||||
(provide 'ffap-tests)
|
||||
|
||||
;;; ffap-tests.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue