commit 5a4b9ca7364f225eff9b134ff06a49c46179366e (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Tue Mar 18 09:41:56 2025 +0800 Fix generation of mouse position lists on the tool and tab bars * src/keyboard.c (make_lispy_tty_position): Return whether an internal border was hit. (make_lispy_position): Only skip standard window and frame detection process if so, as there are other scenarios where POSN is nil but WINDOW_OR_FRAME is none the less expected to be provided by the conditionals skipped. diff --git a/src/keyboard.c b/src/keyboard.c index f3a8d8bab77..5db11ad6379 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5616,9 +5616,12 @@ enum frame_border_side is any frame but WINDOW_OR_FRAME and R whose root is R, which is not decorated and has a 'drag-internal-border' parameter. If we find a suitable frame, set WINDOW_OR_FRAME to it and POSN to the part of the - internal border corresponding to (MX, MY) on the frame found. */ + internal border corresponding to (MX, MY) on the frame found. -static void + Value is 1 if MX and MY rest in one of R or its children's + decorations, and 0 otherwise. */ + +static int make_lispy_tty_position (struct frame *r, int mx, int my, Lisp_Object *window_or_frame, Lisp_Object *posn) { @@ -5678,7 +5681,10 @@ make_lispy_tty_position (struct frame *r, int mx, int my, XSETFRAME (*window_or_frame, f); *posn = builtin_lisp_symbol (internal_border_parts[part]); + return 1; } + + return 0; } /* X and Y are frame-relative coordinates for a click or wheel event. @@ -5761,10 +5767,9 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, if (WINDOWP (window_or_frame) && is_tty_frame (f) && (is_tty_root_frame_with_visible_child (f) - || is_tty_child_frame (f))) - make_lispy_tty_position (root_frame (f), mx, my, &window_or_frame, &posn); - - if (!NILP (posn)) + || is_tty_child_frame (f)) + && make_lispy_tty_position (root_frame (f), mx, my, + &window_or_frame, &posn)) ; else if (WINDOWP (window_or_frame)) { commit 5f4c9053538fc1bf472c1be9a203db5c6178ea02 Author: Stefan Kangas Date: Tue Mar 18 00:33:32 2025 +0100 ; Use defvar-keymap in define-derived-mode * lisp/emacs-lisp/derived.el (define-derived-mode): Use defvar-keymap. This change is for documentation purposes on macro expansion. diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 2e54d6ce36c..2958bd37e91 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -217,7 +217,7 @@ No problems result if this variable is not bound. child))) (unless (boundp ',map) (put ',map 'definition-name ',child)) - (with-no-warnings (defvar ,map (make-sparse-keymap))) + (with-no-warnings (defvar-keymap ,map)) (unless (get ',map 'variable-documentation) (put ',map 'variable-documentation ,(format "Keymap for `%s'." child))) commit 69210eb84e7c3074c339b8aa2f380f66a80ae61b Author: Stefan Kangas Date: Mon Mar 17 18:45:20 2025 +0100 Use 'help-key' function in more places * lisp/dired-aux.el (dired-query): * lisp/emacs-lisp/helper.el (Helper-help-map): * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p): Use 'help-key'. * lisp/net/tramp-cmds.el (tramp-rename-files): * lisp/which-key.el (which-key--next-page-hint): Prefer 'help-key' when available. * lisp/help.el (help-key): Simplify. * etc/symbol-releases.eld: Add 'help-key'. diff --git a/etc/symbol-releases.eld b/etc/symbol-releases.eld index 93f0f5419f4..9732f60fc16 100644 --- a/etc/symbol-releases.eld +++ b/etc/symbol-releases.eld @@ -10,6 +10,7 @@ ( ("29.1" fun plistp) + ("29.1" fun help-key) ("28.1" fun always) ("27.1" fun project-files) ("26.1" fun flymake--diag-region) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 7534eb552ad..d7d4a394c4a 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1912,7 +1912,7 @@ return t; if SYM is q or ESC, return nil." (concat (apply #'format-message prompt args) (if help-form (format " [Type yn!q or %s] " - (key-description (vector help-char))) + (help-key)) " [Type y, n, q or !] "))) (set sym (setq char (read-char-choice prompt char-choices))) (if (memq char '(?y ?\s ?!)) t))))) diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el index 8a173219545..01dbc686437 100644 --- a/lisp/emacs-lisp/helper.el +++ b/lisp/emacs-lisp/helper.el @@ -47,7 +47,7 @@ ;;"f" #'Helper-describe-function ;;"v" #'Helper-describe-variable "?" #'Helper-help-options - (key-description (char-to-string help-char)) #'Helper-help-options) + (help-key) #'Helper-help-options) (fset 'Helper-help-map Helper-help-map) (defun Helper-help-scroller () diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 952497032a2..fc9912f189e 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -173,7 +173,7 @@ The function's value is the number of actions taken." "%s(\\`y', \\`n', \\`!', \\`.', \\`q', %sor \\`%s') " minibuffer-prompt-properties) prompt user-keys - (key-description (vector help-char))))) + (help-key)))) (if minibuffer-auto-raise (raise-frame (window-frame (minibuffer-window)))) (unwind-protect @@ -198,7 +198,7 @@ The function's value is the number of actions taken." (format "%s(\\`y', \\`n', \\`!', \\`.', \\`q', %sor \\`%s') %s" prompt user-keys - (key-description (vector help-char)) + (help-key) (if (equal char -1) "[end-of-keyboard-macro]" (single-key-description char)))))) @@ -279,7 +279,7 @@ Type \\`SPC' or \\`y' to %s the current %s; (message (substitute-command-keys (format "Type \\`%s' for help" - (key-description (vector help-char))))) + (help-key)))) (beep) (sit-for 1) (funcall try-again)))) diff --git a/lisp/help.el b/lisp/help.el index 835e47fec43..b0c003ed16a 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -57,7 +57,7 @@ buffer.") (defun help-key () "Return `help-char' in a format suitable for the `keymap-set' KEY argument." - (key-description (char-to-string help-char))) + (key-description (vector help-char))) (defvar-keymap help-map :doc "Keymap for characters following the Help key." diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 0d90382b2d3..098e39ccf7c 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -550,7 +550,8 @@ ESC or `q' to quit without changing further buffers, (new-bfn (and (stringp bfn) (string-replace source target bfn))) (prompt (format-message "Set visited file name to `%s' [Type yn!eq or %s] " - new-bfn (key-description (vector help-char))))) + new-bfn (if (fboundp 'help-key) (help-key) ; 29.1 + (key-description (vector help-char)))))) (when (and (buffer-live-p buffer) (stringp bfn) (string-prefix-p source bfn) ;; Skip, and don't ask again. diff --git a/lisp/which-key.el b/lisp/which-key.el index bfeb9da7422..c62595da587 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -2213,7 +2213,8 @@ Actual lines: %s" (let* ((paging-key (concat prefix-keys " " which-key-paging-key)) (paging-key-bound (eq 'which-key-C-h-dispatch (key-binding (kbd paging-key)))) - (key (key-description (vector help-char))) + (key (if (fboundp 'help-key) (help-key) ; 29.1 + (key-description (vector help-char)))) (key (if paging-key-bound (concat key " or " which-key-paging-key) key))) commit 49e019fbbc61e22167f0a15a3b1983d98bce7be6 Author: Stefan Kangas Date: Sun Mar 16 22:26:09 2025 +0100 ; * lisp/follow.el (follow-mode-prefix-key): Improve. diff --git a/lisp/follow.el b/lisp/follow.el index ddf72845eed..087d3139556 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -231,12 +231,12 @@ After that, changing the prefix key requires manipulating keymaps." (defcustom follow-mode-prefix-key (key-description follow-mode-prefix) "Prefix key to use for follow commands in Follow mode." - :type 'string + :type 'key + :initialize 'custom-initialize-default :set (lambda (symbol value) (defvar follow-mode-map) (defvar follow-mode-submap) - (when (boundp 'follow-mode-map) - (keymap-unset follow-mode-map (symbol-value symbol)) - (keymap-set follow-mode-map value follow-mode-submap)) + (keymap-unset follow-mode-map (symbol-value symbol)) + (keymap-set follow-mode-map value follow-mode-submap) (set-default symbol value)) :group 'follow :version "31.1") commit be2b5a7148887879e0127994c9d779a943e3df2b Author: john muhl Date: Mon Mar 17 09:04:33 2025 -0500 ; Fix 'java-ts-mode' tests (Bug#77070) * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Set 'indent-tabs-mode' later. diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts index 7cf59340454..180f4358a0a 100644 --- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -1,8 +1,8 @@ Code: (lambda () - (setq indent-tabs-mode nil) (setq java-ts-mode-indent-offset 4) (java-ts-mode) + (setq indent-tabs-mode nil) (indent-region (point-min) (point-max))) Point-Char: | commit 4cfeb3697c242b5d669a102bd43fa51f776f987e Author: Eli Zaretskii Date: Mon Mar 17 14:19:34 2025 +0200 ; * src/dispnew.c (adjust_glyph_matrix): Restore lost comment. diff --git a/src/dispnew.c b/src/dispnew.c index 1a40939f14e..595f27e255a 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -512,6 +512,8 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y dim.width * sizeof (struct glyph)); if ((row == matrix->rows + dim.height - 1 + /* The mode line, if displayed, never has marginal + areas. */ && !(w && window_wants_mode_line (w))) || (row == matrix->rows && matrix->tab_line_p) || (row == matrix->rows commit 4008e664a8dc6d92dda0ba0a5b0c717ab3f72e5c Author: Eli Zaretskii Date: Mon Mar 17 14:16:45 2025 +0200 ; * src/dispnew.c (adjust_glyph_matrix): Add comment (bug#77039). diff --git a/src/dispnew.c b/src/dispnew.c index 683c6ba4226..1a40939f14e 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -506,6 +506,8 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y row->glyphs[LEFT_MARGIN_AREA] = xnrealloc (row->glyphs[LEFT_MARGIN_AREA], dim.width, sizeof (struct glyph)); + /* We actually need to clear only the 'frame' member, but + it's easier to clear everything. */ memset (row->glyphs[LEFT_MARGIN_AREA], 0, dim.width * sizeof (struct glyph)); commit c44f34475af6b1e32c71a230e25e0cbea0697c4c Author: Eli Zaretskii Date: Mon Mar 17 14:14:46 2025 +0200 ; * etc/NEWS: Fix punctuation. diff --git a/etc/NEWS b/etc/NEWS index 15de0b42600..0797fc03217 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -981,7 +981,7 @@ blocks are syntax-highlighted if the Doxygen grammar library is available. --- -*** New user option 'java-ts-mode-method-chaining-indent-offset' +*** New user option 'java-ts-mode-method-chaining-indent-offset'. Now method chaining is indented by 8 spaces rather than 4, and this variable controls how much is indented for method chaining. commit fd88c5232098a323f6334b6e1f7e2dacdc447a8e Author: Eli Zaretskii Date: Mon Mar 17 14:12:13 2025 +0200 ; * etc/NEWS: Fix last change. diff --git a/etc/NEWS b/etc/NEWS index d32b1f8739a..15de0b42600 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1406,17 +1406,19 @@ It is intended to be added to the 'log-edit-done-hook' so that command line. --- -*** New user options 'vc-resolve-conflicts', 'vc-*-resolve-conflicts' +*** New user options 'vc-resolve-conflicts' and 'vc-*-resolve-conflicts'. Control whether to mark a conflicted file as resolved when saving. You can now control it globally, with 'vc-resolve-conflicts' or for specific backends with 'vc-bzr-resolve-conflicts', 'vc-hg-resolve-conflicts' and 'vc-svn-resolve-conflicts'. + --- -*** New value for 'vc-git-resolve-conflicts' +*** New value for 'vc-git-resolve-conflicts'. The option now accepts the symbol 'default' as a value, which is its default value. Effectively, the default value hasn't changed, since 'vc-resolve-conflicts' defaults to t, the previous default value for 'vc-git-resolve-conflicts'. + ** Diff mode +++ diff --git a/src/eval.c b/src/eval.c index 335fdae8ab9..68da81ff8da 100644 --- a/src/eval.c +++ b/src/eval.c @@ -722,9 +722,9 @@ signal a `cyclic-variable-indirection' error. */) DEFUN ("internal-delete-indirect-variable", Finternal_delete_indirect_variable, Sinternal_delete_indirect_variable, 1, 1, 0, - doc: /* Internal use only. -Undeclare SYMBOL as variable alias, then unbind it. -Return SYMBOL. */) + doc: /* Undeclare SYMBOL as variable alias, then unbind it. +Return SYMBOL. +Internal use only. */) (register Lisp_Object symbol) { CHECK_SYMBOL (symbol); commit acb96a5ca8ac3bef80ca2ff1496cacb3ab57c87a Author: Mauro Aranda Date: Mon Mar 17 06:55:07 2025 -0300 Make marking conflicted files as resolved upon saving opt-out This fixes Bug#3860. * lisp/vc/vc.el (vc-resolve-conflicts): New user option. * lisp/vc/vc-bzr.el (vc-bzr-resolve-conflicts): New user option. (vc-bzr-find-file-hook): Use it. * lisp/vc/vc-hg.el (vc-hg-resolve-conflicts): New user option. (vc-hg-find-file-hook): Use it. * lisp/vc/vc-svn.el (vc-svn-resolve-conflicts): New user option. (vc-svn-find-file-hook): Use it. * lisp/vc/vc-git.el (vc-git-resolve-conflicts): Support 'default' as an option. Adjust docstring and version. (vc-git-find-file-hook): Respect vc-resolve-conflicts. * etc/NEWS: Announce the new options. diff --git a/etc/NEWS b/etc/NEWS index 98aea4280e3..d32b1f8739a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1405,6 +1405,18 @@ It is intended to be added to the 'log-edit-done-hook' so that 'vc-cvs-checkin' behaves like invoking 'cvs commit [files...]' from the command line. +--- +*** New user options 'vc-resolve-conflicts', 'vc-*-resolve-conflicts' +Control whether to mark a conflicted file as resolved when saving. +You can now control it globally, with 'vc-resolve-conflicts' or for +specific backends with 'vc-bzr-resolve-conflicts', +'vc-hg-resolve-conflicts' and 'vc-svn-resolve-conflicts'. +--- +*** New value for 'vc-git-resolve-conflicts' +The option now accepts the symbol 'default' as a value, which is +its default value. Effectively, the default value hasn't changed, +since 'vc-resolve-conflicts' defaults to t, the previous default value +for 'vc-git-resolve-conflicts'. ** Diff mode +++ diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 0907eaee448..1ba4450cf5d 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -110,6 +110,16 @@ The option \"--no-classify\" should be present if your bzr supports it." (repeat :tag "Argument List" :value ("") string)) :version "24.1") +(defcustom vc-bzr-resolve-conflicts 'default + "Whether to mark conflicted file as resolved upon saving. +If this is t and there are no more conflict markers in the file, +VC will mark the conflicts in the saved file as resolved. +A value of `default' means to use the value of `vc-resolve-conflicts'." + :type '(choice (const :tag "Don't resolve" nil) + (const :tag "Resolve" t) + (const :tag "Use vc-resolve-conflicts" default)) + :version "31.1") + ;; since v0.9, bzr supports removing the progress indicators ;; by setting environment variable BZR_PROGRESS_BAR to "none". (defun vc-bzr-command (bzr-command buffer okstatus file-or-list &rest args) @@ -531,7 +541,10 @@ in the branch repository (or whose status not be determined)." ;; but the one in `bzr pull' isn't, so it would be good to provide an ;; elisp function to remerge from the .BASE/OTHER/THIS files. (smerge-start-session) - (add-hook 'after-save-hook #'vc-bzr-resolve-when-done nil t) + (when (or (eq vc-bzr-resolve-conflicts t) + (and (eq vc-bzr-resolve-conflicts 'default) + vc-resolve-conflicts)) + (add-hook 'after-save-hook #'vc-bzr-resolve-when-done nil t)) (vc-message-unresolved-conflicts buffer-file-name))) (defun vc-bzr-clone (remote directory rev) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 78827c74691..932dddaefbb 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -166,17 +166,24 @@ uses a full scan)." (repeat :tag "Argument List" :value ("") string)) :version "30.1") -(defcustom vc-git-resolve-conflicts t - "When non-nil, mark conflicted file as resolved upon saving. +(defcustom vc-git-resolve-conflicts 'default + "Whether to mark conflicted file as resolved upon saving. That is performed after all conflict markers in it have been removed. + +If this is t and there are no more conflict markers in the file, +VC will mark the conflicts in the saved file as resolved. + If the value is `unstage-maybe', and no merge, rebase or similar operation is in progress, then after the last conflict is resolved, also -clear the staging area." +clear the staging area. + +A value of `default' means to use the value of `vc-resolve-conflicts'." :type '(choice (const :tag "Don't resolve" nil) (const :tag "Resolve" t) (const :tag "Resolve and maybe unstage all files" - unstage-maybe)) - :version "25.1") + unstage-maybe) + (const :tag "Use vc-resolve-conflicts" default)) + :version "31.1") (defcustom vc-git-program "git" "Name of the Git executable (excluding any arguments)." @@ -1445,7 +1452,9 @@ This prompts for a branch to merge from." (goto-char (point-min)) (re-search-forward "^<<<<<<< " nil 'noerror))) (smerge-start-session) - (when vc-git-resolve-conflicts + (unless (or (null vc-git-resolve-conflicts) + (and (eq vc-git-resolve-conflicts 'default) + (not vc-resolve-conflicts))) (add-hook 'after-save-hook #'vc-git-resolve-when-done nil 'local)) (vc-message-unresolved-conflicts buffer-file-name))) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index b4d7844013a..b7200da0914 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -183,6 +183,16 @@ If `ask', you will be prompted for a branch type." (const :tag "Ask" ask)) :version "28.1") +(defcustom vc-hg-resolve-conflicts 'default + "Whether to mark conflicted file as resolved upon saving. +If this is t and there are no more conflict markers in the file, +VC will mark the conflicts in the saved file as resolved. +A value of `default' means to use the value of `vc-resolve-conflicts'." + :type '(choice (const :tag "Don't resolve" nil) + (const :tag "Resolve" t) + (const :tag "Use vc-resolve-conflicts" default)) + :version "31.1") + ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. @@ -1263,7 +1273,10 @@ REV is the revision to check out into WORKFILE." ;; Hg may not recognize "conflict" as a state, but we can do better. (vc-file-setprop buffer-file-name 'vc-state 'conflict) (smerge-start-session) - (add-hook 'after-save-hook #'vc-hg-resolve-when-done nil t) + (when (or (eq vc-hg-resolve-conflicts t) + (and (eq vc-hg-resolve-conflicts 'default) + vc-resolve-conflicts)) + (add-hook 'after-save-hook #'vc-hg-resolve-when-done nil t)) (vc-message-unresolved-conflicts buffer-file-name))) (defun vc-hg-clone (remote directory rev) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 422ef48f8c0..e81636552b5 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -106,6 +106,16 @@ switches." :version "24.1" ; no longer consult the obsolete vc-header-alist :type '(repeat string)) +(defcustom vc-svn-resolve-conflicts 'default + "Whether to mark conflicted file as resolved upon saving. +If this is t and there are no more conflict markers in the file, +VC will mark the conflicts in the saved file as resolved. +A value of `default' means to use the value of `vc-resolve-conflicts'." + :type '(choice (const :tag "Don't resolve" nil) + (const :tag "Resolve" t) + (const :tag "Use vc-resolve-conflicts" default)) + :version "31.1") + ;; We want to autoload it for use by the autoloaded version of ;; vc-svn-registered, but we want the value to be compiled at startup, not ;; at dump time. @@ -688,7 +698,10 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." ;; There are conflict markers. (progn (smerge-start-session) - (add-hook 'after-save-hook #'vc-svn-resolve-when-done nil t)) + (when (or (eq vc-svn-resolve-conflicts t) + (and (eq vc-svn-resolve-conflicts 'default) + vc-resolve-conflicts)) + (add-hook 'after-save-hook #'vc-svn-resolve-when-done nil t))) ;; There are no conflict markers. This is problematic: maybe it means ;; the conflict has been resolved and we should immediately call "svn ;; resolved", or it means that the file's type does not allow Svn to diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 5c2f848b891..565eaabff0b 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -999,6 +999,21 @@ the URL-REGEXP of the association." :value-type ,vc-cloneable-backends-custom-type) :version "31.1") +(defcustom vc-resolve-conflicts t + "Whether to mark conflicted file as resolved upon saving. + +If this is non-nil and there are no more conflict markers in the file, +VC will mark the conflicts in the saved file as resolved. This is +only meaningful for VCS that handle conflicts by inserting conflict +markers in a conflicted file. + +When saving a conflicted file, VC first tries to use the value +of `vc-BACKEND-resolve-conflicts', for handling backend-specific +settings. It defaults to this option if that option has the special +value `default'." + :type 'boolean + :version "31.1") + ;; File property caching commit 86be9431ae88126387ed8402cb4953963ebba6f8 Author: Martin Rudalics Date: Mon Mar 17 09:50:19 2025 +0100 Implement dragging and resizing of tty child frames * lisp/faces.el (face-spec-recalc): Don't set scroll-bar-foreground and scroll-bar-background parameters on ttys. * lisp/mouse.el (mouse-drag-frame-resize) (mouse-drag-frame-move): On ttys call 'mouse-position-in-root-frame' to get position of child frame to resize or drag. * lisp/xt-mouse.el (xterm-mouse-event): Handle events on child frame decorations as if they happened on the internal border to find out whether a user wants to drag or resize a child frame. * src/frame.c (frame_internal_border_part): Define for ttys too. (Fmouse_position_in_root_frame): New function. * src/frame.h (internal_border_part): Define for ttys too. * src/keyboard.c (internal_border_parts): Define for ttys too. (frame_border_side): New enum. (make_lispy_position): Handle events on tty child frames. (Fposn_at_x_y): Accept -1 for Y so we can handle a position on the top decoration of a tty child frame. * src/term.c (tty_frame_at): Handle case where X and Y denote a position on a tty child frame's decoration. * src/window.c (Fwindow_at): Handle case where X and Y denote a position on the decoration of a tty child frame which we pretend as belonging to that child frame (and not to its root). diff --git a/lisp/faces.el b/lisp/faces.el index e699e9f243b..dbc0a2e04f6 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1766,7 +1766,8 @@ The following sources are applied in this order: (list :extend (cadr tail)))))) (setq face-attrs (face-spec-choose (get face 'face-override-spec) frame)) (face-spec-set-2 face frame face-attrs) - (when (and (fboundp 'set-frame-parameter) ; This isn't available + (when (and (not (eq (framep frame) t)) + (fboundp 'set-frame-parameter) ; This isn't available ; during loadup. (eq face 'scroll-bar)) ;; Set the `scroll-bar-foreground' and `scroll-bar-background' diff --git a/lisp/mouse.el b/lisp/mouse.el index 0775ec2f4ec..5f841e80b9e 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1111,7 +1111,10 @@ frame with the mouse." (drag-bottom (memq part '(bottom-right bottom bottom-left))) ;; Initial "first" mouse position. While dragging we base all ;; calculations against that position. - (first-x-y (mouse-absolute-pixel-position)) + (tty (tty-type frame)) + (first-x-y (if tty + (mouse-position-in-root-frame) + (mouse-absolute-pixel-position))) (first-x (car first-x-y)) (first-y (cdr first-x-y)) (exitfun nil) @@ -1119,7 +1122,9 @@ frame with the mouse." (lambda (event) (interactive "e") (when (consp event) - (let* ((last-x-y (mouse-absolute-pixel-position)) + (let* ((last-x-y (if tty + (mouse-position-in-root-frame) + (mouse-absolute-pixel-position))) (last-x (car last-x-y)) (last-y (cdr last-x-y)) (left (- last-x first-x)) @@ -1228,10 +1233,13 @@ frame with the mouse." (parent-bottom (and parent-edges (nth 3 parent-edges))) ;; Initial "first" mouse position. While dragging we base all ;; calculations against that position. - (first-x-y (mouse-absolute-pixel-position)) - (first-x (car first-x-y)) - (first-y (cdr first-x-y)) - ;; `snap-width' (maybe also a yet to be provided `snap-height') + (tty (tty-type frame)) + (first-x-y (if tty + (mouse-position-in-root-frame) + (mouse-absolute-pixel-position))) + (first-x (car first-x-y)) + (first-y (cdr first-x-y)) + ;; `snap-width' (maybe also a yet to be provided `snap-height') ;; could become floats to handle proportionality wrt PARENT. ;; We don't do any checks on this parameter so far. (snap-width (frame-parameter frame 'snap-width)) @@ -1247,7 +1255,9 @@ frame with the mouse." (lambda (event) (interactive "e") (when (consp event) - (let* ((last-x-y (mouse-absolute-pixel-position)) + (let* ((last-x-y (if tty + (mouse-position-in-root-frame) + (mouse-absolute-pixel-position))) (last-x (car last-x-y)) (last-y (cdr last-x-y)) (left (- last-x first-x)) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 94b3f08de96..89f9bbab608 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -306,19 +306,41 @@ which is the \"1006\" extension implemented in Xterm >= 277." (x (or (nth 1 frame-and-xy) x)) (y (or (nth 2 frame-and-xy) y)) (w (window-at x y frame)) - (ltrb (window-edges w)) - (left (nth 0 ltrb)) - (top (nth 1 ltrb)) - (posn (if w - (posn-at-x-y (- x left) (- y top) w t) - (append (list nil (if (and tab-bar-mode - (or (not menu-bar-mode) - ;; The tab-bar is on the - ;; second row below menu-bar - (eq y 1))) - 'tab-bar - 'menu-bar)) - (nthcdr 2 (posn-at-x-y x y (selected-frame)))))) + (posn + (if w + (let* ((ltrb (window-edges w)) + (left (nth 0 ltrb)) + (top (nth 1 ltrb))) + (posn-at-x-y (- x left) (- y top) w t)) + (let* ((frame-has-menu-bar + (not (zerop (frame-parameter frame 'menu-bar-lines)))) + (frame-has-tab-bar + (not (zerop (frame-parameter frame 'tab-bar-lines)))) + (item + (cond + ((and frame-has-menu-bar (eq y 0)) + 'menu-bar) + ((and frame-has-tab-bar + (or (and frame-has-menu-bar + (eq y 1)) + (eq y 0))) + 'tab-bar) + ((eq x -1) + (cond + ((eq y -1) 'top-left-corner) + ((eq y (frame-height frame)) 'bottom-left-corner) + (t 'left-edge))) + ((eq x (frame-width frame)) + (cond + ((eq y -1) 'top-right-corner) + ((eq y (frame-height frame)) 'bottom-right-corner) + (t 'right-edge))) + ((eq y -1) 'top-edge) + (t 'bottom-edge)))) + (append (list (unless (memq item '(menu-bar tab-bar)) + frame) + item) + (nthcdr 2 (posn-at-x-y x y (selected-frame))))))) (event (list type posn))) (setcar (nthcdr 3 posn) timestamp) diff --git a/src/frame.c b/src/frame.c index bbff0dec2e4..c1ef26e5dd4 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2897,7 +2897,7 @@ The functions are run with one argument, the frame to be deleted. */) return delete_frame (frame, !NILP (force) ? Qt : Qnil); } -#ifdef HAVE_WINDOW_SYSTEM + /** * frame_internal_border_part: * @@ -2920,7 +2920,11 @@ The functions are run with one argument, the frame to be deleted. */) enum internal_border_part frame_internal_border_part (struct frame *f, int x, int y) { - int border = FRAME_INTERNAL_BORDER_WIDTH (f); + int border = (FRAME_INTERNAL_BORDER_WIDTH (f) + ? FRAME_INTERNAL_BORDER_WIDTH (f) + : (is_tty_child_frame (f) && !FRAME_UNDECORATED (f)) + ? 1 + : 0); int offset = FRAME_LINE_HEIGHT (f); int width = FRAME_PIXEL_WIDTH (f); int height = FRAME_PIXEL_HEIGHT (f); @@ -2989,7 +2993,7 @@ frame_internal_border_part (struct frame *f, int x, int y) return part; } -#endif + /* Return mouse position in character cell units. */ @@ -6549,6 +6553,36 @@ selected frame. This is useful when `make-pointer-invisible' is set. */) return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt; } +DEFUN ("mouse-position-in-root-frame", Fmouse_position_in_root_frame, + Smouse_position_in_root_frame, 0, 0, 0, + doc: /* Return mouse position in selected frame's root frame. +Return the position of `mouse-position' in coordinates of the root frame +of the frame returned by 'mouse-position'. */) + (void) +{ + Lisp_Object pos = mouse_position (true); + Lisp_Object frame = XCAR (pos); + struct frame *f = XFRAME (frame); + int x = XFIXNUM (XCAR (XCDR (pos))) + f->left_pos; + int y = XFIXNUM (XCDR (XCDR (pos))) + f->top_pos; + + if (!FRAMEP (frame)) + return Qnil; + else + { + f = FRAME_PARENT_FRAME (f); + + while (f) + { + x = x + f->left_pos; + y = y + f->top_pos; + f = FRAME_PARENT_FRAME (f); + } + + return Fcons (make_fixnum (x), make_fixnum (y)); + } +} + DEFUN ("frame--set-was-invisible", Fframe__set_was_invisible, Sframe__set_was_invisible, 2, 2, 0, doc: /* Set FRAME's was-invisible flag if WAS-INVISIBLE is non-nil. @@ -7334,6 +7368,7 @@ allow `make-frame' to show the current buffer even if its hidden. */); defsubr (&Sframe_position); defsubr (&Sset_frame_position); defsubr (&Sframe_pointer_visible_p); + defsubr (&Smouse_position_in_root_frame); defsubr (&Sframe__set_was_invisible); defsubr (&Sframe_window_state_change); defsubr (&Sset_frame_window_state_change); diff --git a/src/frame.h b/src/frame.h index a70d9caf5df..62b2edcb315 100644 --- a/src/frame.h +++ b/src/frame.h @@ -31,6 +31,19 @@ enum vertical_scroll_bar_type vertical_scroll_bar_right }; +enum internal_border_part + { + INTERNAL_BORDER_NONE, + INTERNAL_BORDER_LEFT_EDGE, + INTERNAL_BORDER_TOP_LEFT_CORNER, + INTERNAL_BORDER_TOP_EDGE, + INTERNAL_BORDER_TOP_RIGHT_CORNER, + INTERNAL_BORDER_RIGHT_EDGE, + INTERNAL_BORDER_BOTTOM_RIGHT_CORNER, + INTERNAL_BORDER_BOTTOM_EDGE, + INTERNAL_BORDER_BOTTOM_LEFT_CORNER, + }; + #ifdef HAVE_WINDOW_SYSTEM enum fullscreen_type @@ -53,19 +66,6 @@ enum z_group z_group_above_suspended, }; -enum internal_border_part - { - INTERNAL_BORDER_NONE, - INTERNAL_BORDER_LEFT_EDGE, - INTERNAL_BORDER_TOP_LEFT_CORNER, - INTERNAL_BORDER_TOP_EDGE, - INTERNAL_BORDER_TOP_RIGHT_CORNER, - INTERNAL_BORDER_RIGHT_EDGE, - INTERNAL_BORDER_BOTTOM_RIGHT_CORNER, - INTERNAL_BORDER_BOTTOM_EDGE, - INTERNAL_BORDER_BOTTOM_LEFT_CORNER, - }; - #ifdef NS_IMPL_COCOA enum ns_appearance_type { @@ -1862,7 +1862,6 @@ extern Lisp_Object gui_display_get_resource (Display_Info *, extern void set_frame_menubar (struct frame *f, bool deep_p); extern void frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y); extern void free_frame_menubar (struct frame *); -extern enum internal_border_part frame_internal_border_part (struct frame *f, int x, int y); #if defined HAVE_X_WINDOWS extern void x_wm_set_icon_position (struct frame *, int, int); @@ -1888,6 +1887,8 @@ gui_set_bitmap_icon (struct frame *f) #endif /* !HAVE_NS */ #endif /* HAVE_WINDOW_SYSTEM */ +extern enum internal_border_part frame_internal_border_part (struct frame *f, + int x, int y); extern bool frame_ancestor_p (struct frame *af, struct frame *df); INLINE void diff --git a/src/keyboard.c b/src/keyboard.c index 21a3b3bcf4e..f3a8d8bab77 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5553,7 +5553,6 @@ static short const scroll_bar_parts[] = { SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio) }; -#ifdef HAVE_WINDOW_SYSTEM /* An array of symbol indexes of internal border parts, indexed by an enum internal_border_part value. Note that Qnil corresponds to internal_border_part_none and should not appear in Lisp events. */ @@ -5564,7 +5563,6 @@ static short const internal_border_parts[] = { SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge), SYMBOL_INDEX (Qbottom_left_corner) }; -#endif /* A vector, indexed by button number, giving the down-going location of currently depressed buttons, both scroll bar and non-scroll bar. @@ -5599,6 +5597,90 @@ static Time button_down_time; static int double_click_count; +enum frame_border_side +{ + ON_LEFT, + ON_TOP, + ON_RIGHT, + ON_BOTTOM, + ON_NONE +}; + +/* Handle make_lispy_event when a tty child frame's decorations shall be + used in lieu of internal borders. R denotes the root frame under + investigation, MX and MY are the positions of the mouse relative to + R. WINDOW_OR_FRAME denotes the frame previously reported as the + frame under (MX, MY). Note: The decorations of a child frame are + always drawn outside the child frame, so WINDOW_OR_FRAME is certainly + not the frame we are looking for. Neither is R. A candidate frame + is any frame but WINDOW_OR_FRAME and R whose root is R, which is not + decorated and has a 'drag-internal-border' parameter. If we find a + suitable frame, set WINDOW_OR_FRAME to it and POSN to the part of the + internal border corresponding to (MX, MY) on the frame found. */ + +static void +make_lispy_tty_position (struct frame *r, int mx, int my, + Lisp_Object *window_or_frame, Lisp_Object *posn) +{ + enum frame_border_side side = ON_NONE; + struct frame *f = NULL; + Lisp_Object tail, frame; + int ix, iy = 0; + + FOR_EACH_FRAME (tail, frame) + { + f = XFRAME (frame); + + int left = f->left_pos; + int top = f->top_pos; + int right = left + f->pixel_width; + int bottom = top + f->pixel_height; + + if (root_frame (f) == r && f != r + && !FRAME_UNDECORATED (f) + && !NILP (get_frame_param (f, Qdrag_internal_border))) + { + if (left == mx + 1 && my >= top && my <= bottom) + { + side = ON_LEFT; + ix = -1; + iy = my - top + 1; + break; + } + else if (right == mx && my >= top && my <= bottom) + { + side = ON_RIGHT; + ix = f->pixel_width; + iy = my - top + 1; + break; + } + else if (top == my + 1 && mx >= left && mx <= right) + { + side = ON_TOP; + ix = mx - left + 1; + iy = -1; + break; + } + else if (bottom == my && mx >= left && mx <= right) + { + side = ON_BOTTOM; + ix = mx - left + 1; + iy = f->pixel_height; + break; + } + } + } + + if (side != ON_NONE) + { + enum internal_border_part part + = frame_internal_border_part (f, ix, iy); + + XSETFRAME (*window_or_frame, f); + *posn = builtin_lisp_symbol (internal_border_parts[part]); + } +} + /* X and Y are frame-relative coordinates for a click or wheel event. Return a Lisp-style event list. */ @@ -5677,7 +5759,14 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, window_or_frame = Qnil; /* see above */ } - if (WINDOWP (window_or_frame)) + if (WINDOWP (window_or_frame) && is_tty_frame (f) + && (is_tty_root_frame_with_visible_child (f) + || is_tty_child_frame (f))) + make_lispy_tty_position (root_frame (f), mx, my, &window_or_frame, &posn); + + if (!NILP (posn)) + ; + else if (WINDOWP (window_or_frame)) { /* It's a click in window WINDOW at frame coordinates (X,Y) */ struct window *w = XWINDOW (window_or_frame); @@ -5880,9 +5969,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, xret = mx; yret = my; -#ifdef HAVE_WINDOW_SYSTEM - if (FRAME_WINDOW_P (f) - && FRAME_LIVE_P (f) + if (FRAME_LIVE_P (f) && NILP (posn) && FRAME_INTERNAL_BORDER_WIDTH (f) > 0 && !NILP (get_frame_param (f, Qdrag_internal_border))) @@ -5892,7 +5979,6 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, posn = builtin_lisp_symbol (internal_border_parts[part]); } -#endif } else { @@ -12572,7 +12658,9 @@ The `posn-' functions access elements of such lists. */) into the left fringe. */ if (XFIXNUM (x) != -1) CHECK_FIXNAT (x); - CHECK_FIXNAT (y); + CHECK_FIXNUM (y); + if (XFIXNUM (y) != -1) + CHECK_FIXNAT (y); if (NILP (frame_or_window)) frame_or_window = selected_window; diff --git a/src/term.c b/src/term.c index bc7a9c78f0d..e15b7a0887e 100644 --- a/src/term.c +++ b/src/term.c @@ -2676,12 +2676,68 @@ tty_frame_at (int x, int y, int *cx, int *cy) Lisp_Object frame = Fcar (frames); struct frame *f = XFRAME (frame); int fx, fy; + bool on_border = false; + root_xy (f, 0, 0, &fx, &fy); - if ((fx <= x && x < fx + f->pixel_width) - && (fy <= y && y < fy + f->pixel_height)) + if (!FRAME_UNDECORATED (f) && FRAME_PARENT_FRAME (f)) + { + if (fy - 1 <= y && y <= fy + f->pixel_height + 1) + { + if (fx == x + 1) + { + *cx = -1; + on_border = true; + } + else if (fx + f->pixel_width == x) + { + *cx = f->pixel_width; + on_border = true; + } + + if (on_border) + { + *cy = y - fy; + + return frame; + } + } + + if (fx - 1 <= x && x <= fx + f->pixel_width + 1) + { + if (fy == y + 1) + { + *cy = -1; + on_border = true; + } + else if (fy + f->pixel_height == y) + { + *cy = f->pixel_height; + on_border = true; + } + + if (on_border) + { + *cx = x - fx; + + return frame; + } + } + + + if ((fx <= x && x <= fx + f->pixel_width) + && (fy <= y && y <= fy + f->pixel_height)) + { + child_xy (XFRAME (frame), x, y, cx, cy); + + return frame; + } + } + else if ((fx <= x && x <= fx + f->pixel_width) + && (fy <= y && y <= fy + f->pixel_height)) { child_xy (XFRAME (frame), x, y, cx, cy); + return frame; } } @@ -2705,6 +2761,7 @@ relative to FRAME. */) Lisp_Object frame = tty_frame_at (XFIXNUM (x), XFIXNUM (y), &cx, &cy); if (NILP (frame)) return Qnil; + return list3 (frame, make_fixnum (cx), make_fixnum (cy)); } diff --git a/src/window.c b/src/window.c index 330a95a716f..1ac004af5e0 100644 --- a/src/window.c +++ b/src/window.c @@ -1758,6 +1758,13 @@ function returns nil. */) { struct frame *f = decode_live_frame (frame); + CHECK_INTEGER (x); + CHECK_INTEGER (y); + + if (XFIXNUM (x) < 0 || XFIXNUM (x) > FRAME_PIXEL_WIDTH (f) + || XFIXNUM (y) < 0 || XFIXNUM (y) > FRAME_PIXEL_HEIGHT (f)) + return Qnil; + CHECK_NUMBER (x); CHECK_NUMBER (y); commit 7e71b0a2c938623872ec7404d81339c8ff51b012 Author: Martin Rudalics Date: Mon Mar 17 09:36:59 2025 +0100 Implement surrogate menu bars for tty child frames * lisp/menu-bar.el (popup-menu): When asked to pop up MENU from a tty child frame try to use menu of its root frame. (menu-bar-open): When FRAME is a child frame and 'tty-menu-open-use-tmm' is nil, navigate menu bar of its root frame. * src/keymap.c (Fcurrent_active_maps): Accept live window as POSITION argument and use its buffer as current when processing the key sequence. Needed for tty child frames so the root frame's menu bar can be updated according to the selected window's buffer when navigating the menu bar from keyboard. * src/xdisp.c (prepare_menu_bars): If the selected window's frame is a tty child frame without menu bar, that frame's root frame has a menu bar and 'tty-menu-open-use-tmm' is nil, prepare to update the menu bar of the root frame as surrogate. (update_menu_bar): New argument W denoting the window that should be considered as selected. For a tty child frame using F as surrogate menu bar frame this specifies the child frame's selected window and its buffer shall be used for updating the menu bar of the root frame instead of the buffer of the root frame's selected window. (redisplay_window): Instead of setting redisplay_menu_p flag always call display_menu_bar right away. This facilitates to call display_menu_bar for a tty child frame with its root frame as surrogate menu bar frame. (display_tty_menu_item): If the selected frame is a tty child frame, overwrite its root frame's glyph matrix (and not that of the child frame) when displaying a menu item. (Qtty_menu_open_use_tmm): Define symbol. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 9a6cda24219..1685357fab6 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2691,53 +2691,74 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." (filter (when (symbolp map) (plist-get (get map 'menu-prop) :filter)))) (if filter (funcall filter (symbol-function map)) map))))) - (frame (selected-frame)) + (selected-frame (selected-frame)) + (frame (if (and (eq (framep selected-frame) t) (frame-parent) + from-menu-bar + (zerop (or (frame-parameter nil 'menu-bar-lines) 0))) + ;; If the selected frame is a tty child frame + ;; without its own menu bar and we are called from + ;; the menu bar, the menu bar must be on the root + ;; frame of the selected frame. + (frame-root-frame) + (selected-frame))) event cmd) - (if from-menu-bar - (let* ((xy (posn-x-y position)) - (menu-symbol (menu-bar-menu-at-x-y (car xy) (cdr xy)))) - (setq position (list menu-symbol (list frame '(menu-bar) - xy 0)))) - (setq position (popup-menu-normalize-position position))) - ;; The looping behavior was taken from lmenu's popup-menu-popup - (while (and map (setq event - ;; map could be a prefix key, in which case - ;; we need to get its function cell - ;; definition. - (x-popup-menu position (indirect-function map)))) - ;; Strangely x-popup-menu returns a list. - ;; mouse-major-mode-menu was using a weird: - ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events))) - (setq cmd - (cond - ((and from-menu-bar - (consp event) - (numberp (car event)) - (numberp (cdr event))) - (let ((x (car event)) - (y (cdr event)) - menu-symbol) - (setq menu-symbol (menu-bar-menu-at-x-y x y)) - (setq position (list menu-symbol (list frame '(menu-bar) - event 0))) - (setq map - (key-binding (vector 'menu-bar menu-symbol))))) - ((and (not (keymapp map)) (listp map)) - ;; We were given a list of keymaps. Search them all - ;; in sequence until a first binding is found. - (let ((mouse-click (apply 'vector event)) - binding) - (while (and map (null binding)) - (setq binding (lookup-key-ignore-too-long (car map) mouse-click)) - (setq map (cdr map))) - binding)) - (t - ;; We were given a single keymap. - (lookup-key map (apply 'vector event))))) - ;; Clear out echoing, which perhaps shows a prefix arg. - (message "") - ;; Maybe try again but with the submap. - (setq map (if (keymapp cmd) cmd))) + (with-selected-frame frame + (if from-menu-bar + (let* ((xy (posn-x-y position)) + (menu-symbol (menu-bar-menu-at-x-y (car xy) (cdr xy)))) + (setq position (list menu-symbol (list frame '(menu-bar) + xy 0)))) + (setq position (popup-menu-normalize-position position))) + + ;; The looping behavior was taken from lmenu's popup-menu-popup + (while (and map (setq event + ;; map could be a prefix key, in which case + ;; we need to get its function cell + ;; definition. + (x-popup-menu position (indirect-function map)))) + ;; Strangely x-popup-menu returns a list. + ;; mouse-major-mode-menu was using a weird: + ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events))) + (setq cmd + (cond + ((and from-menu-bar + (consp event) + (numberp (car event)) + (numberp (cdr event))) + (let ((x (car event)) + (y (cdr event)) + menu-symbol) + (setq menu-symbol (menu-bar-menu-at-x-y x y)) + (setq position (list menu-symbol (list frame '(menu-bar) + event 0))) + (if (not (eq frame selected-frame)) + ;; If we are using the menu bar from the root + ;; frame, look up the key binding in the keymaps + ;; of the initially selected window's buffer to + ;; make sure that navigating the menu bar with the + ;; keyboard works as intended. + (setq map + (key-binding (vector 'menu-bar menu-symbol) nil nil + (frame-selected-window selected-frame))) + (setq map + (key-binding (vector 'menu-bar menu-symbol)))))) + ((and (not (keymapp map)) (listp map)) + ;; We were given a list of keymaps. Search them all + ;; in sequence until a first binding is found. + (let ((mouse-click (apply 'vector event)) + binding) + (while (and map (null binding)) + (setq binding (lookup-key-ignore-too-long (car map) mouse-click)) + (setq map (cdr map))) + binding)) + (t + ;; We were given a single keymap. + (lookup-key map (apply 'vector event))))) + ;; Clear out echoing, which perhaps shows a prefix arg. + (message "") + ;; Maybe try again but with the submap. + (setq map (if (keymapp cmd) cmd)))) + ;; If the user did not cancel by refusing to select, ;; and if the result is a command, run it. (when (and (null map) (commandp cmd)) @@ -2808,14 +2829,27 @@ is nil or not. If FRAME is nil or not given, use the selected frame." (interactive (list nil (prefix-numeric-value current-prefix-arg))) - (let ((type (framep (or frame (selected-frame))))) + (let* ((type (framep (or frame (selected-frame)))) + root + (frame (if (and (eq type t) (frame-parent frame) + (null tty-menu-open-use-tmm) + (zerop (or (frame-parameter frame 'menu-bar-lines) 0)) + (setq root (frame-root-frame)) + (not (zerop + (or (frame-parameter root 'menu-bar-lines) 0)))) + ;; If FRAME is a tty child frame without its own + ;; menu bar, 'tty-menu-open-use-tmm' is false and + ;; FRAME's root frame has a menu bar, use that root + ;; frame's menu bar. + root + frame))) (cond ((eq type 'x) (x-menu-bar-open frame)) ((eq type 'w32) (w32-menu-bar-open frame)) ((eq type 'haiku) (haiku-menu-bar-open frame)) ((eq type 'pgtk) (pgtk-menu-bar-open frame)) ((and (null tty-menu-open-use-tmm) - (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0)))) + (not (zerop (or (frame-parameter frame 'menu-bar-lines) 0)))) ;; Make sure the menu bar is up to date. One situation where ;; this is important is when this function is invoked by name ;; via M-x, in which case the menu bar includes the "Minibuf" @@ -2831,7 +2865,7 @@ If FRAME is nil or not given, use the selected frame." (current-local-map) (vector 'menu-bar menu)) (cdar (minor-mode-key-binding (vector 'menu-bar menu))) (mouse-menu-bar-map)) - (posn-at-x-y x 0 nil t) nil t))) + (posn-at-x-y x 0 frame t) nil t))) (t (with-selected-frame (or frame (selected-frame)) (tmm-menubar)))))) diff --git a/src/keymap.c b/src/keymap.c index bc731c54ef0..2c250578b00 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1652,7 +1652,8 @@ DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps, doc: /* Return a list of the currently active keymaps. OLP if non-nil indicates that we should obey `overriding-local-map' and `overriding-terminal-local-map'. POSITION can specify a click position -like in the respective argument of `key-binding'. */) +like in the respective argument of `key-binding' or a live window which +means to return the active maps for that window's buffer. */) (Lisp_Object olp, Lisp_Object position) { specpdl_ref count = SPECPDL_INDEX (); @@ -1682,6 +1683,16 @@ like in the respective argument of `key-binding'. */) set_buffer_internal (XBUFFER (XWINDOW (window)->contents)); } } + else if (WINDOW_LIVE_P (position)) + { + if (BUFFERP (XWINDOW (position)->contents) + && XBUFFER (XWINDOW (position)->contents) != current_buffer) + { + /* See comment above. */ + record_unwind_current_buffer (); + set_buffer_internal (XBUFFER (XWINDOW (position)->contents)); + } + } if (!NILP (olp) /* The doc said that overriding-terminal-local-map should diff --git a/src/xdisp.c b/src/xdisp.c index d7e0691c44d..c396b213b92 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1147,7 +1147,7 @@ static bool set_cursor_from_row (struct window *, struct glyph_row *, struct glyph_matrix *, ptrdiff_t, ptrdiff_t, int, int); static bool cursor_row_fully_visible_p (struct window *, bool, bool, bool); -static bool update_menu_bar (struct frame *, bool, bool); +static bool update_menu_bar (struct frame *, bool, bool, struct window *); static bool try_window_reusing_current_matrix (struct window *); static int try_window_id (struct window *); static void maybe_produce_line_number (struct it *); @@ -14066,13 +14066,32 @@ prepare_menu_bars (void) /* True means that update_menu_bar has run its hooks so any further calls to update_menu_bar shouldn't do so again. */ bool menu_bar_hooks_run = false; + struct window *sw = XWINDOW (selected_window); + struct frame *sf = WINDOW_XFRAME (sw); + struct frame *rf = NULL; + + if (FRAME_PARENT_FRAME (sf) && !FRAME_WINDOW_P (sf) + && FRAME_MENU_BAR_LINES (sf) == 0 + && FRAME_MENU_BAR_LINES (rf = root_frame (sf)) != 0 + && NILP (Fdefault_value (Qtty_menu_open_use_tmm))) + /* If the selected window's frame is a tty child frame without + menu bar, that frame's root frame has a menu bar and + 'tty-menu-open-use-tmm' is nil, update the menu bar of the + root frame from the selected window. */ + sf = rf; + else + { + sf = NULL; + sw = NULL; + } record_unwind_save_match_data (); FOR_EACH_FRAME (tail, frame) { struct frame *f = XFRAME (frame); - struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f)); + struct window *w + = sf == f ? sw : XWINDOW (FRAME_SELECTED_WINDOW (f)); /* Ignore tooltip frame. */ if (FRAME_TOOLTIP_P (f)) @@ -14084,8 +14103,8 @@ prepare_menu_bars (void) && !XBUFFER (w->contents)->text->redisplay) continue; - if (!FRAME_PARENT_FRAME (f)) - menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run); + menu_bar_hooks_run + = update_menu_bar (f, false, menu_bar_hooks_run, w); update_tab_bar (f, false); #ifdef HAVE_WINDOW_SYSTEM @@ -14097,10 +14116,21 @@ prepare_menu_bars (void) } else { - struct frame *sf = SELECTED_FRAME (); + struct window *sw = XWINDOW (selected_window); + struct frame *sf = WINDOW_XFRAME (sw); + struct frame *rf = NULL; - if (!FRAME_PARENT_FRAME (sf)) - update_menu_bar (sf, true, false); + if (FRAME_PARENT_FRAME (sf) && !FRAME_WINDOW_P (sf) + && FRAME_MENU_BAR_LINES (sf) == 0 + && FRAME_MENU_BAR_LINES (rf = root_frame (sf)) != 0 + && NILP (Fdefault_value (Qtty_menu_open_use_tmm))) + /* If the selected window's frame is a tty child frame without + menu bar, that frame's root frame has a menu bar and + 'tty-menu-open-use-tmm' is nil, update the menu bar of the + root frame from the selected window. */ + sf = rf; + + update_menu_bar (sf, true, false, sw); update_tab_bar (sf, true); #ifdef HAVE_WINDOW_SYSTEM @@ -14119,23 +14149,23 @@ prepare_menu_bars (void) If HOOKS_RUN, a previous call to update_menu_bar already ran the menu bar hooks for this redisplay, so there is no need to run them again. The return value is the - updated value of this flag, to pass to the next call. */ + updated value of this flag, to pass to the next call. + + W, if set, denotes the window that should be considered as selected. + For a tty child frame using F as surrogate menu bar frame, this + specifes the child frame's selected window and its buffer shall be + used for updating the menu bar of the root frame instead of the + buffer of the root frame's selected window. */ static bool -update_menu_bar (struct frame *f, bool save_match_data, bool hooks_run) +update_menu_bar (struct frame *f, bool save_match_data, bool hooks_run, struct window *w) { - Lisp_Object window; - struct window *w; - /* If called recursively during a menu update, do nothing. This can happen when, for instance, an activate-menubar-hook causes a redisplay. */ if (inhibit_menubar_update) return hooks_run; - window = FRAME_SELECTED_WINDOW (f); - w = XWINDOW (window); - if (FRAME_WINDOW_P (f) ? #ifdef HAVE_EXT_MENU_BAR @@ -21195,24 +21225,33 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* When we reach a frame's selected window, redo the frame's menu bar, tool bar, tab-bar, and the frame's title. */ - if (update_mode_line - && EQ (FRAME_SELECTED_WINDOW (f), window)) + if (update_mode_line && EQ (FRAME_SELECTED_WINDOW (f), window)) { - bool redisplay_menu_p; - if (FRAME_WINDOW_P (f)) { #ifdef HAVE_EXT_MENU_BAR - redisplay_menu_p = FRAME_EXTERNAL_MENU_BAR (f); + if (FRAME_EXTERNAL_MENU_BAR (f)) + display_menu_bar (w); #else - redisplay_menu_p = FRAME_MENU_BAR_LINES (f) > 0; + if (FRAME_MENU_BAR_LINES (f) > 0) + display_menu_bar (w); #endif } else - redisplay_menu_p = FRAME_MENU_BAR_LINES (f) > 0; + { + struct frame *rf = NULL; - if (redisplay_menu_p) - display_menu_bar (w); + if (FRAME_PARENT_FRAME (f) + && FRAME_MENU_BAR_LINES (f) == 0 + && FRAME_MENU_BAR_LINES (rf = root_frame (f)) != 0 + && NILP (Fdefault_value (Qtty_menu_open_use_tmm))) + /* If F is a tty child frame without menu bar, that frame's root + frame has a menu bar and 'tty-menu-open-use-tmm' is nil, + display the menu bar of the root frame's selected window. */ + display_menu_bar (XWINDOW (FRAME_SELECTED_WINDOW (rf))); + else if (FRAME_MENU_BAR_LINES (f) > 0) + display_menu_bar (w); + } #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) @@ -27466,10 +27505,19 @@ display_tty_menu_item (const char *item_text, int width, int face_id, { struct it it; struct frame *f = SELECTED_FRAME (); - struct window *w = XWINDOW (f->selected_window); struct glyph_row *row; size_t item_len = strlen (item_text); + struct frame *rf = NULL; + + if (FRAME_PARENT_FRAME (f) && !FRAME_WINDOW_P (f) + && FRAME_MENU_BAR_LINES (f) == 0 + && FRAME_MENU_BAR_LINES (rf = root_frame (f)) != 0 + && NILP (Fdefault_value (Qtty_menu_open_use_tmm))) + f = rf; + + struct window *w = XWINDOW (f->selected_window); + eassert (FRAME_TERMCAP_P (f)); /* Don't write beyond the matrix's last row. This can happen for @@ -38610,6 +38658,7 @@ depending on your patience and the speed of your system. */); DEFSYM (Qnhdrag, "nhdrag"); DEFSYM (Qvdrag, "vdrag"); DEFSYM (Qhourglass, "hourglass"); + DEFSYM (Qtty_menu_open_use_tmm, "tty-menu-open-use-tmm"); } commit d708ebe401a2001e764821b7e43d9e9aaa23ea95 Author: Yuan Fu Date: Sun Mar 16 22:47:00 2025 -0700 ; Add NEWS entry for java-ts-mode-method-chaining-indent-offset * etc/NEWS: Add entry. diff --git a/etc/NEWS b/etc/NEWS index f9b5388bd53..98aea4280e3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -980,6 +980,11 @@ are highlighted like other comments. When non-nil, Doxygen comment blocks are syntax-highlighted if the Doxygen grammar library is available. +--- +*** New user option 'java-ts-mode-method-chaining-indent-offset' +Now method chaining is indented by 8 spaces rather than 4, and this +variable controls how much is indented for method chaining. + ** Emacs Lisp mode --- commit eb63d0c04a6747a8a1847b88a50befb4e425e7a3 Author: Yuan Fu Date: Sun Mar 16 22:38:26 2025 -0700 Add some keywords to java-ts-mode--keywords (bug#75154) * lisp/progmodes/java-ts-mode.el: (java-ts-mode--keywords): Add keywords, remove @interface. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index ca169543b5a..c4b2282b574 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -180,17 +180,16 @@ PARENT and BOL are the as in other matchers." "Tree-sitter indent rules.") (defvar java-ts-mode--keywords - '("abstract" "assert" "break" "case" "catch" - "class" "continue" "default" "do" "else" - "enum" "exports" "extends" "final" "finally" + '("abstract" "assert" "break" + "case" "catch" "class" "continue" "default" "do" + "else" "enum" "exports" "extends" "final" "finally" "for" "if" "implements" "import" "instanceof" - "interface" "module" "native" "new" "non-sealed" - "open" "opens" "package" "private" "protected" - "provides" "public" "requires" "return" "sealed" - "static" "strictfp" "switch" "synchronized" - "throw" "throws" "to" "transient" "transitive" - "try" "uses" "volatile" "while" "with" "record" - "@interface") + "interface" "long" "module" "native" "new" "non-sealed" + "open" "opens" "package" "permits" "private" "protected" + "provides" "public" "record" "requires" "return" "sealed" + "short" "static" "strictfp" "switch" "synchronized" + "throw" "throws" "to" "transient" "transitive" "try" + "uses" "volatile" "when" "while" "with" "yield") "Java keywords for tree-sitter font-locking.") (defvar java-ts-mode--operators commit 3d2d95e28431a16897a65543d8b26c791b389ef6 Author: Yuan Fu Date: Sun Mar 16 22:30:42 2025 -0700 Move around java-ts-mode font-lock rules (bug#75154) * lisp/progmodes/java-ts-mode.el: (java-ts-mode--font-lock-settings): Move constant feature down so it overrides expression and definition. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index c7b44fc8b74..ca169543b5a 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -236,11 +236,6 @@ For NODE, OVERRIDE, START, and END, see `treesit-font-lock-rules'." (block_comment) @font-lock-comment-face) :language 'java :override t - :feature 'constant - `((identifier) @java-ts-mode--fontify-constant - [(true) (false)] @font-lock-constant-face) - :language 'java - :override t :feature 'keyword `([,@java-ts-mode--keywords (this) @@ -346,7 +341,13 @@ For NODE, OVERRIDE, START, and END, see `treesit-font-lock-rules'." (argument_list (identifier) @font-lock-variable-name-face) (expression_statement (identifier) @font-lock-variable-use-face)) - + ;; Make sure the constant feature is after expression and definition, + ;; because those two applies variable-name-face on some constants. + :language 'java + :override t + :feature 'constant + `((identifier) @java-ts-mode--fontify-constant + [(true) (false)] @font-lock-constant-face) :language 'java :feature 'bracket '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) commit 93cd55f40e5e1788e55d82c572f1fafac1dee499 Author: Yuan Fu Date: Thu Feb 13 18:24:41 2025 -0800 Use c-ts-common baseline rule in java-ts-mode (bug#75154) Use it for function parameters. * lisp/progmodes/java-ts-mode.el: (java-ts-mode--standalone-predicate): New function. (java-ts-mode--indent-rules): Comment out rules for function parameters and statements, and add c-ts-common-baseline-indent-rule as fallback. (java-ts-mode): Setup. (java-ts-mode--first-line-on-multi-line-string): Mark BOL as unused. * test/lisp/progmodes/java-ts-mode-resources/indent.erts: New test. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index e53e34cb6dc..c7b44fc8b74 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -91,7 +91,18 @@ again." table) "Syntax table for `java-ts-mode'.") -(defun java-ts-mode--first-line-on-multi-line-string (_node parent bol &rest _) +(defun java-ts-mode--standalone-predicate (node) + "Java's standalone predicate. +Return t if NODE is on the start of a line." + (save-excursion + (goto-char (treesit-node-start node)) + (if (looking-back (rx bol (* whitespace) (? ".")) (pos-bol)) + t + (back-to-indentation) + (when (eq (char-after) ?.) + (point))))) + +(defun java-ts-mode--first-line-on-multi-line-string (_node parent _bol &rest _) "Simple-indent matcher for the first line in a multi-line string block. PARENT and BOL are the as in other matchers." (and (treesit-node-match-p parent "multiline_string_fragment") @@ -154,8 +165,8 @@ PARENT and BOL are the as in other matchers." ((parent-is "argument_list") parent-bol java-ts-mode-indent-offset) ((parent-is "annotation_argument_list") parent-bol java-ts-mode-indent-offset) ((parent-is "modifiers") parent-bol 0) - ((parent-is "formal_parameters") parent-bol java-ts-mode-indent-offset) - ((parent-is "formal_parameter") parent-bol 0) + ;; ((parent-is "formal_parameters") parent-bol java-ts-mode-indent-offset) + ;; ((parent-is "formal_parameter") parent-bol 0) ((parent-is "init_declarator") parent-bol java-ts-mode-indent-offset) ((parent-is "if_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "for_statement") parent-bol java-ts-mode-indent-offset) @@ -164,7 +175,8 @@ PARENT and BOL are the as in other matchers." ((parent-is "case_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "do_statement") parent-bol java-ts-mode-indent-offset) - ((parent-is "block") standalone-parent java-ts-mode-indent-offset))) + ;; ((parent-is "block") standalone-parent java-ts-mode-indent-offset) + c-ts-common-baseline-indent-rule)) "Tree-sitter indent rules.") (defvar java-ts-mode--keywords @@ -401,6 +413,9 @@ Return nil if there is no name or if NODE is not a defun node." (do . "do_statement"))) (setq-local c-ts-common-indent-offset 'java-ts-mode-indent-offset) (setq-local treesit-simple-indent-rules java-ts-mode--indent-rules) + (setq-local treesit-simple-indent-standalone-predicate + #'java-ts-mode--standalone-predicate) + (setq-local c-ts-common-list-indent-style 'simple) ;; Electric (setq-local electric-indent-chars diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts index 514d2e08977..7cf59340454 100644 --- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -141,3 +141,31 @@ public class Java { } } =-=-= + +Name: Method chaining + +=-= +public class FloodFill { +public static void main(String[] args) { +List stream = students.stream(MAX_VALUE) +.filter(item -> { +return item.getValue() > 100 && +item.isActive(); +}) +.map() +.collect(); +} +} +=-= +public class FloodFill { + public static void main(String[] args) { + List stream = students.stream(MAX_VALUE) + .filter(item -> { + return item.getValue() > 100 && + item.isActive(); + }) + .map() + .collect(); + } +} +=-=-= commit affb2ba77b4a7ec7c000b18cc5c30d237e1b7165 Author: Yuan Fu Date: Thu Feb 13 18:23:43 2025 -0800 Add indentation for multi-line string in java-ts-mode (bug#75154) * lisp/progmodes/java-ts-mode.el: (java-ts-mode--first-line-on-multi-line-string): New function. (java-ts-mode--indent-rules): Add rules. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index c720d609a19..e53e34cb6dc 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -91,6 +91,14 @@ again." table) "Syntax table for `java-ts-mode'.") +(defun java-ts-mode--first-line-on-multi-line-string (_node parent bol &rest _) + "Simple-indent matcher for the first line in a multi-line string block. +PARENT and BOL are the as in other matchers." + (and (treesit-node-match-p parent "multiline_string_fragment") + (save-excursion + ;; Less than 2 newlines between point and string start. + (not (search-backward "\n" (treesit-node-start parent) t 2))))) + (defvar java-ts-mode--indent-rules `((java ((parent-is "program") column-0 0) @@ -108,6 +116,10 @@ again." ((and (parent-is "comment") c-ts-common-looking-at-star) c-ts-common-comment-start-after-first-star -1) ((parent-is "comment") prev-adaptive-prefix 0) + (java-ts-mode--first-line-on-multi-line-string parent-bol + java-ts-mode-indent-offset) + ((parent-is "multiline_string_fragment") prev-adaptive-prefix 0) + ((match "\"\"\"" "string_literal" nil 1) prev-adaptive-prefix 0) ((parent-is "text_block") no-indent) ((parent-is "class_body") column-0 c-ts-common-statement-offset) ((parent-is "array_initializer") parent-bol java-ts-mode-indent-offset) commit 8fb31f58664b2c963dcc49706c163ffb4fafd699 Author: Yuan Fu Date: Thu Feb 13 07:57:19 2025 -0800 Add java-ts-mode-method-chaining-indent-offset (bug#75154) Default method chaining to indent 8 spaces. * lisp/progmodes/java-ts-mode.el: (java-ts-mode-method-chaining-indent-offset): New custom option. (java-ts-mode--indent-rules): Use java-ts-mode-method-chaining-indent-offset. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 602c2553592..c720d609a19 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -50,6 +50,13 @@ :safe 'integerp :group 'java) +(defcustom java-ts-mode-method-chaining-indent-offset 8 + "Indent offset for method chaining in `java-ts-mode'." + :version "31.1" + :type 'integer + :safe 'integerp + :group 'java) + (defcustom java-ts-mode-enable-doxygen nil "Enable doxygen syntax highlighting. If Non-nil, enable doxygen based font lock for comment blocks. @@ -121,7 +128,7 @@ again." ((parent-is "variable_declarator") parent-bol java-ts-mode-indent-offset) ((match ">" "type_arguments") parent-bol 0) ((parent-is "type_arguments") parent-bol java-ts-mode-indent-offset) - ((parent-is "method_invocation") parent-bol java-ts-mode-indent-offset) + ((parent-is "method_invocation") parent-bol java-ts-mode-method-chaining-indent-offset) ((parent-is "switch_rule") parent-bol java-ts-mode-indent-offset) ((parent-is "switch_label") parent-bol java-ts-mode-indent-offset) ((parent-is "ternary_expression") parent-bol java-ts-mode-indent-offset) commit d7763c45138865e81895cc2196602ab1893af5af Author: Sean Whitton Date: Mon Mar 17 10:59:39 2025 +0800 ; etc/NEWS (remember-prefix-map): Suggest a key reserved to users. Matthias intended to incorporate a change like this into his most recent reroll of his patch, but it was accidentally omitted. diff --git a/etc/NEWS b/etc/NEWS index ba28e87ca19..f9b5388bd53 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1503,7 +1503,7 @@ a file, that file being choosen by the user through the minibuffer. *** New prefix map for remember commands. Meant to be given a global binding convenient to the user. Example: - (keymap-global-set "C-c M-r" 'remember-prefix-map) + (keymap-global-set "C-c r" 'remember-prefix-map) ** Speedbar commit eab14d68b2e72b9a6b8b0cc67c9667c2bfbed4f5 Author: Gerd Möllmann Date: Sun Mar 16 21:17:55 2025 +0100 Make sure to initialize glyph::frame to NULL (bug#77039) * src/dispnew.c (adjust_glyph_matrix): Clear glyph memory when enlarging window-system window glyph matrices. diff --git a/src/dispnew.c b/src/dispnew.c index 4f4dcdf1dfb..683c6ba4226 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -506,8 +506,9 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y row->glyphs[LEFT_MARGIN_AREA] = xnrealloc (row->glyphs[LEFT_MARGIN_AREA], dim.width, sizeof (struct glyph)); + memset (row->glyphs[LEFT_MARGIN_AREA], 0, + dim.width * sizeof (struct glyph)); - /* The mode line, if displayed, never has marginal areas. */ if ((row == matrix->rows + dim.height - 1 && !(w && window_wants_mode_line (w))) || (row == matrix->rows && matrix->tab_line_p) commit 7f2e4508cebe76a885b72ca4789ae839d5bd45e1 Author: Jens Schmidt Date: Fri Mar 14 23:07:11 2025 +0100 Correctly unload variable aliases. * src/eval.c (Finternal_delete_indirect_variable): Add function. * lisp/loadhist.el (loadhist-unload-element): Use it for variable aliases. * test/src/eval-tests.el (eval-tests--internal-delete-indirect-variable): Test function `internal-delete-indirect-variable'. * test/lisp/loadhist-tests.el (loadhist-test-unload-feature-alias): * test/lisp/loadhist-resources/loadhist--alias.el: Test unloading of features that define variable aliases. (Bug#76748) diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 1a6f434561e..10b61f184d6 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -211,9 +211,13 @@ unloading." (kill-local-variable x))) (if (and (boundp x) (timerp (symbol-value x))) (cancel-timer (symbol-value x))) - ;; Get rid of the default binding if we can. - (unless (local-variable-if-set-p x) - (makunbound x))) + (cond + ;; "Unbind" indirect variable. + ((not (eq (indirect-variable x) x)) + (internal-delete-indirect-variable x)) + ;; Get rid of the default binding if we can. + ((not (local-variable-if-set-p x)) + (makunbound x)))) (cl-defmethod loadhist-unload-element ((x (head define-type))) (let* ((name (cdr x))) diff --git a/src/eval.c b/src/eval.c index 5de723cf3bc..335fdae8ab9 100644 --- a/src/eval.c +++ b/src/eval.c @@ -720,6 +720,24 @@ signal a `cyclic-variable-indirection' error. */) return base_variable; } +DEFUN ("internal-delete-indirect-variable", Finternal_delete_indirect_variable, Sinternal_delete_indirect_variable, + 1, 1, 0, + doc: /* Internal use only. +Undeclare SYMBOL as variable alias, then unbind it. +Return SYMBOL. */) + (register Lisp_Object symbol) +{ + CHECK_SYMBOL (symbol); + if (XSYMBOL (symbol)->u.s.redirect != SYMBOL_VARALIAS) + xsignal2 (Qerror, + build_string ("Cannot undeclare a variable that is not an alias"), + symbol); + XSYMBOL (symbol)->u.s.redirect = SYMBOL_PLAINVAL; + Fput (symbol, Qvariable_documentation, Qnil); + Fset (symbol, Qunbound); + return symbol; +} + static union specbinding * default_toplevel_binding (Lisp_Object symbol) { @@ -4488,6 +4506,7 @@ alist of active lexical bindings. */); defsubr (&Sdefvar_1); defsubr (&Sdefvaralias); DEFSYM (Qdefvaralias, "defvaralias"); + defsubr (&Sinternal_delete_indirect_variable); defsubr (&Sdefconst); defsubr (&Sdefconst_1); defsubr (&Sinternal__define_uninitialized_variable); diff --git a/test/lisp/loadhist-resources/loadhist--alias.el b/test/lisp/loadhist-resources/loadhist--alias.el new file mode 100644 index 00000000000..96f1b77c48d --- /dev/null +++ b/test/lisp/loadhist-resources/loadhist--alias.el @@ -0,0 +1,28 @@ +;;; loadhist--alias.el --- Dummy package for loadhist-tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Jens Schmidt + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(defvaralias 'loadhist--alias-last-input-event 'last-input-event + "Alias on built-in variable.") + +(provide 'loadhist--alias) +;;; loadhist--alias.el ends here diff --git a/test/lisp/loadhist-tests.el b/test/lisp/loadhist-tests.el index 0f1cedf9c7f..3bc8bbb0189 100644 --- a/test/lisp/loadhist-tests.el +++ b/test/lisp/loadhist-tests.el @@ -101,4 +101,12 @@ (should (null (get 'loadhist--bar-dec 'function-history))) (should (null (get 'loadhist--foo-inc 'function-history)))) +(ert-deftest loadhist-test-unload-feature-alias () + "Check that bug#76748 has been fixed." + (add-to-list 'load-path (expand-file-name + "loadhist-resources/" + loadhist--tests-dir)) + (load "loadhist--alias" nil t) + (unload-feature 'loadhist--alias)) + ;;; loadhist-tests.el ends here diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index c5a46b62ee2..64a108f8744 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -282,6 +282,18 @@ expressions works for identifiers starting with period." (should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d) :type 'cyclic-variable-indirection)) +(ert-deftest eval-tests--internal-delete-indirect-variable () + (defvar eval-tests--i-d-i-v-var 'foo) + (defvaralias 'eval-tests--i-d-i-v-var1 'eval-tests--i-d-i-v-var "Doc string.") + (internal-delete-indirect-variable 'eval-tests--i-d-i-v-var1) + + (should (eq (indirect-variable 'eval-tests--i-d-i-v-var1) + 'eval-tests--i-d-i-v-var1)) + (should-not (boundp 'eval-tests--i-d-i-v-var1)) + (should-not (get 'eval-tests--i-d-i-v-var1 'variable-documentation)) + + (should-error (internal-delete-indirect-variable 'eval-tests--i-d-i-v-var))) + (defvar eval-tests/global-var 'global-value) (defvar-local eval-tests/buffer-local-var 'default-value) (ert-deftest eval-tests/default-value () commit b8104dadbf285d12c356d4cddd28ac3eaf05f263 Author: Michael Albinus Date: Sun Mar 16 14:17:38 2025 +0100 Tramp: Handle symlinks to non-existing targets better * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file): Don't use the truename. * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file): Refactor. Handle symlinks. (Bug#76678) * lisp/net/tramp-smb.el (tramp-smb-errors): Add string. (tramp-smb-handle-copy-file, tramp-smb-handle-rename-file): Refactor. * lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file): Don't use the truename. Handle symlinks. * lisp/net/tramp.el (tramp-barf-if-file-missing): Accept also symlinks. (tramp-skeleton-file-exists-p): Handle non-existing symlink targets. (tramp-skeleton-set-file-modes-times-uid-gid): Fix typo. * test/lisp/net/tramp-tests.el (vc-handled-backends): Suppress only if noninteractive. (tramp-test11-copy-file, tramp-test12-rename-file) (tramp-test18-file-attributes, tramp-test21-file-links) (tramp--test-check-files): Adapt tests. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index f3b4e547692..fb54abfa0c6 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -997,7 +997,7 @@ error and non-nil on success." ;; ;; mksh uses UTF-8 internally, but is currently limited to the ;; BMP (basic multilingua plane), which means U+0000 to - ;; U+FFFD. If you want to use SMP codepoints (U-00010000 to + ;; U+FFFD. If you want to use SMP codepoints (U-00010000 to ;; U-0010FFFD) on the input line, you currently have to disable ;; the UTF-8 mode (sorry). (tramp-adb-execute-adb-command vec "shell" command) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 0118ed7ab4c..0d90382b2d3 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -738,6 +738,7 @@ By default this is done using the \"sudo\" Tramp method. YOu can customize `tramp-file-name-with-method' to change this. Interactively, with a prefix argument, prompt for a different method." + ;; (declare (completion tramp-dired-buffer-command-completion-p)) (interactive) (with-tramp-file-name-with-method (find-file (tramp-file-name-with-sudo (dired-get-file-for-visit))))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 2f0593b0a93..eff7a2d9ff8 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1044,7 +1044,9 @@ file names." (unless (memq op '(copy rename)) (error "Unknown operation `%s', must be `copy' or `rename'" op)) - (setq filename (file-truename filename)) + ;; We cannot use `file-truename', this would fail for symlinks with + ;; non-existing target. + (setq filename (expand-file-name filename)) (if (file-directory-p filename) (progn (copy-directory filename newname keep-date t) @@ -2217,7 +2219,7 @@ connection if a previous connection has died for some reason." method '(("smb" . "smb-share") ("davs" . "dav") ("nextcloud" . "dav") - ("afp". "afp-volume") + ("afp" . "afp-volume") ("gdrive" . "google-drive"))) method) tramp-gvfs-mounttypes) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 84b0d97cd20..2b113ba1acf 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2128,123 +2128,129 @@ file names." (progn (copy-directory filename newname keep-date t) (when (eq op 'rename) (delete-directory filename 'recursive))) + (if (file-symlink-p filename) + (progn + (make-symbolic-link + (file-symlink-p filename) newname ok-if-already-exists) + (when (eq op 'rename) (delete-file filename))) + + ;; FIXME: This should be optimized. Computing `file-attributes' + ;; checks already, whether the file exists. + (let ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname)) + (length (or (file-attribute-size + (file-attributes (file-truename filename))) + ;; `filename' doesn't exist, for example due + ;; to non-existent symlink target. + 0)) + (file-times (file-attribute-modification-time + (file-attributes filename))) + (file-modes (tramp-default-file-modes filename)) + (msg-operation (if (eq op 'copy) "Copying" "Renaming")) + copy-keep-date) + + (with-parsed-tramp-file-name (if t1 filename newname) nil + (tramp-barf-if-file-missing v filename + (when (and (not ok-if-already-exists) (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-error "File is a directory %s" newname)) - ;; FIXME: This should be optimized. Computing `file-attributes' - ;; checks already, whether the file exists. - (let ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname)) - (length (file-attribute-size - (file-attributes (file-truename filename)))) - (file-times (file-attribute-modification-time - (file-attributes filename))) - (file-modes (tramp-default-file-modes filename)) - (msg-operation (if (eq op 'copy) "Copying" "Renaming")) - copy-keep-date) - - (with-parsed-tramp-file-name (if t1 filename newname) nil - (unless length - (tramp-error v 'file-missing filename)) - (tramp-barf-if-file-missing v filename - (when (and (not ok-if-already-exists) (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - (when (and (file-directory-p newname) - (not (directory-name-p newname))) - (tramp-error v 'file-error "File is a directory %s" newname)) - - (with-tramp-progress-reporter - v 0 (format "%s %s to %s" msg-operation filename newname) + (with-tramp-progress-reporter + v 0 (format "%s %s to %s" msg-operation filename newname) - (cond - ;; Both are Tramp files. - ((and t1 t2) - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name newname v2 - (cond - ;; Shortcut: if method, host, user are the same for - ;; both files, we invoke `cp' or `mv' on the remote - ;; host directly. - ((tramp-equal-remote filename newname) - (setq copy-keep-date - (or (eq op 'rename) keep-date preserve-uid-gid)) - (tramp-do-copy-or-rename-file-directly - op filename newname - ok-if-already-exists keep-date preserve-uid-gid)) - - ;; Try out-of-band operation. - ((and - (tramp-method-out-of-band-p v1 length) - (tramp-method-out-of-band-p v2 length)) - (setq copy-keep-date - (tramp-get-method-parameter v 'tramp-copy-keep-date)) - (tramp-do-copy-or-rename-file-out-of-band - op filename newname ok-if-already-exists keep-date)) - - ;; No shortcut was possible. So we copy the file - ;; first. If the operation was `rename', we go - ;; back and delete the original file (if the copy - ;; was successful). The approach is simple-minded: - ;; we create a new buffer, insert the contents of - ;; the source file into it, then write out the - ;; buffer to the target file. The advantage is - ;; that it doesn't matter which file name handlers - ;; are used for the source and target file. - (t - (tramp-do-copy-or-rename-file-via-buffer - op filename newname ok-if-already-exists keep-date)))))) - - ;; One file is a Tramp file, the other one is local. - ((or t1 t2) (cond - ;; Fast track on local machine. - ((tramp-local-host-p v) - (setq copy-keep-date - (or (eq op 'rename) keep-date preserve-uid-gid)) - (tramp-do-copy-or-rename-file-directly - op filename newname - ok-if-already-exists keep-date preserve-uid-gid)) - - ;; If the Tramp file has an out-of-band method, the - ;; corresponding copy-program can be invoked. - ((tramp-method-out-of-band-p v length) - (setq copy-keep-date - (tramp-get-method-parameter v 'tramp-copy-keep-date)) - (tramp-do-copy-or-rename-file-out-of-band - op filename newname ok-if-already-exists keep-date)) + ;; Both are Tramp files. + ((and t1 t2) + (with-parsed-tramp-file-name filename v1 + (with-parsed-tramp-file-name newname v2 + (cond + ;; Shortcut: if method, host, user are the same + ;; for both files, we invoke `cp' or `mv' on the + ;; remote host directly. + ((tramp-equal-remote filename newname) + (setq copy-keep-date + (or (eq op 'rename) keep-date preserve-uid-gid)) + (tramp-do-copy-or-rename-file-directly + op filename newname + ok-if-already-exists keep-date preserve-uid-gid)) + + ;; Try out-of-band operation. + ((and + (tramp-method-out-of-band-p v1 length) + (tramp-method-out-of-band-p v2 length)) + (setq copy-keep-date + (tramp-get-method-parameter v 'tramp-copy-keep-date)) + (tramp-do-copy-or-rename-file-out-of-band + op filename newname ok-if-already-exists keep-date)) + + ;; No shortcut was possible. So we copy the file + ;; first. If the operation was `rename', we go + ;; back and delete the original file (if the copy + ;; was successful). The approach is simple-minded: + ;; we create a new buffer, insert the contents of + ;; the source file into it, then write out the + ;; buffer to the target file. The advantage is + ;; that it doesn't matter which file name handlers + ;; are used for the source and target file. + (t + (tramp-do-copy-or-rename-file-via-buffer + op filename newname ok-if-already-exists keep-date)))))) + + ;; One file is a Tramp file, the other one is local. + ((or t1 t2) + (cond + ;; Fast track on local machine. + ((tramp-local-host-p v) + (setq copy-keep-date + (or (eq op 'rename) keep-date preserve-uid-gid)) + (tramp-do-copy-or-rename-file-directly + op filename newname + ok-if-already-exists keep-date preserve-uid-gid)) + + ;; If the Tramp file has an out-of-band method, the + ;; corresponding copy-program can be invoked. + ((tramp-method-out-of-band-p v length) + (setq copy-keep-date + (tramp-get-method-parameter v 'tramp-copy-keep-date)) + (tramp-do-copy-or-rename-file-out-of-band + op filename newname ok-if-already-exists keep-date)) + + ;; Use the inline method via a Tramp buffer. + (t (tramp-do-copy-or-rename-file-via-buffer + op filename newname ok-if-already-exists keep-date)))) + + (t + ;; One of them must be a Tramp file. + (error "Tramp implementation says this cannot happen"))) + + ;; In case of `rename', we must flush the cache of the source file. + (when (and t1 (eq op 'rename)) + (with-parsed-tramp-file-name filename v1 + (tramp-flush-file-properties v1 v1-localname))) + + ;; NEWNAME has wrong cached values. + (when t2 + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties v2 v2-localname))) - ;; Use the inline method via a Tramp buffer. - (t (tramp-do-copy-or-rename-file-via-buffer - op filename newname ok-if-already-exists keep-date)))) + ;; Handle `preserve-extended-attributes'. We ignore + ;; possible errors, because ACL strings could be + ;; incompatible. + (when-let* ((attributes (and preserve-extended-attributes + (file-extended-attributes filename)))) + (ignore-errors + (set-file-extended-attributes newname attributes))) - (t - ;; One of them must be a Tramp file. - (error "Tramp implementation says this cannot happen"))) - - ;; In case of `rename', we must flush the cache of the source file. - (when (and t1 (eq op 'rename)) - (with-parsed-tramp-file-name filename v1 - (tramp-flush-file-properties v1 v1-localname))) - - ;; NEWNAME has wrong cached values. - (when t2 - (with-parsed-tramp-file-name newname v2 - (tramp-flush-file-properties v2 v2-localname))) - - ;; Handle `preserve-extended-attributes'. We ignore - ;; possible errors, because ACL strings could be - ;; incompatible. - (when-let* ((attributes (and preserve-extended-attributes - (file-extended-attributes filename)))) - (ignore-errors - (set-file-extended-attributes newname attributes))) - - ;; KEEP-DATE handling. - (when (and keep-date (not copy-keep-date)) - (set-file-times - newname file-times (unless ok-if-already-exists 'nofollow))) - - ;; Set the mode. - (unless (and keep-date copy-keep-date) - (set-file-modes newname file-modes)))))))) + ;; KEEP-DATE handling. + (when (and keep-date (not copy-keep-date)) + (set-file-times + newname file-times (unless ok-if-already-exists 'nofollow))) + + ;; Set the mode. + (unless (and keep-date copy-keep-date) + (set-file-modes newname file-modes))))))))) (defun tramp-do-copy-or-rename-file-via-buffer (op filename newname _ok-if-already-exists _keep-date) @@ -3119,7 +3125,7 @@ will be used." ;; character to read. When a process does ;; not read from stdin, like magit, it ;; should set a timeout - ;; instead. See`tramp-pipe-stty-settings'. + ;; instead. See `tramp-pipe-stty-settings'. ;; (Bug#62093) ;; FIXME: Shall we rather use "stty raw"? (tramp-send-command @@ -5631,7 +5637,7 @@ Nonexistent directories are removed from spec." (lambda (x) (not (tramp-get-file-property vec x "file-directory-p"))) remote-path)))))) -;; The PIPE_BUF in POSIX [1] can be as low as 512 [2]. Here are the values +;; The PIPE_BUF in POSIX [1] can be as low as 512 [2]. Here are the values ;; on various platforms: ;; - 512 on macOS, FreeBSD, NetBSD, OpenBSD, MirBSD, native Windows. ;; - 4 KiB on Linux, OSF/1, Cygwin, Haiku. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 64bde348775..aeb7c01c03f 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -114,6 +114,7 @@ this variable \"client min protocol=NT1\"." "Read from server failed, maybe it closed the connection" "Call timed out: server did not respond" (: (+ (not blank)) ": command not found") + (: (+ (not blank)) " does not exist") "Server doesn't support UNIX CIFS calls" (| ;; Samba. "ERRDOS" @@ -596,66 +597,63 @@ KEEP-DATE has no effect in case NEWNAME resides on an SMB server. PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq filename (expand-file-name filename) newname (expand-file-name newname)) - (with-tramp-progress-reporter - (tramp-dissect-file-name - (if (tramp-tramp-file-p filename) filename newname)) - 0 (format "Copying %s to %s" filename newname) - (if (file-directory-p filename) - (copy-directory filename newname keep-date 'parents 'copy-contents) + (with-parsed-tramp-file-name + (if (tramp-tramp-file-p filename) filename newname) nil + (with-tramp-progress-reporter + v 0 (format "Copying %s to %s" filename newname) + + (if (file-directory-p filename) + (copy-directory filename newname keep-date 'parents 'copy-contents) + + (tramp-barf-if-file-missing v filename + ;; `file-local-copy' returns a file name also for a local + ;; file with `jka-compr-handler', so we cannot trust its + ;; result as indication for a remote file name. + (if-let* ((tmpfile + (and (tramp-tramp-file-p filename) + (file-local-copy filename)))) + ;; Remote filename. + (condition-case err + (rename-file tmpfile newname ok-if-already-exists) + ((error quit) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Remote newname. + (when (and (file-directory-p newname) + (directory-name-p newname)) + (setq newname + (expand-file-name + (file-name-nondirectory filename) newname))) + + (when (and (not ok-if-already-exists) (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-error "File is a directory %s" newname)) + + (unless (tramp-smb-get-share v) + (tramp-error + v 'file-error "Target `%s' must contain a share name" newname)) + (unless (tramp-smb-send-command + v (format "put %s %s" + (tramp-smb-shell-quote-argument filename) + (tramp-smb-shell-quote-localname v))) + (tramp-error + v 'file-error "Cannot copy `%s' to `%s'" filename newname)) - (unless (file-exists-p filename) - (tramp-error - (tramp-dissect-file-name - (if (tramp-tramp-file-p filename) filename newname)) - 'file-missing filename)) - - ;; `file-local-copy' returns a file name also for a local file - ;; with `jka-compr-handler', so we cannot trust its result as - ;; indication for a remote file name. - (if-let* ((tmpfile - (and (tramp-tramp-file-p filename) (file-local-copy filename)))) - ;; Remote filename. - (condition-case err - (rename-file tmpfile newname ok-if-already-exists) - ((error quit) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Remote newname. - (when (and (file-directory-p newname) - (directory-name-p newname)) - (setq newname - (expand-file-name (file-name-nondirectory filename) newname))) - - (with-parsed-tramp-file-name newname nil - (when (and (not ok-if-already-exists) (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - (when (and (file-directory-p newname) - (not (directory-name-p newname))) - (tramp-error v 'file-error "File is a directory %s" newname)) - - (unless (tramp-smb-get-share v) - (tramp-error - v 'file-error "Target `%s' must contain a share name" newname)) - (unless (tramp-smb-send-command - v (format "put %s %s" - (tramp-smb-shell-quote-argument filename) - (tramp-smb-shell-quote-localname v))) - (tramp-error - v 'file-error "Cannot copy `%s' to `%s'" filename newname)) - - ;; When newname did exist, we have wrong cached values. - (when (tramp-tramp-file-p newname) - (with-parsed-tramp-file-name newname v2 - (tramp-flush-file-properties v2 v2-localname)))))) - - ;; KEEP-DATE handling. - (when keep-date - (set-file-times - newname - (file-attribute-modification-time (file-attributes filename)) - (unless ok-if-already-exists 'nofollow))))) + ;; When newname did exist, we have wrong cached values. + (when (tramp-tramp-file-p newname) + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties v2 v2-localname)))))) + + ;; KEEP-DATE handling. + (when keep-date + (set-file-times + newname + (file-attribute-modification-time (file-attributes filename)) + (unless ok-if-already-exists 'nofollow)))))) (defun tramp-smb-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." @@ -1306,46 +1304,45 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (with-parsed-tramp-file-name (if (tramp-tramp-file-p filename) filename newname) nil - (unless (file-exists-p filename) - (tramp-error v 'file-missing filename)) - (when (and (not ok-if-already-exists) (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - (when (and (file-directory-p newname) - (not (directory-name-p newname))) - (tramp-error v 'file-error "File is a directory %s" newname)) + (tramp-barf-if-file-missing v filename + (when (and (not ok-if-already-exists) (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-error "File is a directory %s" newname)) - (with-tramp-progress-reporter - v 0 (format "Renaming %s to %s" filename newname) - - (if (and (not (file-exists-p newname)) - (tramp-equal-remote filename newname) - (string-equal - (tramp-smb-get-share (tramp-dissect-file-name filename)) - (tramp-smb-get-share (tramp-dissect-file-name newname)))) - ;; We can rename directly. - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name newname v2 - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v1 v1-localname) - (tramp-flush-file-properties v2 v2-localname) - (unless (tramp-smb-get-share v2) - (tramp-error - v2 'file-error - "Target `%s' must contain a share name" newname)) - (unless (tramp-smb-send-command - v2 (format "rename %s %s" - (tramp-smb-shell-quote-localname v1) - (tramp-smb-shell-quote-localname v2))) - (tramp-error v2 'file-error "Cannot rename `%s'" filename)))) - - ;; We must rename via copy. - (copy-file - filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid) - (if (file-directory-p filename) - (delete-directory filename 'recursive) - (delete-file filename)))))) + (with-tramp-progress-reporter + v 0 (format "Renaming %s to %s" filename newname) + + (if (and (not (file-exists-p newname)) + (tramp-equal-remote filename newname) + (string-equal + (tramp-smb-get-share (tramp-dissect-file-name filename)) + (tramp-smb-get-share (tramp-dissect-file-name newname)))) + ;; We can rename directly. + (with-parsed-tramp-file-name filename v1 + (with-parsed-tramp-file-name newname v2 + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v1 v1-localname) + (tramp-flush-file-properties v2 v2-localname) + (unless (tramp-smb-get-share v2) + (tramp-error + v2 'file-error + "Target `%s' must contain a share name" newname)) + (unless (tramp-smb-send-command + v2 (format "rename %s %s" + (tramp-smb-shell-quote-localname v1) + (tramp-smb-shell-quote-localname v2))) + (tramp-error v2 'file-error "Cannot rename `%s'" filename)))) + + ;; We must rename via copy. + (copy-file + filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid) + (if (file-directory-p filename) + (delete-directory filename 'recursive) + (delete-file filename))))))) (defun tramp-smb-action-set-acl (proc vec) "Set ACL data." diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 0202f933b74..517bd85736a 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -244,84 +244,88 @@ absolute file names." (unless (memq op '(copy rename)) (error "Unknown operation `%s', must be `copy' or `rename'" op)) - (setq filename (file-truename filename)) (if (file-directory-p filename) (progn (copy-directory filename newname keep-date t) (when (eq op 'rename) (delete-directory filename 'recursive))) - - ;; FIXME: This should be optimized. Computing `file-attributes' - ;; checks already, whether the file exists. - (let ((t1 (tramp-sudoedit-file-name-p filename)) - (t2 (tramp-sudoedit-file-name-p newname)) - (file-times (file-attribute-modification-time - (file-attributes filename))) - (file-modes (tramp-default-file-modes filename)) - (attributes (and preserve-extended-attributes - (file-extended-attributes filename))) - (sudoedit-operation - (cond - ((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p")) - ((eq op 'copy) '("cp" "-f")) - ((eq op 'rename) '("mv" "-f")))) - (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) - - (with-parsed-tramp-file-name (if t1 filename newname) nil - (tramp-barf-if-file-missing v filename - (when (and (not ok-if-already-exists) (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - (when (and (file-directory-p newname) - (not (directory-name-p newname))) - (tramp-error v 'file-error "File is a directory %s" newname)) - - (if (or (and (tramp-tramp-file-p filename) (not t1)) - (and (tramp-tramp-file-p newname) (not t2))) - ;; We cannot copy or rename directly. - (let ((tmpfile (tramp-compat-make-temp-file filename))) - (if (eq op 'copy) - (copy-file filename tmpfile t) - (rename-file filename tmpfile t)) - (rename-file tmpfile newname ok-if-already-exists)) - - ;; Direct action. - (with-tramp-progress-reporter - v 0 (format "%s %s to %s" msg-operation filename newname) - (unless (tramp-sudoedit-send-command - v sudoedit-operation - (tramp-unquote-file-local-name filename) - (tramp-unquote-file-local-name newname)) - (tramp-error - v 'file-error - "Error %s `%s' `%s'" msg-operation filename newname)))) - - ;; When `newname' is local, we must change the ownership to - ;; the local user. - (unless (tramp-tramp-file-p newname) - (tramp-set-file-uid-gid - (concat (file-remote-p filename) newname) - (tramp-get-local-uid 'integer) - (tramp-get-local-gid 'integer))) - - ;; Set the time and mode. Mask possible errors. - (when keep-date - (ignore-errors - (set-file-times - newname file-times (unless ok-if-already-exists 'nofollow)) - (set-file-modes newname file-modes))) - - ;; Handle `preserve-extended-attributes'. We ignore possible - ;; errors, because ACL strings could be incompatible. - (when attributes - (ignore-errors - (set-file-extended-attributes newname attributes))) - - (when (and t1 (eq op 'rename)) - (with-parsed-tramp-file-name filename v1 - (tramp-flush-file-properties v1 v1-localname))) - - (when t2 - (with-parsed-tramp-file-name newname v2 - (tramp-flush-file-properties v2 v2-localname)))))))) + (if (file-symlink-p filename) + (progn + (make-symbolic-link + (file-symlink-p filename) newname ok-if-already-exists) + (when (eq op 'rename) (delete-file filename))) + + ;; FIXME: This should be optimized. Computing `file-attributes' + ;; checks already, whether the file exists. + (let ((t1 (tramp-sudoedit-file-name-p filename)) + (t2 (tramp-sudoedit-file-name-p newname)) + (file-times (file-attribute-modification-time + (file-attributes filename))) + (file-modes (tramp-default-file-modes filename)) + (attributes (and preserve-extended-attributes + (file-extended-attributes filename))) + (sudoedit-operation + (cond + ((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p")) + ((eq op 'copy) '("cp" "-f")) + ((eq op 'rename) '("mv" "-f")))) + (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) + + (with-parsed-tramp-file-name (if t1 filename newname) nil + (tramp-barf-if-file-missing v filename + (when (and (not ok-if-already-exists) (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-error "File is a directory %s" newname)) + + (if (or (and (tramp-tramp-file-p filename) (not t1)) + (and (tramp-tramp-file-p newname) (not t2))) + ;; We cannot copy or rename directly. + (let ((tmpfile (tramp-compat-make-temp-file filename))) + (if (eq op 'copy) + (copy-file filename tmpfile t) + (rename-file filename tmpfile t)) + (rename-file tmpfile newname ok-if-already-exists)) + + ;; Direct action. + (with-tramp-progress-reporter + v 0 (format "%s %s to %s" msg-operation filename newname) + (unless (tramp-sudoedit-send-command + v sudoedit-operation + (tramp-unquote-file-local-name filename) + (tramp-unquote-file-local-name newname)) + (tramp-error + v 'file-error + "Error %s `%s' `%s'" msg-operation filename newname)))) + + ;; When `newname' is local, we must change the ownership + ;; to the local user. + (unless (tramp-tramp-file-p newname) + (tramp-set-file-uid-gid + (concat (file-remote-p filename) newname) + (tramp-get-local-uid 'integer) + (tramp-get-local-gid 'integer))) + + ;; Set the time and mode. Mask possible errors. + (when keep-date + (ignore-errors + (set-file-times + newname file-times (unless ok-if-already-exists 'nofollow)) + (set-file-modes newname file-modes))) + + ;; Handle `preserve-extended-attributes'. We ignore possible + ;; errors, because ACL strings could be incompatible. + (when attributes + (ignore-errors + (set-file-extended-attributes newname attributes))) + + (when (and t1 (eq op 'rename)) + (with-parsed-tramp-file-name filename v1 + (tramp-flush-file-properties v1 v1-localname))) + + (when t2 + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties v2 v2-localname))))))))) (defun tramp-sudoedit-handle-copy-file (filename newname &optional ok-if-already-exists keep-date diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 190e1871234..6f2d891db5d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2107,7 +2107,7 @@ does not exist, otherwise propagate the error." `(condition-case ,err (progn ,@body) (error - (if (not (file-exists-p ,filename)) + (if (not (or (file-exists-p ,filename) (file-symlink-p ,filename))) (tramp-error ,vec 'file-missing ,filename) (signal (car ,err) (cdr ,err))))))) @@ -3576,12 +3576,17 @@ BODY is the backend specific code." (when (tramp-connectable-p ,filename) (with-parsed-tramp-file-name (expand-file-name ,filename) nil (with-tramp-file-property v localname "file-exists-p" - ;; Examine `file-attributes' cache to see if request can - ;; be satisfied without remote operation. - (if (tramp-file-property-p v localname "file-attributes") - (not - (null (tramp-get-file-property v localname "file-attributes"))) - ,@body)))))) + (cond + ;; Examine `file-attributes' cache to see if request can + ;; be satisfied without remote operation. + ((and-let* + (((tramp-file-property-p v localname "file-attributes")) + (fa (tramp-get-file-property v localname "file-attributes")) + ((not (stringp (car fa))))))) + ;; Symlink to a non-existing target counts as nil. + ((file-symlink-p ,filename) + (file-exists-p (file-truename ,filename))) + (t ,@body))))))) (defmacro tramp-skeleton-file-local-copy (filename &rest body) "Skeleton for `tramp-*-handle-file-local-copy'. @@ -3846,7 +3851,7 @@ BODY is the backend specific code." ;; We cannot add "file-attributes", "file-executable-p", ;; "file-ownership-preserved-p", "file-readable-p", ;; "file-writable-p". - '("file-directory-p" "file-exists-p" "file-symlinkp" "file-truename") + '("file-directory-p" "file-exists-p" "file-symlink-p" "file-truename") (tramp-flush-file-properties v localname)) (condition-case err (progn ,@body) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1efafb68fbc..ccb3731fc09 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -153,7 +153,7 @@ tramp-error-show-message-timeout nil tramp-persistency-file-name nil tramp-verbose 0 - vc-handled-backends nil) + vc-handled-backends (unless noninteractive vc-handled-backends)) (defconst tramp-test-name-prefix "tramp-test" "Prefix to use for temporary test files.") @@ -2871,7 +2871,9 @@ This checks also `file-name-as-directory', `file-name-directory', (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) - (tmp-name3 (tramp--test-make-temp-name 'local quoted))) + (tmp-name3 (tramp--test-make-temp-name 'local quoted)) + (tmp-name4 + (file-name-nondirectory (tramp--test-make-temp-name 'local quoted)))) (dolist (source-target `(;; Copy on remote side. (,tmp-name1 . ,tmp-name2) @@ -2879,8 +2881,12 @@ This checks also `file-name-as-directory', `file-name-directory', (,tmp-name1 . ,tmp-name3) ;; Copy from local side to remote side. (,tmp-name3 . ,tmp-name1))) - (let ((source (car source-target)) - (target (cdr source-target))) + (let* ((source (car source-target)) + (source-link + (expand-file-name tmp-name4 (file-name-directory source))) + (target (cdr source-target)) + (target-link + (expand-file-name tmp-name4 (file-name-directory target)))) ;; Copy simple file. (unwind-protect @@ -2905,6 +2911,26 @@ This checks also `file-name-as-directory', `file-name-directory', (ignore-errors (delete-file source)) (ignore-errors (delete-file target))) + ;; Copy symlinked file. + (unwind-protect + (tramp--test-ignore-make-symbolic-link-error + (write-region "foo" nil source-link) + (should (file-exists-p source-link)) + (make-symbolic-link tmp-name4 source) + (should (file-exists-p source)) + (should (string-equal (file-symlink-p source) tmp-name4)) + (copy-file source target) + ;; Some backends like tramp-gvfs.el do not create the + ;; link on the target. + (when (file-symlink-p target) + (should (string-equal (file-symlink-p target) tmp-name4)))) + + ;; Cleanup. + (ignore-errors (delete-file source)) + (ignore-errors (delete-file source-link)) + (ignore-errors (delete-file target)) + (ignore-errors (delete-file target-link))) + ;; Copy file to directory. (unwind-protect ;; This doesn't work on FTP. @@ -2980,7 +3006,9 @@ This checks also `file-name-as-directory', `file-name-directory', (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) - (tmp-name3 (tramp--test-make-temp-name 'local quoted))) + (tmp-name3 (tramp--test-make-temp-name 'local quoted)) + (tmp-name4 + (file-name-nondirectory (tramp--test-make-temp-name 'local quoted)))) (dolist (source-target `(;; Rename on remote side. (,tmp-name1 . ,tmp-name2) @@ -2988,8 +3016,12 @@ This checks also `file-name-as-directory', `file-name-directory', (,tmp-name1 . ,tmp-name3) ;; Rename from local side to remote side. (,tmp-name3 . ,tmp-name1))) - (let ((source (car source-target)) - (target (cdr source-target))) + (let* ((source (car source-target)) + (source-link + (expand-file-name tmp-name4 (file-name-directory source))) + (target (cdr source-target)) + (target-link + (expand-file-name tmp-name4 (file-name-directory target)))) ;; Rename simple file. (unwind-protect @@ -3018,6 +3050,27 @@ This checks also `file-name-as-directory', `file-name-directory', (ignore-errors (delete-file source)) (ignore-errors (delete-file target))) + ;; Rename symlinked file. + (unwind-protect + (tramp--test-ignore-make-symbolic-link-error + (write-region "foo" nil source-link) + (should (file-exists-p source-link)) + (make-symbolic-link tmp-name4 source) + (should (file-exists-p source)) + (should (string-equal (file-symlink-p source) tmp-name4)) + (rename-file source target) + (should-not (file-exists-p source)) + ;; Some backends like tramp-gvfs.el do not create the + ;; link on the target. + (when (file-symlink-p target) + (should (string-equal (file-symlink-p target) tmp-name4)))) + + ;; Cleanup. + (ignore-errors (delete-file source)) + (ignore-errors (delete-file source-link)) + (ignore-errors (delete-file target)) + (ignore-errors (delete-file target-link))) + ;; Rename file to directory. (unwind-protect (progn @@ -3814,6 +3867,18 @@ This tests also `access-file', `file-readable-p', (if quoted #'file-name-quote #'identity) (file-attribute-type attr)) (file-remote-p (file-truename tmp-name1) 'localname))) + (delete-file tmp-name2) + + ;; A non-existent link target makes the file unaccessible. + (make-symbolic-link "error" tmp-name2) + (should (file-symlink-p tmp-name2)) + (should-error + (access-file tmp-name2 "error") + :type 'file-missing) + ;; `file-ownership-preserved-p' should return t for + ;; symlinked files to a non-existing target. + (when test-file-ownership-preserved-p + (should (file-ownership-preserved-p tmp-name2 'group))) (delete-file tmp-name2)) ;; Check, that "//" in symlinks are handled properly. @@ -4463,13 +4528,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (make-symbolic-link tmp-name1 tmp-name2) (should (file-symlink-p tmp-name1)) (should (file-symlink-p tmp-name2)) - (should-not (file-regular-p tmp-name1)) - (should-not (file-regular-p tmp-name2)) (should-error - (file-truename tmp-name1) + (file-regular-p tmp-name1) :type 'file-error) (should-error - (file-truename tmp-name2) + (file-regular-p tmp-name2) :type 'file-error)))) ;; Cleanup. @@ -7390,10 +7453,6 @@ This requires restrictions of file name syntax." (if quoted #'file-name-quote #'identity) (file-attribute-type (file-attributes file3))) (file-remote-p (file-truename file1) 'localname))) - ;; Check file contents. - (with-temp-buffer - (insert-file-contents file3) - (should (string-equal (buffer-string) elt))) (delete-file file3)))) ;; Check file names. commit 03e33cbef3e33aa1ec843388d1671f7116a7347b Author: Stefan Kangas Date: Sat Mar 15 14:11:51 2025 +0100 Don't recommend legacy keymap functions in docstrings * lisp/comint.el (comint-prompt-read-only): * lisp/ielm.el (ielm-prompt-read-only): * lisp/international/ogonek.el (ogonek-informacja, ogonek-information): * lisp/mouse-copy.el (mouse-drag-secondary-pasting): * lisp/mouse-drag.el (mouse-drag-throw, mouse-drag-drag): Don't recommend using legacy keymap functions. diff --git a/lisp/comint.el b/lisp/comint.el index f92ee382473..188989ff8a4 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -186,11 +186,11 @@ narrowing in effect. This way you will be certain that none of the remaining prompts will be accidentally messed up. You may wish to put something like the following in your init file: -\(add-hook \\='comint-mode-hook - (lambda () - (define-key comint-mode-map [remap kill-region] \\='comint-kill-region) - (define-key comint-mode-map [remap kill-whole-line] - \\='comint-kill-whole-line))) + (with-eval-after-load \\='comint + (keymap-set comint-mode-map \" \" + \\='comint-kill-region) + (keymap-set comint-mode-map \" \" + \\='comint-kill-whole-line)) If you sometimes use `comint-mode' on text-only terminals or with `emacs -nw', you might wish to use another binding for `comint-kill-whole-line'." diff --git a/lisp/ielm.el b/lisp/ielm.el index 43529f36cd6..81d22ee4405 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -60,11 +60,10 @@ narrowing in effect. This way you will be certain that none of the remaining prompts will be accidentally messed up. You may wish to put something like the following in your init file: -\(add-hook \\='ielm-mode-hook - (lambda () - (define-key ielm-map \"\\C-w\" \\='comint-kill-region) - (define-key ielm-map [C-S-backspace] - \\='comint-kill-whole-line))) + (with-eval-after-load \\='ielm + (keymap-set ielm-map \"C-w\" \\='comint-kill-region) + (keymap-set ielm-map \"C-S-\" + \\='comint-kill-whole-line)) If you set `comint-prompt-read-only' to t, you might wish to use `comint-mode-hook' and `comint-mode-map' instead of diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el index e5b71f9bf47..0b1e478eefd 100644 --- a/lisp/international/ogonek.el +++ b/lisp/international/ogonek.el @@ -144,17 +144,17 @@ znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco. (defun deprefixify-iso8859-2-region (start end) (interactive \"*r\") (ogonek-deprefixify-region start end ?/ \"iso8859-2\")) - (global-set-key \"\\C-cd\" \\='deprefixify-iso8859-2-region) ; ctrl-c d + (keymap-global-set \"C-c d\" \\='deprefixify-iso8859-2-region) ; ctrl-c d (defun mazovia-to-iso8859-2 (start end) (interactive \"*r\") (ogonek-recode-region start end \"mazovia\" \"iso8859-2\")) - (global-set-key \"\\C-cr\" \\='mazovia-to-iso8859-2) ; ctrl-c r + (keymap-global-set \"C-c r\" \\='mazovia-to-iso8859-2) ; ctrl-c r (defun prefixify-iso8859-2-region (start end) (interactive \"*r\") (ogonek-prefixify-region start end \"iso8859-2\" ?/)) - (global-set-key \"\\C-cp\" \\='prefixify-iso8859-2-region) ; ctrl-c p + (keymap-global-set \"C-c p\" \\='prefixify-iso8859-2-region) ; ctrl-c p Ka/zd/a operacj/e przekodowania mo/zna w ca/lo/sci odwo/la/c przez wykonanie polecenia `undo'.") @@ -244,17 +244,17 @@ The functions come in the following groups. (defun deprefixify-iso8859-2-region (start end) (interactive \"*r\") (ogonek-deprefixify-region start end ?/ \"iso8859-2\")) - (global-set-key \"\\C-cd\" \\='deprefixify-iso8859-2-region) ; ctrl-c d + (keymap-global-set \"C-c d\" \\='deprefixify-iso8859-2-region) ; ctrl-c d (defun mazovia-to-iso8859-2 (start end) (interactive \"*r\") (ogonek-recode-region start end \"mazovia\" \"iso8859-2\")) - (global-set-key \"\\C-cr\" \\='mazovia-to-iso8859-2) ; ctrl-c r + (keymap-global-set \"C-c r\" \\='mazovia-to-iso8859-2) ; ctrl-c r (defun prefixify-iso8859-2-region (start end) (interactive \"*r\") (ogonek-prefixify-region start end \"iso8859-2\" ?/)) - (global-set-key \"\\C-cp\" \\='prefixify-iso8859-2-region) ; ctrl-c p + (keymap-global-set \"C-c p\" \\='prefixify-iso8859-2-region) ; ctrl-c p Each recoding operation can be called off using the `undo' command.") diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el index cbd3f360c3e..1abc36d8812 100644 --- a/lisp/mouse-copy.el +++ b/lisp/mouse-copy.el @@ -152,7 +152,8 @@ If you have the bug (or the real fix :-), please let me know." "Drag out a secondary selection, then paste it at the current point. To test this function, evaluate: - (global-set-key [M-down-mouse-1] \\='mouse-drag-secondary-pasting) + (keymap-global-set \"M-\" + \\='mouse-drag-secondary-pasting) put the point at one place, then click and drag over some other region." (interactive "e") ;; Work-around: We see and react to each part of a multi-click event diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el index bb27994bbca..01f0421baf0 100644 --- a/lisp/mouse-drag.el +++ b/lisp/mouse-drag.el @@ -203,7 +203,7 @@ about which direction is natural. Perhaps it has to do with which hemisphere you're in.) To test this function, evaluate: - (global-set-key [down-mouse-2] \\='mouse-drag-throw)" + (keymap-global-set \"\" \\='mouse-drag-throw)" (interactive "e") ;; we want to do save-selected-window, but that requires 19.29 (let* ((start-posn (event-start start-event)) @@ -263,7 +263,7 @@ Drag scrolling is identical to the \"hand\" option in MacPaint, or the middle button in Tk text widgets. To test this function, evaluate: - (global-set-key [down-mouse-2] \\='mouse-drag-drag)" + (keymap-global-set \"\" \\='mouse-drag-drag)" (interactive "e") ;; we want to do save-selected-window, but that requires 19.29 (let* ((start-posn (event-start start-event)) commit dec21bcc9997780a9c56e4eb7f718fd64d8c32ec Author: Stefan Kangas Date: Sat Mar 15 19:26:31 2025 +0100 Use substitute-quotes for checkdoc errors * lisp/emacs-lisp/checkdoc.el (checkdoc-create-error): Use substitute-quotes. diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index a45c7dd04cc..c5f1e9a6ed5 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1283,7 +1283,8 @@ generating a buffered list of errors.") "Used to create the return error text returned from all engines. TEXT, START, END and UNFIXABLE conform to `checkdoc-create-error-function', which see." - (funcall checkdoc-create-error-function text start end unfixable)) + (funcall checkdoc-create-error-function + (substitute-quotes text) start end unfixable)) (defun checkdoc--create-error-for-checkdoc (text start end &optional unfixable) "Create an error for Checkdoc. commit d8d524071d78d6499278546cf13ae261c05cadf3 Author: Stefan Kangas Date: Sat Mar 15 13:39:45 2025 +0100 Use defvar-keymap for some trivial keymaps * lisp/bindings.el (mode-line-window-dedicated-keymap) (mode-line-buffer-identification-keymap): * lisp/emulation/cua-rect.el (cua--overlay-keymap, cua--overlay-key): * lisp/mh-e/mh-mime.el (mh-mime-security-button-map): * lisp/mh-e/mh-utils.el (mh-hidden-header-keymap): * lisp/net/eudc-bob.el (eudc-bob-generic-keymap, eudc-bob-image-keymap) (eudc-bob-sound-keymap, eudc-bob-url-keymap, eudc-bob-mail-keymap): * lisp/progmodes/etags-regen.el (etags-regen-mode-map): * lisp/progmodes/octave.el (octave-help-mode-map): * lisp/replace.el (multi-query-replace-map): * lisp/simple.el (process-menu-mode-map, messages-buffer-mode-map): * lisp/startup.el (splash-screen-keymap): * lisp/tab-bar.el (tab-bar-mode-map): * lisp/textmodes/ispell.el (ispell-minor-keymap): * lisp/textmodes/tex-mode.el (latex-mode-map, plain-tex-mode-map): * lisp/tree-widget.el (tree-widget-button-keymap): * lisp/vc/vc-hooks.el (vc-mode-line-map): Use defvar-keymap. diff --git a/lisp/bindings.el b/lisp/bindings.el index 5764143673c..9707ce4b474 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -300,11 +300,9 @@ Value is used for `mode-line-frame-identification', which see." ;;;###autoload (put 'mode-line-frame-identification 'risky-local-variable t) -(defvar mode-line-window-dedicated-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] #'toggle-window-dedicated) - map) - "Keymap for what is displayed by `mode-line-window-dedicated'.") +(defvar-keymap mode-line-window-dedicated-keymap + :doc "Keymap for what is displayed by `mode-line-window-dedicated'." + " " #'toggle-window-dedicated) (defun mode-line-window-control () "Compute mode line construct for window dedicated state. @@ -628,20 +626,18 @@ Normally displays the buffer percentage and, optionally, the buffer size, the line number and the column number.") (put 'mode-line-position 'risky-local-variable t) -(defvar mode-line-buffer-identification-keymap +(defvar-keymap mode-line-buffer-identification-keymap + :doc "Keymap for what is displayed by `mode-line-buffer-identification'." ;; Add menu of buffer operations to the buffer identification part ;; of the mode line.or header line. - (let ((map (make-sparse-keymap))) - ;; Bind down- events so that the global keymap won't ``shine - ;; through''. - (define-key map [mode-line mouse-1] 'mode-line-previous-buffer) - (define-key map [header-line down-mouse-1] 'ignore) - (define-key map [header-line mouse-1] 'mode-line-previous-buffer) - (define-key map [mode-line mouse-3] 'mode-line-next-buffer) - (define-key map [header-line down-mouse-3] 'ignore) - (define-key map [header-line mouse-3] 'mode-line-next-buffer) - map) "\ -Keymap for what is displayed by `mode-line-buffer-identification'.") + ;; Bind down- events so that the global keymap won't ``shine + ;; through''. + " " #'mode-line-previous-buffer + " " #'ignore + " " #'mode-line-previous-buffer + " " #'mode-line-next-buffer + " " #'ignore + " " #'mode-line-next-buffer) (defun propertized-buffer-identification (fmt) "Return a list suitable for `mode-line-buffer-identification'. diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index e224d4ce248..218e8ea418c 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -88,9 +88,8 @@ See `cua--rectangle'.") "List of overlays used to display current rectangle.") (put 'cua--rectangle-overlays 'permanent-local t) -(defvar cua--overlay-keymap - (let ((map (make-sparse-keymap))) - (define-key map "\r" #'cua-rotate-rectangle))) +(defvar-keymap cua--overlay-keymap + "RET" #'cua-rotate-rectangle) (defvar cua--virtual-edges-debug nil) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 00a6293ba70..fe0d3a9272f 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -201,11 +201,9 @@ Set from last use.") (?i info ?s) (?d details ?s) (?D pressed-details ?s))) -(defvar mh-mime-security-button-map - (let ((map (make-sparse-keymap))) - (define-key map "\r" #'mh-press-button) - (define-key map [mouse-2] #'mh-push-button) - map)) +(defvar-keymap mh-mime-security-button-map + "RET" #'mh-press-button + "" #'mh-push-button) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 205c13c849c..5b8c48308ae 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -920,10 +920,8 @@ Handle RFC 822 (or later) continuation lines." when (equal (downcase x) field) return t finally return nil))) -(defvar mh-hidden-header-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] #'mh-letter-toggle-header-field-display-button) - map)) +(defvar-keymap mh-hidden-header-keymap + "" #'mh-letter-toggle-header-field-display-button) ;;;###mh-autoload (defun mh-letter-toggle-header-field-display (arg) diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index b7289868625..58a3e02430d 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -39,42 +39,32 @@ (require 'eudc) -(defvar eudc-bob-generic-keymap - (let ((map (make-sparse-keymap))) - (define-key map "s" #'eudc-bob-save-object) - (define-key map "!" #'eudc-bob-pipe-object-to-external-program) - (define-key map [down-mouse-3] #'eudc-bob-popup-menu) - map) - "Keymap for multimedia objects.") - -(defvar eudc-bob-image-keymap - (let ((map (make-sparse-keymap))) - (set-keymap-parent map eudc-bob-generic-keymap) - (define-key map "t" #'eudc-bob-toggle-inline-display) - map) - "Keymap for inline images.") - -(defvar eudc-bob-sound-keymap - (let ((map (make-sparse-keymap))) - (set-keymap-parent map eudc-bob-generic-keymap) - (define-key map (kbd "RET") #'eudc-bob-play-sound-at-point) - (define-key map [down-mouse-2] #'eudc-bob-play-sound-at-mouse) - map) - "Keymap for inline sounds.") - -(defvar eudc-bob-url-keymap - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") #'browse-url-at-point) - (define-key map [down-mouse-2] #'browse-url-at-mouse) - map) - "Keymap for inline urls.") - -(defvar eudc-bob-mail-keymap - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") #'goto-address-at-point) - (define-key map [down-mouse-2] #'goto-address-at-point) - map) - "Keymap for inline e-mail addresses.") +(defvar-keymap eudc-bob-generic-keymap + :doc "Keymap for multimedia objects." + "s" #'eudc-bob-save-object + "!" #'eudc-bob-pipe-object-to-external-program + "" #'eudc-bob-popup-menu) + +(defvar-keymap eudc-bob-image-keymap + :doc "Keymap for inline images." + :parent eudc-bob-generic-keymap + "t" #'eudc-bob-toggle-inline-display) + +(defvar-keymap eudc-bob-sound-keymap + :doc "Keymap for inline sounds." + :parent eudc-bob-generic-keymap + "RET" #'eudc-bob-play-sound-at-point + "" #'eudc-bob-play-sound-at-mouse) + +(defvar-keymap eudc-bob-url-keymap + :doc "Keymap for inline urls." + "RET" #'browse-url-at-point + "" #'browse-url-at-mouse) + +(defvar-keymap eudc-bob-mail-keymap + :doc "Keymap for inline e-mail addresses." + "RET" #'goto-address-at-point + "" #'goto-address-at-point) (defvar eudc-bob-generic-menu '("EUDC Binary Object Menu" diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el index 7994303284b..cde82956c24 100644 --- a/lisp/progmodes/etags-regen.el +++ b/lisp/progmodes/etags-regen.el @@ -409,7 +409,7 @@ File extensions to generate the tags for." (remove-hook 'after-save-hook #'etags-regen--update-file) (remove-hook 'before-save-hook #'etags-regen--mark-as-new)) -(defvar etags-regen-mode-map (make-sparse-keymap)) +(defvar-keymap etags-regen-mode-map) ;;;###autoload (define-minor-mode etags-regen-mode diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 261012bb43a..ee9c30d5080 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1666,12 +1666,10 @@ code line." 'follow-link t 'action (lambda (b) (octave-help (button-label b)))) -(defvar octave-help-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\M-." 'octave-find-definition) - (define-key map "\C-hd" 'octave-help) - (define-key map "\C-ha" 'octave-lookfor) - map)) +(defvar-keymap octave-help-mode-map + "M-." #'octave-find-definition + "C-h d" #'octave-help + "C-h a" #'octave-lookfor) (define-derived-mode octave-help-mode help-mode "OctHelp" "Major mode for displaying Octave documentation." diff --git a/lisp/replace.el b/lisp/replace.el index 2d64612f0fc..a6ba6387dc9 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2517,19 +2517,17 @@ The valid answers include `act', `skip', `act-and-show', This keymap is used by `y-or-n-p' as well as `query-replace'.") -(defvar multi-query-replace-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map query-replace-map) - (define-key map "Y" 'automatic-all) - (define-key map "N" 'exit-current) - map) - "Keymap that defines additional bindings for multi-buffer replacements. +(defvar-keymap multi-query-replace-map + :doc "Keymap that defines additional bindings for multi-buffer replacements. It extends its parent map `query-replace-map' with new bindings to operate on a set of buffers/files. The difference with its parent map is the additional answers `automatic-all' to replace all remaining matches in all remaining buffers with no more questions, and `exit-current' to skip remaining matches in the current buffer -and to continue with the next buffer in the sequence.") +and to continue with the next buffer in the sequence." + :parent query-replace-map + "Y" 'automatic-all + "N" 'exit-current) (defun replace-match-string-symbols (n) "Process a list (and any sub-lists), expanding certain symbols. diff --git a/lisp/simple.el b/lisp/simple.el index 1d4f7b55567..579b9ee9118 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5227,10 +5227,8 @@ File name handlers might not support pty association, if PROGRAM is nil." (defvar process-menu-query-only nil) -(defvar process-menu-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [?d] 'process-menu-delete-process) - map)) +(defvar-keymap process-menu-mode-map + "d" #'process-menu-delete-process) (define-derived-mode process-menu-mode tabulated-list-mode "Process Menu" "Major mode for listing the processes called by Emacs." @@ -11019,11 +11017,9 @@ and setting it to nil." (setq buffer-invisibility-spec nil))) -(defvar messages-buffer-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map special-mode-map) - (define-key map "g" nil) ; nothing to revert - map)) +(defvar-keymap messages-buffer-mode-map + :parent special-mode-map + "g" nil) ; nothing to revert (define-derived-mode messages-buffer-mode special-mode "Messages" "Major mode used in the \"*Messages*\" buffer." diff --git a/lisp/startup.el b/lisp/startup.el index c240fbbe28a..d3b5b2e3b66 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1882,16 +1882,13 @@ Each element in the list should be a list of strings or pairs (file :tag "File"))) -(defvar splash-screen-keymap - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (set-keymap-parent map button-buffer-map) - (define-key map "\C-?" #'scroll-down-command) - (define-key map [?\S-\ ] #'scroll-down-command) - (define-key map " " #'scroll-up-command) - (define-key map "q" #'exit-splash-screen) - map) - "Keymap for splash screen buffer.") +(defvar-keymap splash-screen-keymap + :doc "Keymap for splash screen buffer." + :suppress t :parent button-buffer-map + "DEL" #'scroll-down-command + "S-SPC" #'scroll-down-command + "SPC" #'scroll-up-command + "q" #'exit-splash-screen) ;; These are temporary storage areas for the splash screen display. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index e4c6ea5e02c..bd9af41de00 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -97,8 +97,8 @@ -(defvar tab-bar-mode-map (make-sparse-keymap) - "Tab Bar mode map.") +(defvar-keymap tab-bar-mode-map + :doc "Tab Bar mode map.") (defcustom tab-bar-define-keys t "Define specified tab-bar key bindings. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 9cec637f996..ad7c8571f67 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -3816,12 +3816,10 @@ available on the net." ;;; Ispell Minor Mode ;;; ********************************************************************** -(defvar ispell-minor-keymap - (let ((map (make-sparse-keymap))) - (define-key map " " 'ispell-minor-check) - (define-key map "\r" 'ispell-minor-check) - map) - "Keymap used for Ispell minor mode.") +(defvar-keymap ispell-minor-keymap + :doc "Keymap used for Ispell minor mode." + "SPC" #'ispell-minor-check + "RET" #'ispell-minor-check) ;;;###autoload (define-minor-mode ispell-minor-mode diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 0eb686ce35d..ad1d4fa1f88 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -945,18 +945,14 @@ START is the position of the \\ and DELIM is the delimiter char." map) "Keymap shared by TeX modes.") -(defvar latex-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map tex-mode-map) - (define-key map "\C-c\C-s" #'latex-split-block) - map) - "Keymap for `latex-mode'. See also `tex-mode-map'.") - -(defvar plain-tex-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map tex-mode-map) - map) - "Keymap for `plain-tex-mode'. See also `tex-mode-map'.") +(defvar-keymap latex-mode-map + :doc "Keymap for `latex-mode'. See also `tex-mode-map'." + :parent tex-mode-map + "C-c C-s" #'latex-split-block) + +(defvar-keymap plain-tex-mode-map + :doc "Keymap for `plain-tex-mode'. See also `tex-mode-map'." + :parent tex-mode-map) (defvar tex-shell-map (let ((m (make-sparse-keymap))) diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el index 3b20d795ea8..d958bd0e96d 100644 --- a/lisp/tree-widget.el +++ b/lisp/tree-widget.el @@ -392,13 +392,11 @@ EVENT is the mouse event received." (if (get-char-property pos 'button) (widget-button-click event)))) -(defvar tree-widget-button-keymap - (let ((km (make-sparse-keymap))) - (set-keymap-parent km widget-keymap) - (define-key km [down-mouse-1] 'tree-widget-button-click) - km) - "Keymap used inside node buttons. -Handle mouse button 1 click on buttons.") +(defvar-keymap tree-widget-button-keymap + :doc "Keymap used inside node buttons. +Handle mouse button 1 click on buttons." + :parent widget-keymap + "" #'tree-widget-button-click) (define-widget 'tree-widget-icon 'push-button "Basic widget other tree-widget icons are derived from." diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 7fd15bb1331..401ccb066e0 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -694,10 +694,8 @@ Before doing that, check if there are any old backups and get rid of them." ;; and this will simply use it. (define-key menu-bar-tools-menu [vc] vc-menu-entry)) -(defconst vc-mode-line-map - (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] vc-menu-entry) - map)) +(defvar-keymap vc-mode-line-map + " " vc-menu-entry) (defun vc-mode-line (file &optional backend) "Set `vc-mode' to display type of version control for FILE. commit a07465410adcf13c7f46cfe381380258601d4299 Merge: 773e9ebadcb 2d5cf228186 Author: Po Lu Date: Sun Mar 16 20:16:05 2025 +0800 Merge from savannah/emacs-30 2d5cf228186 Fix clipboard object handle leak on Android 3.1 to 11.0 b6b4a080a3a Only disable 'completion-preview-active-mode' when it is on commit 773e9ebadcb9163d1596645403e87d4381017ab8 Merge: 66ea323f0d5 91a9d021999 Author: Po Lu Date: Sun Mar 16 20:14:48 2025 +0800 ; Merge from savannah/emacs-30 The following commit was skipped: 91a9d021999 Backport Transient commit f69e1286 commit 66ea323f0d543b00bb83b418abf243b1105dd43d Merge: 5d02ca181da dcf3916e558 Author: Po Lu Date: Sun Mar 16 20:14:48 2025 +0800 Merge from savannah/emacs-30 dcf3916e558 ; Doc fix for legacy keymap functions 227db70db98 ; * doc/misc/ede.texi (Top): Improve introduction. commit 5d02ca181daa2b3833a2b32157388a7b131955e8 Author: Po Lu Date: Sun Mar 16 20:14:32 2025 +0800 ; New `bisect' argument to `ats-execute-tests-batch' * test/infra/android/test-controller.el (ats-execute-tests-batch): New argument `bisect'. diff --git a/test/infra/android/test-controller.el b/test/infra/android/test-controller.el index 7424518e11b..6e5350b43a3 100644 --- a/test/infra/android/test-controller.el +++ b/test/infra/android/test-controller.el @@ -2537,7 +2537,13 @@ The following command-line arguments are also accepted: --stub-file Name of `stub.zip' wrapper required on Android <= 4.4. --test-dir Directory in which Emacs's tests are situated. --output-dir, -o DIR Name of a directory into which to save test logs. - --no-upload Don't upload tests; only run those which already exist." + --no-upload Don't upload tests; only run those which already exist. + +In addition, these options exist to facilitate debugging the +automated testing process itself. + + --bisect COUNT Skip COUNT tests from the beginning to investigate + compatibility issues between tests." (let* ((ats-adb-host (getenv "ATS_ADB_HOST")) (devices (ats-enumerate-devices (lambda (name state _) @@ -2547,7 +2553,8 @@ The following command-line arguments are also accepted: (cmd-device nil) (cmd-user nil) (cmd-output-dir nil) - (cmd-no-upload nil)) + (cmd-no-upload nil) + (bisect 0)) ;; Read command-line arguments. (let (arg) (while (setq arg (pop argv)) @@ -2568,7 +2575,13 @@ The following command-line arguments are also accepted: --stub-file Name of `stub.zip' wrapper required on Android <= 4.4. --test-dir Directory in which Emacs's tests are situated. --output-dir, -o DIR Name of a directory into which to save test logs. - --no-upload Don't upload tests; only run those which already exist.") + --no-upload Don't upload tests; only run those which already exist. + +In addition, these options exist to facilitate debugging the +automated testing process itself. + + --bisect COUNT Skip COUNT tests from the beginning to investigate + compatibility issues between tests.") (kill-emacs 0)) ((or (equal arg "-s") (equal arg "--device")) (setq cmd-device @@ -2597,6 +2610,17 @@ The following command-line arguments are also accepted: "Expected argument to `--test-dir' option.")))) ((equal arg "--no-upload") (setq cmd-no-upload t)) + ((equal arg "--bisect") + (let ((value (or (pop argv) + (ats-cmd-error + "Expected argument to `--bisect' option.")))) + (setq bisect (progn + (unless (string-match-p + "\\`[[:digit:]]+\\'" value) + (ats-cmd-error + "Invalid value for `--bisect' option: `%s'" + value)) + (string-to-number value))))) (t (ats-cmd-error "Unknown command line argument `%s'" arg))))) ;; Validate and apply command-line arguments or prompt the user for ;; parameters in their absence. @@ -2625,10 +2649,11 @@ The following command-line arguments are also accepted: (user nil)) (if cmd-user (progn - (let ((valid-number (string-match-p "^[[:digit:]]+$" cmd-user)) + (let ((valid-number + (string-match-p "\\`[[:digit:]]+\\'" cmd-user)) (uid (string-to-number cmd-user))) (unless valid-number - (ats-cmd-error "Invalid value for `--user' argument: %s" + (ats-cmd-error "Invalid value for `--user' argument: `'%s'" cmd-user)) (unless (assq uid users) (ats-cmd-error "No such user exists: %d" uid)) @@ -2655,8 +2680,9 @@ The following command-line arguments are also accepted: (read-directory-name "Where to save test log files? ")))) (mkdir output-directory t) - (let ((tests (ats-list-tests connection))) - (dolist (test tests) + (let* ((tests (ats-list-tests connection)) + (start (nthcdr bisect tests))) + (dolist (test start) (message "Generating `%s/%s-test.log'" output-directory test) (ats-run-test connection test) commit 2d5cf228186184b5af6e4e8ee8f5280f67f407bc (refs/remotes/origin/emacs-30) Author: Po Lu Date: Sun Mar 16 20:12:52 2025 +0800 Fix clipboard object handle leak on Android 3.1 to 11.0 * src/androidselect.c (extract_fd_offsets): Release retrieved ParcelFileDescriptor objects on APIs 12 through 30. diff --git a/src/androidselect.c b/src/androidselect.c index 8d3cfac1df9..337747cbcb4 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -418,7 +418,10 @@ close_asset_fd (void *afd) } /* Return the offset, file descriptor and length of the data contained - in the asset file descriptor AFD, in *FD, *OFFSET, and *LENGTH. + in the asset file descriptor AFD, in *FD, *OFFSET, and *LENGTH. AFD + will not be released if an exception is detected; it is the + responsibility of the caller to arrange that it be. + Value is 0 upon success, 1 otherwise. */ static int @@ -487,6 +490,9 @@ extract_fd_offsets (jobject afd, int *fd, jlong *offset, jlong *length) *fd = (*android_java_env)->CallIntMethod (android_java_env, java_fd, fd_class.get_fd); + android_exception_check_1 (java_fd); + ANDROID_DELETE_LOCAL_REF (java_fd); + if (*fd >= 0) return 0; } commit 412a6fad98e768000dfe9538179889d6faeaa97a Author: Eli Zaretskii Date: Sun Mar 16 13:35:18 2025 +0200 Avoid rare segfaults in 'combine_updates_for_frame' * src/xdisp.c (redisplay_internal): Don't add to 'tty_root_frames' frames that are not yet completely made. (Bug#77046) diff --git a/src/xdisp.c b/src/xdisp.c index ac654934e54..d7e0691c44d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -17569,7 +17569,10 @@ redisplay_internal (void) if (is_tty_frame (f)) { /* Ignore all invisible tty frames, children or root. */ - if (!frame_redisplay_p (f)) + if (!frame_redisplay_p (f) + /* Ignore frames not yet completely made, which we + cannot safely redisplay. */ + || !f->after_make_frame) continue; /* Remember tty root frames which we've seen. */ commit b6b4a080a3abb5a45b680e26f93dd17adbb75f69 Author: Eshel Yaron Date: Sun Mar 16 09:45:25 2025 +0100 Only disable 'completion-preview-active-mode' when it is on * lisp/completion-preview.el (completion-preview--post-command): Avoid calling 'completion-preview-active-mode' to disable the mode when already off, since it forces a costly redisplay. (Bug#76964) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 1c524985f05..ae1394d27b4 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -437,13 +437,17 @@ point, otherwise hide it." (cancel-timer completion-preview--timer) (setq completion-preview--timer nil)) - ;; If we're called after a command that itself updates the - ;; preview, don't do anything. - (unless internal-p - (if (and (completion-preview-require-certain-commands) - (completion-preview-require-minimum-symbol-length)) - (completion-preview--show) - (completion-preview-active-mode -1))))) + (cond + (internal-p + ;; `this-command' took care of updating the preview. Do nothing. + ) + ((and (completion-preview-require-certain-commands) + (completion-preview-require-minimum-symbol-length)) + ;; All conditions met. Show or update the preview. + (completion-preview--show)) + (completion-preview-active-mode + ;; The preview is shown, but it shouldn't be. Hide it. + (completion-preview-active-mode -1))))) (defun completion-preview-insert () "Insert the completion candidate that the preview is showing." commit 91a9d021999d78109b01bad21d3439bc2e2875cd Author: Jonas Bernoulli Date: Sat Mar 15 20:29:58 2025 +0100 Backport Transient commit f69e1286 2025-03-12 f69e128654627275e7483a735f670bd53501999d transient-suffix-object: Handle duplicated command invoked using mouse Fixes bug#76680. diff --git a/lisp/transient.el b/lisp/transient.el index 39d7e822bb6..bda680d3c7a 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -1573,6 +1573,10 @@ drawing in the transient buffer.") This is bound while the suffix predicate is being evaluated, and while functions that return faces are being evaluated.") +(defvar transient--current-suffix nil + "The suffix currently being invoked using a mouse event. +Do not use this; instead use function `transient-suffix-object'.") + (defvar transient--pending-group nil "The group that is currently being processed. This is bound while the suffixes are drawn in the transient buffer.") @@ -1656,6 +1660,7 @@ probably use this instead: (cl-check-type command command)) (cond (transient--pending-suffix) + (transient--current-suffix) ((or transient--prefix transient-current-prefix) (let ((suffixes @@ -2544,7 +2549,8 @@ value. Otherwise return CHILDREN as is." (transient--redisplay))))) (setq transient-current-prefix nil) (setq transient-current-command nil) - (setq transient-current-suffixes nil))) + (setq transient-current-suffixes nil) + (setq transient--current-suffix nil))) (defun transient--post-exit (&optional command) (transient--debug 'post-exit) @@ -2577,6 +2583,8 @@ value. Otherwise return CHILDREN as is." (setq transient--all-levels-p nil) (setq transient--minibuffer-depth 0) (run-hooks 'transient-exit-hook) + (when command + (setq transient--current-suffix nil)) (when resume (transient--stack-pop)))) @@ -2748,12 +2756,12 @@ Use that command's pre-command to determine transient behavior." (not (eq (posn-window (event-start last-command-event)) transient--window))) transient--stay - (setq this-command - (with-selected-window transient--window - (get-text-property (if (mouse-event-p last-command-event) - (posn-point (event-start last-command-event)) - (point)) - 'command))) + (with-selected-window transient--window + (let ((pos (if (mouse-event-p last-command-event) + (posn-point (event-start last-command-event)) + (point)))) + (setq this-command (get-text-property pos 'command)) + (setq transient--current-suffix (get-text-property pos 'suffix)))) (transient--call-pre-command))) (defun transient--do-recurse () commit dcf3916e558d974aef6516e5709379fa3c762832 Author: Stefan Kangas Date: Sat Mar 15 19:36:51 2025 +0100 ; Doc fix for legacy keymap functions * doc/lispref/keymaps.texi (Low-Level Key Binding): Add new alternatives for two more legacy functions. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index e1f11f9a138..e1814ad21d4 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1839,6 +1839,8 @@ local keymap, or @code{nil} if it is undefined there. The argument @var{accept-defaults} controls checking for default bindings, as in @code{lookup-key} (above). + +Use @code{keymap-local-lookup} instead of this function. @end defun @defun global-key-binding key &optional accept-defaults @@ -1847,6 +1849,8 @@ current global keymap, or @code{nil} if it is undefined there. The argument @var{accept-defaults} controls checking for default bindings, as in @code{lookup-key} (above). + +Use @code{keymap-global-lookup} instead of this function. @end defun @defun event-convert-list list commit 227db70db984091dc2ba9e1d860ce5354d729f7f Author: Stefan Kangas Date: Sat Mar 15 00:18:28 2025 +0100 ; * doc/misc/ede.texi (Top): Improve introduction. diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index 6b7f8700300..dc1845dc276 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -71,14 +71,22 @@ modify this GNU manual.'' @top EDE @comment node-name, next, previous, up -@ede{} is the Emacs Development Environment: an Emacs extension that -simplifies building and debugging programs in Emacs. It attempts to -emulate a typical IDE (Integrated Development Environment). @ede{} +@ede{} (Emacs Development Environment) is an Emacs extension that +simplifies building and debugging programs in Emacs. @ede{} can manage or create your makefiles and other building environment duties, allowing you to concentrate on writing code rather than support files. It aims to make it much easier for new programmers to learn and adopt GNU ways of doing things. +In contrast to Emacs's built-in ``project'' support (@pxref{Projects,,, +emacs, GNU Emacs Manual}), which provides lightweight project management +features focused on file navigation and search, @ede{} offers a +structured approach to managing build systems, configuration files, and +project metadata. While built-in projects are well-suited to +general-purpose workflows, @ede{} is useful for projects using tools +like @samp{make}, @samp{automake}, or @samp{autoconf}, or that involve +managing multiple targets, include paths, and build configurations. + @ifnottex @insertcopying @end ifnottex