commit 16c89c5ae5ec0c002c327793e783f0a943bacb0d (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Tue Jan 14 21:36:46 2025 +0100 Use calln instead of calling Ffuncall directly * src/bytecode.c (bcall0): * src/comp.c (bcall0): * src/eval.c (apply1): * src/lisp.h (call0): * src/thread.c (invoke_thread_function): Use calln instead of calling Ffuncall directly. * admin/coccinelle/calln.cocci: New semantic patch. diff --git a/admin/coccinelle/calln.cocci b/admin/coccinelle/calln.cocci new file mode 100644 index 00000000000..5e720931fb5 --- /dev/null +++ b/admin/coccinelle/calln.cocci @@ -0,0 +1,21 @@ +// Use the calln macro where possible. +@@ +@@ +- CALLN ( Ffuncall, ++ calln ( + ...) + +@@ +constant c; +expression e; +@@ +- Ffuncall ( c, &e ) ++ calln ( e ) + +@@ +constant c; +expression e; +@@ +- Ffuncall ( c, &e, ++ calln ( e, + ...) diff --git a/src/bytecode.c b/src/bytecode.c index fcf369400b9..d62d7d067b1 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -327,7 +327,7 @@ If the third argument is incorrect, Emacs may crash. */) static void bcall0 (Lisp_Object f) { - Ffuncall (1, &f); + calln (f); } /* The bytecode stack size in bytes. diff --git a/src/comp.c b/src/comp.c index 96b314b2709..97c7ea2efac 100644 --- a/src/comp.c +++ b/src/comp.c @@ -862,7 +862,7 @@ freloc_check_fill (void) static void bcall0 (Lisp_Object f) { - Ffuncall (1, &f); + calln (f); } static gcc_jit_block * diff --git a/src/eval.c b/src/eval.c index b0cc2505a35..941d121c2fb 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2967,7 +2967,7 @@ run_hook_with_args_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2) Lisp_Object apply1 (Lisp_Object fn, Lisp_Object arg) { - return NILP (arg) ? Ffuncall (1, &fn) : CALLN (Fapply, fn, arg); + return NILP (arg) ? calln (fn) : CALLN (Fapply, fn, arg); } DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, diff --git a/src/lisp.h b/src/lisp.h index e3142f3b8cc..a8fe2e9f6bc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3528,7 +3528,7 @@ enum maxargs INLINE Lisp_Object call0 (Lisp_Object fn) { - return Ffuncall (1, &fn); + return calln (fn); } extern void defvar_lisp (struct Lisp_Objfwd const *, char const *); diff --git a/src/thread.c b/src/thread.c index bb62283dd21..5610f8be0dd 100644 --- a/src/thread.c +++ b/src/thread.c @@ -741,7 +741,7 @@ invoke_thread_function (void) { specpdl_ref count = SPECPDL_INDEX (); - current_thread->result = Ffuncall (1, ¤t_thread->function); + current_thread->result = calln (current_thread->function); return unbind_to (count, Qnil); } commit 2e937dc2b5ad7a87a099df3f014795e88df5cba9 Author: Juri Linkov Date: Tue Jan 14 21:48:53 2025 +0200 Improve repeat-mode to correctly show multi-key sequences as echo * lisp/repeat.el (repeat-echo-message-string): Use 'cl--map-keymap-recursively' that iterates over complete key sequences. Also it returns key vectors, so don't need to use 'vector'. diff --git a/lisp/repeat.el b/lisp/repeat.el index 7ff8a17aba4..fe8145e5daa 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -566,8 +566,9 @@ This function can be used to force exit of repetition while it's active." (defun repeat-echo-message-string (keymap) "Return a string with the list of repeating keys in KEYMAP." (let (keys) - (map-keymap (lambda (key cmd) (and cmd (push (cons key cmd) keys))) - keymap) + (cl--map-keymap-recursively + (lambda (key cmd) (and cmd (push (cons (copy-sequence key) cmd) keys))) + keymap) (format-message "Repeat with %s%s" (mapconcat (lambda (key-cmd) @@ -577,7 +578,7 @@ This function can be used to force exit of repetition while it's active." (get cmd 'repeat-hint)))) ;; Reuse `read-multiple-choice' formatting. (cdr (rmc--add-key-description (list key hint))) - (propertize (key-description (vector key)) + (propertize (key-description key) 'face 'read-multiple-choice-face)))) keys ", ") (if repeat-exit-key commit 0bd12f560b0b288e6c7717bf2e0f664c17d07619 Author: Juri Linkov Date: Tue Jan 14 21:41:48 2025 +0200 Fix repeat-mode to keep the same map symbol for repeat-continue * lisp/repeat.el (repeat-get-map-sym): New function refactored from 'repeat-get-map'. (repeat-get-map): Move continue-related code to 'repeat-get-map-sym'. (repeat-pre-hook): Use 'repeat-get-map-sym' and 'repeat-get-map'. Set 'repeat-map' to 'map-sym'. (repeat-post-hook): Use 'repeat-get-map-sym'. * test/lisp/repeat-tests.el (repeat-tests-continue-another): Improve to invoke double key 'C-M-o C-M-o' that should not switch between maps (bug#74140). diff --git a/lisp/repeat.el b/lisp/repeat.el index 7f6278ee283..7ff8a17aba4 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -453,21 +453,25 @@ See `describe-repeat-maps' for a list of all repeatable commands." (and (symbolp real-this-command) (get real-this-command property)))) -(defun repeat-get-map (&optional rep-map) - "Return a transient map for keys repeatable after the current command." +(defun repeat-get-map-sym () + "Return a transient map possibly as a symbol." (when repeat-mode - (let ((rep-map (or rep-map repeat-map (repeat--command-property 'repeat-map))) + (let ((map-sym (or repeat-map (repeat--command-property 'repeat-map))) (continue (repeat--command-property 'repeat-continue))) (when continue (if repeat-in-progress (when (and (consp continue) (memq repeat-in-progress continue)) - (setq rep-map repeat-in-progress)) - (setq rep-map nil))) - (when rep-map - (when (and (symbolp rep-map) (boundp rep-map)) - (setq rep-map (symbol-value rep-map))) - rep-map)))) + (setq map-sym repeat-in-progress)) + (setq map-sym nil))) + map-sym))) + +(defun repeat-get-map (map) + "Return a transient map for keys repeatable after the current command." + (when map + (when (and (symbolp map) (boundp map)) + (setq map (symbol-value map))) + map)) (defun repeat-check-key (key map) "Check if the last KEY is suitable for activating the repeating MAP." @@ -496,20 +500,21 @@ See `describe-repeat-maps' for a list of all repeatable commands." "Function run before commands to handle repeatable keys." (when (and repeat-mode repeat-keep-prefix repeat-in-progress (not prefix-arg) current-prefix-arg) - (let ((map (repeat-get-map))) + (let* ((map-sym (repeat-get-map-sym)) + (map (repeat-get-map map-sym))) ;; Only when repeat-post-hook will activate the same map (when (repeat-check-map map) ;; Optimize to use less logic in the function `repeat-get-map' ;; for the next call: when called again from `repeat-post-hook' ;; it will use the variable `repeat-map'. - (setq repeat-map map) + (setq repeat-map map-sym) ;; Preserve universal argument (setq prefix-arg current-prefix-arg))))) (defun repeat-post-hook () "Function run after commands to set transient keymap for repeatable keys." (let* ((was-in-progress repeat-in-progress) - (map-sym (or repeat-map (repeat--command-property 'repeat-map))) + (map-sym (repeat-get-map-sym)) (map (repeat-get-map map-sym))) (setq repeat-in-progress nil) (when (repeat-check-map map) diff --git a/test/lisp/repeat-tests.el b/test/lisp/repeat-tests.el index 70690722164..8e564b3e081 100644 --- a/test/lisp/repeat-tests.el +++ b/test/lisp/repeat-tests.el @@ -233,8 +233,11 @@ '((1 u)) "tz") ;; 'C-M-o' shared with another map should continue current map (repeat-tests--check - "C-M-s t C-M-o t C-M-o t z" - '((1 s) (1 t) (1 o) (1 t) (1 o) (1 t)) "z")))) + "C-M-s t C-M-o C-M-o t z" + '((1 s) (1 t) (1 o) (1 o) (1 t)) "z") + (repeat-tests--check + "C-M-a c C-M-o C-M-o c z" + '((1 a) (1 c) (1 o) (1 o) (1 c)) "z")))) (require 'use-package) commit 6b71d0b1786928474741c356eb7199746f07eb62 Author: Juri Linkov Date: Tue Jan 14 20:20:42 2025 +0200 * lisp/tab-bar.el (tab-bar-select-tab): Fix tab-bar-history-mode. Reset the values of 'tab-bar-history-back' and 'tab-bar-history-forward' to nil to not retain a previous tab's history after switching to another tab using window-state. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 0858e7b4634..b570949bfec 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1662,7 +1662,11 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." ;; `window-state-put' fails when called in the minibuffer (when (window-minibuffer-p) (select-window (get-mru-window))) - (window-state-put ws nil 'safe))) + (window-state-put ws nil 'safe) + + (when tab-bar-history-mode + (puthash (selected-frame) nil tab-bar-history-back) + (puthash (selected-frame) nil tab-bar-history-forward)))) (when tab-bar-select-restore-context (window-point-context-use)) commit 0ff82eb48725e15bb87a75d4f937b75c2482c59b Author: João Távora Date: Thu Jul 18 01:09:10 2024 +0100 Flymake: more ambitious cleanup in flymake-mode (bug#69809) Further improve flymake-mode idempotency by not nuke existing overlays. This means multiple flymake-mode invocations do the same as just one one, with minimal or no additional side effects. This is good for people with lots of 'flymake-mode' in hooks. The foreign diagnostic importation has been refactored into a separate function and moved to the "really start" section of 'flymake-start'. The duplication problem appears to be avoided by some heuristics in flymake-highlight-line. A new test has been added. * lisp/progmodes/flymake.el (flymake--import-foreign-diagnostics): New helper (flymake-start): Use it. (flymake-mode): Don't nuke overlays here. * test/lisp/progmodes/flymake-tests.el (foreign-diagnostics): New test. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 64e55369aac..b29d0bc6456 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1262,6 +1262,37 @@ with a report function." "Recent changes collected by `flymake-after-change-function'.") (defvar flymake-mode) +(defun flymake--import-foreign-diagnostics () + ;; Other diagnostic sources may already target this buffer's file + ;; before we turned on: these sources may be of two types... + (let ((source (current-buffer)) + (bfn buffer-file-name)) + ;; 1. For `flymake-list-only-diagnostics': here, we do nothing. + ;; FIXME: We could remove the corresponding entry from that + ;; variable, as we assume that new diagnostics will come in soon + ;; via the brand new `flymake-mode' setup. For simplicity's + ;; sake, we have opted to leave the backend for now. + nil + ;; 2. other buffers where a backend has created "foreign + ;; diagnostics" and pointed them here. We must highlight them in + ;; this buffer, i.e. create overlays for them. Those other + ;; buffers and backends are still responsible for them, i.e. the + ;; current buffer does not "own" these foreign diags. + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when flymake-mode + (maphash (lambda (_backend state) + (maphash (lambda (file diags) + (when (or (eq file source) + (string= bfn (expand-file-name file))) + (with-current-buffer source + (mapc (lambda (diag) + (flymake--highlight-line diag + 'foreign)) + diags)))) + (flymake--state-foreign-diags state))) + flymake--state)))))) + (defun flymake-start (&optional deferred force) "Start a syntax check for the current buffer. DEFERRED is a list of symbols designating conditions to wait for @@ -1335,7 +1366,8 @@ Interactively, with a prefix arg, FORCE is t." backend)) (t (flymake--run-backend backend backend-args))) - nil)))))))) + nil))) + (flymake--import-foreign-diagnostics)))))) (defvar flymake-mode-map (let ((map (make-sparse-keymap))) @@ -1401,49 +1433,8 @@ special *Flymake log* buffer." :group 'flymake :lighter ;; already active. I.e. `flymake-mode' function should be as ;; idempotent as possible. See bug#69809. (unless flymake--state (setq flymake--state (make-hash-table))) - - ;; On a related note to bug#69809, deleting all Flymake overlays is - ;; a violation of that idempotence. This could be addressed in the - ;; future. However, there is at least one known reason for doing so - ;; currently: since "foreign diagnostics" are created here, we opt - ;; to delete everything to avoid duplicating overlays. In - ;; principle, the next `flymake-start' should re-synch everything - ;; (and with high likelyhood that is right around the corner if - ;; `flymake-start-on-flymake-mode' is t). - (mapc #'flymake--delete-overlay (flymake--really-all-overlays)) (setq flymake--recent-changes nil) - - (when flymake-start-on-flymake-mode (flymake-start t)) - - ;; Other diagnostic sources may already target this buffer's file - ;; before we turned on: these sources may be of two types... - (let ((source (current-buffer)) - (bfn buffer-file-name)) - ;; 1. For `flymake-list-only-diagnostics': here, we do nothing. - ;; FIXME: We could remove the corresponding entry from that - ;; variable, as we assume that new diagnostics will come in soon - ;; via the brand new `flymake-mode' setup. For simplicity's - ;; sake, we have opted to leave the backend for now. - nil - ;; 2. other buffers where a backend has created "foreign - ;; diagnostics" and pointed them here. We must highlight them in - ;; this buffer, i.e. create overlays for them. Those other - ;; buffers and backends are still responsible for them, i.e. the - ;; current buffer does not "own" these foreign diags. - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when flymake-mode - (maphash (lambda (_backend state) - (maphash (lambda (file diags) - (when (or (eq file source) - (string= bfn (expand-file-name file))) - (with-current-buffer source - (mapc (lambda (diag) - (flymake--highlight-line diag - 'foreign)) - diags)))) - (flymake--state-foreign-diags state))) - flymake--state)))))) + (when flymake-start-on-flymake-mode (flymake-start t))) ;; Turning the mode OFF. (t diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index 6d639708c90..7831cc87ec4 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -183,6 +183,26 @@ SEVERITY-PREDICATE is used to setup ("no-problems.h") (should-error (flymake-goto-next-error nil nil t))))) +(ert-deftest foreign-diagnostics () + "Test Flymake in one file impacts another" + (skip-unless (and (executable-find "gcc") + (not (ert-gcc-is-clang-p)) + (executable-find "make"))) + (flymake-tests--with-flymake + ("another-problematic-file.c") + (flymake-tests--with-flymake + ("some-problems.h") + (search-forward "frob") + (backward-char 1) + (should (eq 'flymake-note (face-at-point))) + (let ((diags (flymake-diagnostics (point)))) + (should (= 1 (length diags))) + (should (eq :note (flymake-diagnostic-type (car diags)))) + ;; This note would never been here if it werent' a foreign + ;; diagnostic sourced in 'another-problematic-file.c'. + (should (string-match "previous declaration" + (flymake-diagnostic-text (car diags)))))))) + (defmacro flymake-tests--assert-set (set should should-not) commit 3a1b36a39dcd5a860a91a403f96721109203934a Author: João Távora Date: Tue Jan 14 17:44:38 2025 +0000 Flymake: improve idempotence of flymake-mode (bug#69809) In some circumstances, such as the ones described in the referenced bug report, flymake-mode is activated non-interactively and asynchronously in buffers where it may already be active and in the midst of operations. This commit ensures that flymake-mode a bit safer to re-enable in such circumstances and fixes the bug. It also adds some comments documenting the situation. * lisp/progmodes/flymake.el (flymake-mode): Don't smash flymake--state. Add some comments. No need to check for flymake--state nil. (flymake--project-diagnostics): No need to check for flymake--state nil. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index fa999dde142..64e55369aac 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1396,12 +1396,21 @@ special *Flymake log* buffer." :group 'flymake :lighter ;; AutoResize margins. (flymake--resize-margins) - ;; If Flymake happened to be already ON, we must cleanup - ;; existing diagnostic overlays, lest we forget them by blindly - ;; reinitializing `flymake--state' in the next line. - ;; See https://github.com/joaotavora/eglot/issues/223. + ;; We can't just `clrhash' `flymake--state': there may be in + ;; in-transit requests from other backends if `flymake-mode' was + ;; already active. I.e. `flymake-mode' function should be as + ;; idempotent as possible. See bug#69809. + (unless flymake--state (setq flymake--state (make-hash-table))) + + ;; On a related note to bug#69809, deleting all Flymake overlays is + ;; a violation of that idempotence. This could be addressed in the + ;; future. However, there is at least one known reason for doing so + ;; currently: since "foreign diagnostics" are created here, we opt + ;; to delete everything to avoid duplicating overlays. In + ;; principle, the next `flymake-start' should re-synch everything + ;; (and with high likelyhood that is right around the corner if + ;; `flymake-start-on-flymake-mode' is t). (mapc #'flymake--delete-overlay (flymake--really-all-overlays)) - (setq flymake--state (make-hash-table)) (setq flymake--recent-changes nil) (when flymake-start-on-flymake-mode (flymake-start t)) @@ -1416,14 +1425,14 @@ special *Flymake log* buffer." :group 'flymake :lighter ;; via the brand new `flymake-mode' setup. For simplicity's ;; sake, we have opted to leave the backend for now. nil - ;; 2. other buffers where a backend has created "foreign" - ;; diagnostics and pointed them here. We must highlight them in + ;; 2. other buffers where a backend has created "foreign + ;; diagnostics" and pointed them here. We must highlight them in ;; this buffer, i.e. create overlays for them. Those other ;; buffers and backends are still responsible for them, i.e. the ;; current buffer does not "own" these foreign diags. (dolist (buffer (buffer-list)) (with-current-buffer buffer - (when (and flymake-mode flymake--state) + (when flymake-mode (maphash (lambda (_backend state) (maphash (lambda (file diags) (when (or (eq file source) @@ -1451,10 +1460,9 @@ special *Flymake log* buffer." :group 'flymake :lighter (cancel-timer flymake-timer) (setq flymake-timer nil)) (mapc #'flymake--delete-overlay (flymake--really-all-overlays)) - (when flymake--state - (maphash (lambda (_backend state) - (flymake--clear-foreign-diags state)) - flymake--state)))) + (maphash (lambda (_backend state) + (flymake--clear-foreign-diags state)) + flymake--state))) ;; turning Flymake on or off has consequences for listings (flymake--update-diagnostics-listings (current-buffer))) @@ -2045,7 +2053,7 @@ some of this variable's contents the diagnostic listings.") (cl-loop for buf in visited-buffers do (with-current-buffer buf - (when (and flymake-mode flymake--state) + (when flymake-mode (maphash (lambda (_backend state) (maphash commit e633bbfec0fe0fa436026d759132faa47b6b0dc4 Author: Eli Zaretskii Date: Tue Jan 14 14:49:27 2025 +0200 ; Fix wording and coding style of a recent commit * src/treesit.c (treesit_traverse_match_predicate): Fix style. * doc/lispref/parsing.texi (User-defined Things): Fix wording. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 3e44f31c12c..ba7fbca2de9 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1607,7 +1607,7 @@ that's either a @code{sexp} thing or a @code{sentence} thing, as defined by some other rule in the alist. There are two pre-defined predicates: @code{named} and @code{anonymous}, -that qualifies named and anonymous nodes, respectively. They can be +which qualify, respectively, named and anonymous nodes. They can be combined with @code{and} to narrow down the match. Here's an example @code{treesit-thing-settings} for C and C++: diff --git a/src/treesit.c b/src/treesit.c index 439109e72db..0d878a580eb 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -3733,13 +3733,9 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred, return !NILP (calln (pred, lisp_node)); } else if (SYMBOLP (pred) && BASE_EQ (pred, Qnamed)) - { - return ts_node_is_named (node); - } + return ts_node_is_named (node); else if (SYMBOLP (pred) && BASE_EQ (pred, Qanonymous)) - { - return !ts_node_is_named (node); - } + return !ts_node_is_named (node); else if (SYMBOLP (pred)) { Lisp_Object language = XTS_PARSER (parser)->language_symbol; commit d4aeb6bd230c42cf7b773ec9aebd80ad6d928d98 Author: Martin Rudalics Date: Tue Jan 14 09:51:17 2025 +0100 Handle removal of selected tty child frame * src/dispextern.h (root_frame): * src/frame.h (root_frame): Move declaration from dispextern.h to frame.h. (SET_FRAME_VISIBLE): Whend making the selected tty child frame invisible, use mru_rooted_frame to find a frame to switch to. * src/dispnew.c (root_frame): Move root_frame to frame.c. * src/frame.c (do_switch_frame): On ttys don't change the top frame when switching from a child frame to another frame with the same root. (root_frame): Move here from dispnew.c. (Fframe_root_frame): New Lisp function. (delete_frame): Whend deleting the selected tty child frame use, mru_rooted_frame to find a frame to switch to. * src/window.c (mru_rooted_frame): New function. * src/window.h (mru_rooted_frame): Declare it. * doc/lispref/frames.texi (Child Frames): Describe new function 'frame-root-frame'. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 158e255ef06..a0d0e489ad0 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3579,7 +3579,7 @@ work on all window-systems. Some will drop the object on the parent frame or on some ancestor instead. @end itemize - The following two functions can be useful when working with child and + The following three functions can be useful when working with child and parent frames: @defun frame-parent &optional frame @@ -3591,6 +3591,7 @@ exists, @var{frame} is considered a child frame of that frame. This function returns @code{nil} if @var{frame} has no parent frame. @end defun +@cindex ancestor frame @defun frame-ancestor-p ancestor descendant This functions returns non-@code{nil} if @var{ancestor} is an ancestor of @var{descendant}. @var{ancestor} is an ancestor of @var{descendant} @@ -3599,6 +3600,16 @@ of @var{descendant}'s parent frame. Both, @var{ancestor} and @var{descendant} must specify live frames. @end defun +@cindex root frame +@defun frame-root-frame &optional frame +This function returns the root frame of the specified @var{frame}. +@var{frame} must be a live frame and defaults to the selected one. The +root frame of @var{frame} is the frame obtained by following the chain +of parent frames starting with @var{frame} until a frame is reached that +has no parent. If @var{frame} has no parent, its root frame is +@var{frame} itself. +@end defun + Note also the function @code{window-largest-empty-rectangle} (@pxref{Coordinates and Windows}) which can be used to inscribe a child frame in the largest empty area of an existing window. This can be diff --git a/src/dispextern.h b/src/dispextern.h index e3e621e7318..1d90022a9bc 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3949,7 +3949,6 @@ extern void gui_redo_mouse_highlight (Display_Info *); #endif /* HAVE_WINDOW_SYSTEM */ -struct frame *root_frame (struct frame *f); Lisp_Object frames_in_reverse_z_order (struct frame *f, bool visible); bool is_tty_frame (struct frame *f); bool is_tty_child_frame (struct frame *f); diff --git a/src/dispnew.c b/src/dispnew.c index 5bc6958622d..cb57edcec0f 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3334,18 +3334,6 @@ frame_rect_abs (struct frame *f) #endif /* !HAVE_ANDROID */ -/* Return the root frame of frame F. Follow the parent_frame chain - until we reach a frame that has no parent. That is the root frame. - Note that the root of a root frame is itself. */ - -struct frame * -root_frame (struct frame *f) -{ - while (FRAME_PARENT_FRAME (f)) - f = FRAME_PARENT_FRAME (f); - return f; -} - int max_child_z_order (struct frame *parent) { diff --git a/src/frame.c b/src/frame.c index 212331c0b3a..4559bc41ab8 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1775,7 +1775,7 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor /* Don't mark the frame garbaged if we are switching to the frame that is already the top frame of that TTY. */ - if (!EQ (frame, top_frame)) + if (!EQ (frame, top_frame) && root_frame (f) != XFRAME (top_frame)) { struct frame *new_root = root_frame (f); SET_FRAME_VISIBLE (new_root, true); @@ -2021,6 +2021,39 @@ frame. */) return frame_ancestor_p (af, df) ? Qt : Qnil; } + +/* Return the root frame of frame F. Follow the parent_frame chain + until we reach a frame that has no parent. That is the root frame. + Note that the root of a root frame is itself. */ + +struct frame * +root_frame (struct frame *f) +{ + while (FRAME_PARENT_FRAME (f)) + f = FRAME_PARENT_FRAME (f); + return f; +} + + +DEFUN ("frame-root-frame", Fframe_root_frame, Sframe_root_frame, + 0, 1, 0, + doc: /* Return root frame of specified FRAME. +FRAME must be a live frame and defaults to the selected one. The root +frame of FRAME is the frame obtained by following the chain of parent +frames starting with FRAME until a frame is reached that has no parent. +If FRAME has no parent, its root frame is FRAME. */) + (Lisp_Object frame) +{ + struct frame *f = decode_live_frame (frame); + struct frame *r = root_frame (f); + Lisp_Object root; + + XSETFRAME (root, r); + + return root; +} + + /* Return CANDIDATE if it can be used as 'other-than-FRAME' frame on the same tty (for tty frames) or among frames which uses FRAME's keyboard. If MINIBUF is nil, do not consider minibuffer-only candidate. @@ -2433,61 +2466,68 @@ delete_frame (Lisp_Object frame, Lisp_Object force) /* Don't let the frame remain selected. */ if (f == sf) { - Lisp_Object tail; - Lisp_Object frame1 UNINIT; /* This line works around GCC bug 85563. */ - eassume (CONSP (Vframe_list)); - - /* Look for another visible frame on the same terminal. - Do not call next_frame here because it may loop forever. - See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=15025. */ - FOR_EACH_FRAME (tail, frame1) + if (is_tty_child_frame (f)) + /* If F is a child frame on a tty and is the selected frame, try + to re-select the frame that was selected before F. */ + do_switch_frame (mru_rooted_frame (f), 0, 1, Qnil); + else { - struct frame *f1 = XFRAME (frame1); - - if (!EQ (frame, frame1) - && !FRAME_TOOLTIP_P (f1) - && FRAME_TERMINAL (f) == FRAME_TERMINAL (f1) - && FRAME_VISIBLE_P (f1)) - break; - } + Lisp_Object tail; + Lisp_Object frame1 UNINIT; /* This line works around GCC bug 85563. */ + eassume (CONSP (Vframe_list)); - /* If there is none, find *some* other frame. */ - if (NILP (frame1) || EQ (frame1, frame)) - { + /* Look for another visible frame on the same terminal. + Do not call next_frame here because it may loop forever. + See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=15025. */ FOR_EACH_FRAME (tail, frame1) { struct frame *f1 = XFRAME (frame1); if (!EQ (frame, frame1) - && FRAME_LIVE_P (f1) - && !FRAME_TOOLTIP_P (f1)) + && !FRAME_TOOLTIP_P (f1) + && FRAME_TERMINAL (f) == FRAME_TERMINAL (f1) + && FRAME_VISIBLE_P (f1)) + break; + } + + /* If there is none, find *some* other frame. */ + if (NILP (frame1) || EQ (frame1, frame)) + { + FOR_EACH_FRAME (tail, frame1) { - if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1)) - { - Lisp_Object top_frame = FRAME_TTY (f1)->top_frame; + struct frame *f1 = XFRAME (frame1); - if (!EQ (top_frame, frame)) - frame1 = top_frame; + if (!EQ (frame, frame1) + && FRAME_LIVE_P (f1) + && !FRAME_TOOLTIP_P (f1)) + { + if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1)) + { + Lisp_Object top_frame = FRAME_TTY (f1)->top_frame; + + if (!EQ (top_frame, frame)) + frame1 = top_frame; + } + break; } - break; } } - } #ifdef NS_IMPL_COCOA - else - { - /* Under NS, there is no system mechanism for choosing a new - window to get focus -- it is left to application code. - So the portion of THIS application interfacing with NS - needs to make the frame we switch to the key window. */ - struct frame *f1 = XFRAME (frame1); - if (FRAME_NS_P (f1)) - ns_make_frame_key_window (f1); - } + else + { + /* Under NS, there is no system mechanism for choosing a new + window to get focus -- it is left to application code. + So the portion of THIS application interfacing with NS + needs to make the frame we switch to the key window. */ + struct frame *f1 = XFRAME (frame1); + if (FRAME_NS_P (f1)) + ns_make_frame_key_window (f1); + } #endif - do_switch_frame (frame1, 0, 1, Qnil); - sf = SELECTED_FRAME (); + do_switch_frame (frame1, 0, 1, Qnil); + sf = SELECTED_FRAME (); + } } else /* Ensure any minibuffers on FRAME are moved onto the selected @@ -2583,11 +2623,11 @@ delete_frame (Lisp_Object frame, Lisp_Object force) f->terminal = 0; /* Now the frame is dead. */ unblock_input (); - /* Clear markers and overlays set by F on behalf of an input - method. */ + /* Clear markers and overlays set by F on behalf of an input + method. */ #ifdef HAVE_TEXT_CONVERSION - if (FRAME_WINDOW_P (f)) - reset_frame_state (f); + if (FRAME_WINDOW_P (f)) + reset_frame_state (f); #endif /* If needed, delete the terminal that this frame was on. @@ -7146,6 +7186,7 @@ iconify the top level frame instead. */); defsubr (&Sframe_list); defsubr (&Sframe_parent); defsubr (&Sframe_ancestor_p); + defsubr (&Sframe_root_frame); defsubr (&Snext_frame); defsubr (&Sprevious_frame); defsubr (&Slast_nonminibuf_frame); diff --git a/src/frame.h b/src/frame.h index bff610472c0..fea8baa7332 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1428,23 +1428,6 @@ FRAME_PARENT_FRAME (struct frame *f) /* False means there are no visible garbaged frames. */ extern bool frame_garbaged; -/* Set visibility of frame F. - We call redisplay_other_windows to make sure the frame gets redisplayed - if some changes were applied to it while it wasn't visible (and hence - wasn't redisplayed). */ -INLINE void -SET_FRAME_VISIBLE (struct frame *f, bool v) -{ - if (v) - { - if (v == 1 && f->visible != 1) - redisplay_other_windows (); - if (FRAME_GARBAGED_P (f)) - frame_garbaged = true; - } - f->visible = v; -} - /* Set iconified status of frame F. */ INLINE void SET_FRAME_ICONIFIED (struct frame *f, int i) @@ -1518,6 +1501,7 @@ void check_tty (struct frame *f); struct frame *decode_tty_frame (Lisp_Object frame); extern void frame_make_pointer_invisible (struct frame *); extern void frame_make_pointer_visible (struct frame *); +extern struct frame *root_frame (struct frame *f); extern Lisp_Object delete_frame (Lisp_Object, Lisp_Object); extern bool frame_inhibit_resize (struct frame *, bool, Lisp_Object); extern void adjust_frame_size (struct frame *, int, int, int, bool, @@ -1541,6 +1525,27 @@ extern Lisp_Object Vframe_list; ? XFRAME (selected_frame) \ : (emacs_abort (), (struct frame *) 0)) +/* Set visibility of frame F. + We call redisplay_other_windows to make sure the frame gets redisplayed + if some changes were applied to it while it wasn't visible (and hence + wasn't redisplayed). */ +INLINE void +SET_FRAME_VISIBLE (struct frame *f, bool v) +{ + if (v) + { + if (v == 1 && f->visible != 1) + redisplay_other_windows (); + if (FRAME_GARBAGED_P (f)) + frame_garbaged = true; + } + /* If F is a child frame on a tty and is the selected frame, try to + re-select the frame that was selected before F. */ + else if (is_tty_child_frame (f) && f == XFRAME (selected_frame)) + do_switch_frame (mru_rooted_frame (f), 0, 0, Qnil); + + f->visible = v; +} /*********************************************************************** Display-related Macros diff --git a/src/window.c b/src/window.c index ff58eb12ee0..d7e6cd00c99 100644 --- a/src/window.c +++ b/src/window.c @@ -3097,6 +3097,38 @@ be listed first but no error is signaled. */) { return window_list_1 (window, minibuf, all_frames); } + +/** Return most recently selected frame that has the same root as a + given frame. It's defined here because the static window_list_1 is + here too but in fact it's only needed in the frame code. */ +Lisp_Object +mru_rooted_frame (struct frame *f) +{ + Lisp_Object windows = window_list_1 (FRAME_SELECTED_WINDOW (f), Qnil, Qt); + struct frame *r = root_frame (f); + struct window *b = NULL; + + for (; CONSP (windows); windows = XCDR (windows)) + { + struct window *w = XWINDOW (XCAR (windows)); + struct frame *wf = WINDOW_XFRAME (w); + + if (wf != f && root_frame (wf) == r && FRAME_VISIBLE_P (wf) + && (!b || w->use_time > b->use_time)) + b = w; + } + + if (b) + return WINDOW_FRAME (b); + else + { + Lisp_Object root; + + XSETFRAME (root, r); + + return root; + } +} /* Look at all windows, performing an operation specified by TYPE with argument OBJ. diff --git a/src/window.h b/src/window.h index 39356f80df7..a48c370b198 100644 --- a/src/window.h +++ b/src/window.h @@ -1227,6 +1227,7 @@ extern void wset_buffer (struct window *, Lisp_Object); extern bool window_outdated (struct window *); extern ptrdiff_t window_point (struct window *w); extern void window_discard_buffer_from_dead_windows (Lisp_Object); +extern Lisp_Object mru_rooted_frame (struct frame *); extern void init_window_once (void); extern void init_window (void); extern void syms_of_window (void);