From 85dcf4fe96941e00f88a68859e8b720ef6e09282 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sat, 16 Aug 2025 18:22:47 +0100 Subject: [PATCH 001/158] Flymake: improve previous fix (bug#78862) The previous fix for this bug is an acceptable approach, but more care must be taken when clearing a flymake--state object's diagnostics. Refactor this behaviour into a helper. * lisp/progmodes/flymake.el (flymake--clear-state): New helper. (flymake--publish-diagnostics, flymake-start): Use it. --- lisp/progmodes/flymake.el | 31 +++++++++++-------------------- 1 file changed, 11 insertions(+), 20 deletions(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index bdfcf51a5ff..c5380a9bb64 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1172,6 +1172,13 @@ report applies to that region." (flymake--state-foreign-diags state)) (clrhash (flymake--state-foreign-diags state))) +(defun flymake--clear-state (state) + (cl-loop for diag in (flymake--state-diags state) + for ov = (flymake--diag-overlay diag) + when ov do (flymake--delete-overlay ov)) + (setf (flymake--state-diags state) nil) + (flymake--clear-foreign-diags state)) + (defvar-local flymake-mode nil) (defvar-local flymake--mode-line-counter-cache nil @@ -1189,7 +1196,7 @@ and other buffers." ;; (cond (;; If there is a `region' arg, only affect the diagnostics whose - ;; overlays are in a certain region. Discard "foreign" + ;; overlays are in a certain region. Ignore "foreign" ;; diagnostics. region (cl-loop for diag in (flymake--state-diags state) @@ -1202,16 +1209,9 @@ and other buffers." else collect diag into surviving finally (setf (flymake--state-diags state) surviving))) - (;; Else, if this is the first report, zero all lists and delete - ;; all associated overlays. + (;; Else, if this is the first report, fully clear this state. (not (flymake--state-reported-p state)) - (cl-loop for diag in (flymake--state-diags state) - for ov = (flymake--diag-overlay diag) - when ov do (flymake--delete-overlay ov)) - (setf (flymake--state-diags state) nil) - ;; Also clear all overlays for `foreign-diags' in all other - ;; buffers. - (flymake--clear-foreign-diags state)) + (flymake--clear-state state)) (;; If this is not the first report, do no cleanup. t)) @@ -1415,16 +1415,7 @@ Interactively, with a prefix arg, FORCE is t." ;; See bug#78862 (maphash (lambda (backend state) (unless (memq backend flymake-diagnostic-functions) - ;; Delete all overlays - (dolist (diag (flymake--state-diags state)) - (let ((ov (flymake--diag-overlay diag))) - (flymake--delete-overlay ov))) - ;; Set the list of diagnostics to nil to - ;; avoid trying to delete them again. - ;; We keep the state object itself around in - ;; case there's still diagnostics in flight, - ;; so we don't break things. - (setf (flymake--state-diags state) nil))) + (flymake--clear-state state))) flymake--state) (run-hook-wrapped 'flymake-diagnostic-functions From f8cb751ac0a403bc3769cac9816ad46809b7740e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Aug 2025 19:40:11 +0100 Subject: [PATCH 002/158] vc-hg-known-other-working-trees: Fix on MS-Windows * lisp/vc/vc-hg.el (vc-hg-known-other-working-trees): Use expand-file-name to convert paths from .hg/sharedpath files. --- lisp/vc/vc-hg.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index e9095b72098..b0e5a633566 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1738,7 +1738,10 @@ Intended for use via the `vc-hg--async-command' wrapper." (if (file-exists-p our-sp) (with-temp-buffer (insert-file-contents-literally our-sp) - (setq our-store (string-trim (buffer-string))) + ;; On MS-Windows, ".hg/sharedpath" gives file names with + ;; backslashes; expand-file-name normalizes that to forward + ;; slashes, needed for 'equal' comparison below. + (setq our-store (expand-file-name (string-trim (buffer-string)))) (push (abbreviate-file-name (file-name-directory our-store)) shares)) (setq our-store (expand-file-name ".hg" our-root))) @@ -1748,7 +1751,9 @@ Intended for use via the `vc-hg--async-command' wrapper." ((file-exists-p sp))) (with-temp-buffer (insert-file-contents-literally sp) - (when (equal our-store (buffer-string)) + (when (equal our-store + ;; See above why we use expand-file-name + (expand-file-name (string-trim (buffer-string)))) (push root shares))))) shares)) From 72022459a90bd68bc6ea4a821ca08ff713c23dd3 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 16 Aug 2025 20:40:50 +0100 Subject: [PATCH 003/158] vc-hg-checkin-patch: Fix on MS-Windows, make 'hg import' async * lisp/vc/vc-hg.el (vc-hg--checkin): New function to do the work of vc-hg-checkin and vc-hg-checkin-patch. (vc-hg-checkin): Replace body with call to vc-hg--checkin. (vc-hg-checkin-patch): Likewise. As compared with the old implementation, this change (i) fixes encoding issues when checking in patches on MS-Windows; and (ii) when vc-async-checkin is non-nil, runs 'hg import' asynchronously instead of running 'hg update' asynchronously (bug#79235). --- lisp/vc/vc-hg.el | 109 ++++++++++++++++++++++++++--------------------- 1 file changed, 61 insertions(+), 48 deletions(-) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index b0e5a633566..6c13e555836 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1213,11 +1213,18 @@ It is based on `log-edit-mode', and has Hg-specific extensions.") (defalias 'vc-hg-async-checkins #'always) -(defun vc-hg-checkin (files comment &optional _rev) - "Hg-specific version of `vc-BACKEND-checkin'. -REV is ignored." +(defun vc-hg--checkin (comment &optional files patch-string) + "Workhorse routine for `vc-hg-checkin' and `vc-hg-checkin-patch'. +COMMENT is the commit message. +For a regular checkin, FILES is the list of files to check in. +To check in a patch, PATCH-STRING is the patch text. +It is an error to supply both or neither." + (unless (xor files patch-string) + (error "Invalid call to `vc-hg--checkin'")) (let* ((args (vc-hg--extract-headers comment)) - (file1 (or (car files) default-directory)) + (temps-dir (or (file-name-directory (or (car files) + default-directory)) + default-directory)) (msg-file ;; On MS-Windows, pass the commit log message through a file, ;; to work around the limitation that command-line arguments @@ -1225,30 +1232,53 @@ REV is ignored." ;; support non-ASCII characters in the log message. ;; Also handle remote files. (and (eq system-type 'windows-nt) - (let ((default-directory (or (file-name-directory file1) - default-directory))) - (make-nearby-temp-file "hg-msg"))))) - (when msg-file - (let ((coding-system-for-write 'utf-8)) - (write-region (car args) nil msg-file))) - (let ((coding-system-for-write - ;; On MS-Windows, we must encode command-line arguments in - ;; the system codepage. - (if (eq system-type 'windows-nt) - locale-coding-system - coding-system-for-write)) - (args (if msg-file - (cl-list* "commit" "-A" "-l" (file-local-name msg-file) - (cdr args)) - (cl-list* "commit" "-A" "-m" args))) - (post (lambda () - (when (and msg-file (file-exists-p msg-file)) - (delete-file msg-file))))) + (let ((default-directory temps-dir)) + (make-nearby-temp-file "hg-msg")))) + (patch-file (and patch-string + (let ((default-directory temps-dir)) + (make-nearby-temp-file "hg-patch"))))) + (let ((coding-system-for-write 'utf-8)) + (when msg-file + (write-region (car args) nil msg-file)) + (when patch-file + (write-region patch-string nil patch-file))) + (let* ((coding-system-for-write + ;; On MS-Windows, we must encode command-line arguments in + ;; the system codepage. + (if (eq system-type 'windows-nt) + locale-coding-system + coding-system-for-write)) + (args + (nconc (if patch-file + (list "import" "--bypass" patch-file) + (list "commit" "-A")) + (if msg-file + (cl-list* "-l" (file-local-name msg-file) (cdr args)) + (cl-list* "-m" args)))) + (post (lambda () + (when (and msg-file (file-exists-p msg-file)) + (delete-file msg-file)) + (when (and patch-file (file-exists-p patch-file)) + (delete-file patch-file)) + ;; When committing a patch we run 'hg import' and + ;; then 'hg update'. We have 'hg update' here in the + ;; always-synchronous `post' function because we + ;; assume that 'hg import' is the one that might be + ;; slow and so benefits most from `vc-async-checkin'. + ;; If in fact both the 'hg import' and the 'hg + ;; update' can be slow, then we need to make both of + ;; them part of the async command, possibly by + ;; writing out a tiny shell script (bug#79235). + (when patch-file + (vc-hg-command nil 0 nil "update" "--merge" + "--tool" "internal:local" "tip"))))) (if vc-async-checkin (let ((buffer (vc-hg--async-buffer))) (vc-wait-for-process-before-save (apply #'vc-hg--async-command buffer (nconc args files)) - "Finishing checking in files...") + (if patch-file + "Finishing checking in patch...." + "Finishing checking in files...")) (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg) @@ -1258,31 +1288,14 @@ REV is ignored." (apply #'vc-hg-command nil 0 files args) (funcall post))))) -;; FIXME: Needs MS-Windows encoding issues handling. -;; Possibly we want fix this by merging this function into the preceeding one. -;; Figure out resolution of #79235 first. +(defun vc-hg-checkin (files comment &optional _rev) + "Hg-specific version of `vc-BACKEND-checkin'. +REV is ignored." + (vc-hg--checkin comment files nil)) + (defun vc-hg-checkin-patch (patch-string comment) - (let ((patch-file (make-nearby-temp-file "hg-patch"))) - (write-region patch-string nil patch-file) - (unwind-protect - (let ((args (list "update" - "--merge" "--tool" "internal:local" - "tip"))) - (apply #'vc-hg-command nil 0 nil - (nconc (list "import" "--bypass" patch-file "-m") - (vc-hg--extract-headers comment))) - (if vc-async-checkin - (let ((buffer (vc-hg--async-buffer))) - (vc-wait-for-process-before-save - (apply #'vc-hg--async-command buffer args) - "Finishing checking in patch....") - (with-current-buffer buffer - (vc-run-delayed - (vc-compilation-mode 'hg))) - (vc-set-async-update buffer) - (list 'async (get-buffer-process buffer))) - (apply #'vc-hg-command nil 0 nil args))) - (delete-file patch-file)))) + "Hg-specific version of `vc-BACKEND-checkin-patch'." + (vc-hg--checkin comment nil patch-string)) (defun vc-hg--extract-headers (comment) (log-edit-extract-headers `(("Author" . "--user") From 23b766b503a894ff58773b40e0d185bb40b9529e Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 16 Aug 2025 20:42:25 +0100 Subject: [PATCH 004/158] ; Fix last change: change `let*' to `let'. --- lisp/vc/vc-hg.el | 60 ++++++++++++++++++++++++------------------------ 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 6c13e555836..550d13f9adc 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1242,36 +1242,36 @@ It is an error to supply both or neither." (write-region (car args) nil msg-file)) (when patch-file (write-region patch-string nil patch-file))) - (let* ((coding-system-for-write - ;; On MS-Windows, we must encode command-line arguments in - ;; the system codepage. - (if (eq system-type 'windows-nt) - locale-coding-system - coding-system-for-write)) - (args - (nconc (if patch-file - (list "import" "--bypass" patch-file) - (list "commit" "-A")) - (if msg-file - (cl-list* "-l" (file-local-name msg-file) (cdr args)) - (cl-list* "-m" args)))) - (post (lambda () - (when (and msg-file (file-exists-p msg-file)) - (delete-file msg-file)) - (when (and patch-file (file-exists-p patch-file)) - (delete-file patch-file)) - ;; When committing a patch we run 'hg import' and - ;; then 'hg update'. We have 'hg update' here in the - ;; always-synchronous `post' function because we - ;; assume that 'hg import' is the one that might be - ;; slow and so benefits most from `vc-async-checkin'. - ;; If in fact both the 'hg import' and the 'hg - ;; update' can be slow, then we need to make both of - ;; them part of the async command, possibly by - ;; writing out a tiny shell script (bug#79235). - (when patch-file - (vc-hg-command nil 0 nil "update" "--merge" - "--tool" "internal:local" "tip"))))) + (let ((coding-system-for-write + ;; On MS-Windows, we must encode command-line arguments in + ;; the system codepage. + (if (eq system-type 'windows-nt) + locale-coding-system + coding-system-for-write)) + (args + (nconc (if patch-file + (list "import" "--bypass" patch-file) + (list "commit" "-A")) + (if msg-file + (cl-list* "-l" (file-local-name msg-file) (cdr args)) + (cl-list* "-m" args)))) + (post (lambda () + (when (and msg-file (file-exists-p msg-file)) + (delete-file msg-file)) + (when (and patch-file (file-exists-p patch-file)) + (delete-file patch-file)) + ;; When committing a patch we run 'hg import' and + ;; then 'hg update'. We have 'hg update' here in the + ;; always-synchronous `post' function because we + ;; assume that 'hg import' is the one that might be + ;; slow and so benefits most from `vc-async-checkin'. + ;; If in fact both the 'hg import' and the 'hg + ;; update' can be slow, then we need to make both of + ;; them part of the async command, possibly by + ;; writing out a tiny shell script (bug#79235). + (when patch-file + (vc-hg-command nil 0 nil "update" "--merge" + "--tool" "internal:local" "tip"))))) (if vc-async-checkin (let ((buffer (vc-hg--async-buffer))) (vc-wait-for-process-before-save From 6979bce0b284d62db564647a7be941f8d4828e95 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 17 Aug 2025 11:19:01 +0200 Subject: [PATCH 005/158] Suppress Tramp session timeout if buffer is modified * doc/misc/tramp.texi (Predefined connection information): A session timeout is suppressed if there is a modified buffer, or a buffer under auto-revert. (Traces and Profiles): Tramp messages are written to the *Messages* buffer when level is less than or equal to 3. * lisp/net/tramp-sh.el (tramp-timeout-session): Do not timeout when buffer is modified, or in auto-revert mode. * test/lisp/net/tramp-tests.el (tramp-test48-session-timeout): Extend test. --- doc/misc/tramp.texi | 11 +++++---- lisp/net/tramp-sh.el | 44 ++++++++++++++++++++++++++++-------- test/lisp/net/tramp-tests.el | 32 +++++++++++++++++++++++++- 3 files changed, 72 insertions(+), 15 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 1dc616918d0..182323d0f25 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2376,9 +2376,11 @@ value is @t{"-l"}, but some shells, like @command{ksh}, prefer All @file{tramp-sh.el} based methods accept the property @t{"session-timeout"}. This is the time (in seconds) after a connection is disabled for security reasons, and must be -reestablished. A value of @code{nil} disables this feature. Most of -the methods do not set this property except the @option{sudo}, -@option{doas} and @option{run0} methods, which use predefined values. +reestablished@footnote{If there is a modified buffer, or a buffer +under @code{auto-revert}, this is suppressed.}. A value of @code{nil} +disables this feature. Most of the methods do not set this property +except the @option{sudo}, @option{doas} and @option{run0} methods, +which use predefined values. @item @t{"~"}@* @t{"~user"} @@ -6834,7 +6836,8 @@ they are kept. Example: @value{tramp} messages are raised with verbosity levels ranging from 0 to 10. @value{tramp} does not display all messages; only those with a -verbosity level less than or equal to @code{tramp-verbose}. +verbosity level less than or equal to 3, when @code{tramp-verbose} +permits. @noindent The verbosity levels are diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3c1f36fa8de..9d13cdc3a2d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5154,17 +5154,41 @@ Goes through the list `tramp-inline-compress-commands'." ;;;###tramp-autoload (defun tramp-timeout-session (vec) "Close the connection VEC after a session timeout. -If there is just some editing, retry it after 5 seconds." - (if (and (tramp-get-connection-property - (tramp-get-connection-process vec) "locked") - (tramp-file-name-equal-p vec (car tramp-current-connection))) - (progn - (tramp-message - vec 5 "Cannot timeout session, trying it again in %s seconds." 5) - (run-at-time 5 nil #'tramp-timeout-session vec)) +If there is just some editing, retry it after 5 seconds. +If there is a modified buffer, retry it after 60 seconds." + (cond + ;; Tramp is locked. Try it, again. + ((and (tramp-get-connection-property + (tramp-get-connection-process vec) "locked") + (tramp-file-name-equal-p vec (car tramp-current-connection))) (tramp-message - vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc)) - (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes))) + vec 5 "Cannot timeout session, trying it again in %s seconds." 5) + (run-at-time 5 nil #'tramp-timeout-session vec)) + ;; There's a modified buffer. Try it, again. + ((seq-some + (lambda (buf) + (and-let* (((or (buffer-modified-p buf) + (with-current-buffer buf + ;; We don't know whether autorevert.el has + ;; been loaded alreaddy. + (tramp-compat-funcall 'auto-revert-active-p)))) + (bfn (buffer-file-name buf)) + (v (tramp-ensure-dissected-file-name bfn)) + ((tramp-file-name-equal-p vec v))))) + (tramp-list-remote-buffers)) + (tramp-message + vec 5 + (concat + "Cannot timeout session (modified buffer), " + "trying it again in %s seconds.") + (tramp-get-method-parameter vec 'tramp-session-timeout)) + (run-at-time + (tramp-get-method-parameter vec 'tramp-session-timeout) nil + #'tramp-timeout-session vec)) + ;; Do it. + (t (tramp-message + vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc)) + (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes)))) (defun tramp-maybe-open-connection (vec) "Maybe open a connection VEC. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4438e0090d4..58b5083b2c0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -8471,7 +8471,37 @@ process sentinels. They shall not disturb each other." (cl-letf (((symbol-function #'ask-user-about-lock) #'always)) (save-buffer))) (should-not - (string-match-p "File is missing:" captured-messages)))))) + (string-match-p "File is missing:" captured-messages))))) + + ;; A modified buffer suppresses session timeout. + (with-temp-buffer + (set-visited-file-name tmp-name) + (insert "foo") + (should (buffer-modified-p)) + (tramp-timeout-session tramp-test-vec) + (should + (process-live-p (tramp-get-connection-process tramp-test-vec))) + ;; Steal the file lock. + (cl-letf (((symbol-function #'ask-user-about-lock) #'always)) + (save-buffer)) + (tramp-timeout-session tramp-test-vec) + (should-not + (process-live-p (tramp-get-connection-process tramp-test-vec)))) + + ;; An auto-reverted buffer suppresses session timeout. + (with-temp-buffer + (set-visited-file-name tmp-name) + (auto-revert-mode 1) + ;; Steal the file lock. + (cl-letf (((symbol-function #'ask-user-about-lock) #'always)) + (save-buffer)) + (tramp-timeout-session tramp-test-vec) + (should + (process-live-p (tramp-get-connection-process tramp-test-vec))) + (auto-revert-mode -1) + (tramp-timeout-session tramp-test-vec) + (should-not + (process-live-p (tramp-get-connection-process tramp-test-vec))))) ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) From 6f7e795ce1e5cf4e62c6260c4bde3545fc6d0f0d Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 17 Aug 2025 11:06:55 +0100 Subject: [PATCH 006/158] vc--maybe-read-remote-location: Don't return a list * lisp/vc/vc.el (vc--maybe-read-remote-location): Return an atom. (vc-root-diff-incoming, vc-root-diff-outgoing, vc-log-incoming) (vc-log-outgoing): Wrap call to 'vc--maybe-read-remote-location' in a call to 'list'. --- lisp/vc/vc.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 5d8c3f1eeb8..8543b14c2a2 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2546,7 +2546,7 @@ In some version control systems REMOTE-LOCATION can be a remote branch name. See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." - (interactive (vc--maybe-read-remote-location)) + (interactive (list (vc--maybe-read-remote-location))) (vc--with-backend-in-rootdir "VC root-diff" (let ((default-directory rootdir) (incoming (vc--incoming-revision backend @@ -2570,7 +2570,7 @@ global binding." ;; for those VCS is to make a comparison between locally committed ;; changes and remote committed changes. ;; (Hence why we don't call `vc-buffer-sync-fileset'.) - (interactive (vc--maybe-read-remote-location)) + (interactive (list (vc--maybe-read-remote-location))) (vc--with-backend-in-rootdir "VC root-diff" (let ((default-directory rootdir) (incoming (vc--incoming-revision backend @@ -3449,8 +3449,8 @@ The command prompts for the branch whose change log to show." (defun vc--maybe-read-remote-location () (and current-prefix-arg - (list (read-string "Remote location/branch (empty for default): " - 'vc-remote-location-history)))) + (read-string "Remote location/branch (empty for default): " + 'vc-remote-location-history))) (defun vc--incoming-revision (backend remote-location) (or (vc-call-backend backend 'incoming-revision remote-location) @@ -3462,7 +3462,7 @@ The command prompts for the branch whose change log to show." When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from. When called interactively with a prefix argument, prompt for REMOTE-LOCATION. In some version control systems REMOTE-LOCATION can be a remote branch name." - (interactive (vc--maybe-read-remote-location)) + (interactive (list (vc--maybe-read-remote-location))) (vc--with-backend-in-rootdir "VC root-log" (vc-incoming-outgoing-internal backend (or remote-location "") "*vc-incoming*" 'log-incoming))) @@ -3480,7 +3480,7 @@ In some version control systems REMOTE-LOCATION can be a remote branch name." When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. When called interactively with a prefix argument, prompt for REMOTE-LOCATION. In some version control systems REMOTE-LOCATION can be a remote branch name." - (interactive (vc--maybe-read-remote-location)) + (interactive (list (vc--maybe-read-remote-location))) (vc--with-backend-in-rootdir "VC root-log" (vc-incoming-outgoing-internal backend (or remote-location "") "*vc-outgoing*" 'log-outgoing))) From 70b5ad0192b2dd6232c1961b49e94a6620d02152 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 17 Aug 2025 11:10:14 +0100 Subject: [PATCH 007/158] Delete duplicate bindings of default-directory * lisp/vc/vc.el (vc-root-version-diff, vc-diff-mergebase) (vc-root-diff-incoming, vc-root-diff-outgoing, vc-root-diff): Delete duplicate bindings of default-directory. vc--with-backend-in-rootdir already establishes bindings. --- lisp/vc/vc.el | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 8543b14c2a2..73f4f5d6f1d 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2456,9 +2456,8 @@ state of each file in the fileset." (when (and (not rev1) rev2) (error "Not a valid revision range")) (vc--with-backend-in-rootdir "VC root-diff" - (let ((default-directory rootdir)) - (vc-diff-internal vc-allow-async-diff (list backend (list rootdir)) rev1 rev2 - (called-interactively-p 'interactive))))) + (vc-diff-internal vc-allow-async-diff (list backend (list rootdir)) rev1 rev2 + (called-interactively-p 'interactive)))) ;;;###autoload (defun vc-diff (&optional historic not-essential fileset) @@ -2531,8 +2530,7 @@ The merge base is a common ancestor between REV1 and REV2 revisions." (when (and (not rev1) rev2) (error "Not a valid revision range")) (vc--with-backend-in-rootdir "VC root-diff" - (let ((default-directory rootdir) - (rev1 (vc-call-backend backend 'mergebase rev1 rev2))) + (let ((rev1 (vc-call-backend backend 'mergebase rev1 rev2))) (vc-diff-internal vc-allow-async-diff (list backend (list rootdir)) rev1 rev2 (called-interactively-p 'interactive))))) @@ -2548,8 +2546,7 @@ See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." (interactive (list (vc--maybe-read-remote-location))) (vc--with-backend-in-rootdir "VC root-diff" - (let ((default-directory rootdir) - (incoming (vc--incoming-revision backend + (let ((incoming (vc--incoming-revision backend (or remote-location "")))) (vc-diff-internal vc-allow-async-diff (list backend (list rootdir)) (vc-call-backend backend 'mergebase incoming) @@ -2572,8 +2569,7 @@ global binding." ;; (Hence why we don't call `vc-buffer-sync-fileset'.) (interactive (list (vc--maybe-read-remote-location))) (vc--with-backend-in-rootdir "VC root-diff" - (let ((default-directory rootdir) - (incoming (vc--incoming-revision backend + (let ((incoming (vc--incoming-revision backend (or remote-location "")))) (vc-diff-internal vc-allow-async-diff (list backend (list rootdir)) (vc-call-backend backend 'mergebase incoming) @@ -2674,8 +2670,7 @@ saving the buffer." ;; relative to it. Bind default-directory to the root directory ;; here, this way the *vc-diff* buffer is setup correctly, so ;; relative file names work. - (let ((default-directory rootdir) - (fileset `(,backend (,rootdir)))) + (let ((fileset `(,backend (,rootdir)))) (vc-buffer-sync-fileset fileset not-essential) (vc-diff-internal vc-allow-async-diff fileset nil nil (called-interactively-p 'interactive)))))) From da3973b657db46501e650fb4af4a4f3bb07c77fd Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 17 Aug 2025 11:36:13 +0100 Subject: [PATCH 008/158] VC: New commands for incoming and outgoing fileset diffs * lisp/vc/vc.el (vc-fileset-diff-incoming) (vc-fileset-diff-outgoing): New commands. (vc-root-diff-incoming): Refactor to call vc-fileset-diff-incoming. (vc-root-diff-outgoing): Refactor to call vc-fileset-diff-outgoing. * lisp/vc/vc-hooks.el (vc-incoming-prefix-map) (vc-outgoing-prefix-map): Bind the new commands. * doc/emacs/maintaining.texi (VC Change Log): * etc/NEWS: Document the new commands. --- doc/emacs/maintaining.texi | 31 +++++++++-- etc/NEWS | 12 +++-- lisp/vc/vc-hooks.el | 2 + lisp/vc/vc.el | 102 ++++++++++++++++++++++++------------- 4 files changed, 103 insertions(+), 44 deletions(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index ffa3b7f2a58..4e531805f26 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1070,11 +1070,18 @@ non-@code{nil}, @kbd{C-x v I} becomes a prefix key, and @code{vc-log-incoming} becomes bound to @kbd{C-x v I L}. @item M-x vc-root-diff-incoming -Display a diff of the changes that a pull operation will retrieve. +Display a diff of all changes that a pull operation will retrieve. If you customize @code{vc-use-incoming-outgoing-prefixes} to non-@code{nil}, this command becomes available on @kbd{C-x v I D}. +@item M-x vc-fileset-diff-incoming +Display a diff of changes that a pull operation will retrieve, but +limited to the current fileset. + +If you customize @code{vc-use-incoming-outgoing-prefixes} to +non-@code{nil}, this command becomes available on @kbd{C-x v I =}. + @item C-x v O Display log entries for the changes that will be sent by the next ``push'' operation (@code{vc-log-outgoing}). @@ -1084,12 +1091,19 @@ non-@code{nil}, @kbd{C-x v O} becomes a prefix key, and @code{vc-log-outgoing} becomes bound to @kbd{C-x v O L}. @item M-x vc-root-diff-outgoing -Display a diff of the changes that will be sent by the next push +Display a diff of all changes that will be sent by the next push operation. If you customize @code{vc-use-incoming-outgoing-prefixes} to non-@code{nil}, this command is bound to @kbd{C-x v O D}. +@item M-x vc-fileset-diff-outgoing +Display a diff of changes that will be sent by the next push operation, +but limited to the current fileset. + +If you customize @code{vc-use-incoming-outgoing-prefixes} to +non-@code{nil}, this command becomes available on @kbd{C-x v O =}. + @item C-x v h Display the history of changes made in the region of file visited by the current buffer (@code{vc-region-history}). @@ -1176,13 +1190,22 @@ version control system can be a branch name. @findex vc-root-diff-outgoing The closely related commands @code{vc-root-diff-incoming} and @code{vc-root-diff-outgoing} are the diff analogues of -@code{vc-log-incoming} and @code{vc-log-outgoing}. These display a diff -buffer reporting the changes that would be pulled or pushed. You can +@code{vc-log-incoming} and @code{vc-log-outgoing}. These display diff +buffers reporting the changes that would be pulled or pushed. You can use a prefix argument here too to specify a particular remote location. @code{vc-root-diff-outgoing} is useful as a way to preview your push and quickly check that all and only the changes you intended to include were committed and will be pushed. +@findex vc-fileset-diff-incoming +@findex vc-fileset-diff-outgoing + The commands @code{vc-fileset-diff-incoming} and +@code{vc-fileset-diff-outgoing} are very similar. They also display +changes that would be pulled or pushed. The difference is that the +diffs reported are limited to the current fileset. Don't forget that +actual pull and push operations always affect the whole working tree, +not just the current fileset. + @cindex VC log buffer, commands in @cindex vc-log buffer In the @file{*vc-change-log*} buffer, you can use the following keys diff --git a/etc/NEWS b/etc/NEWS index 4a193484591..ebf03b53e12 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2131,15 +2131,19 @@ relevant buffers before generating the contents of a VC Directory buffer (like the third-party package Magit does with its status buffer). +++ -*** New commands 'vc-root-diff-incoming' and 'vc-root-diff-outgoing'. -These commands report diffs of all the changes that would be pulled and -would be pushed, respectively. They are the diff analogues of the -existing commands 'vc-log-incoming' and 'vc-log-outgoing'. +*** New commands to report incoming and outgoing diffs. +'vc-root-diff-incoming' and 'vc-root-diff-outgoing' report diffs of all +the changes that would be pulled and would be pushed, respectively. +They are the diff analogues of the existing commands 'vc-log-incoming' +and 'vc-log-outgoing'. In particular, 'vc-root-diff-outgoing' is useful as a way to preview your push and ensure that all and only the changes you intended to include were committed and will be pushed. +'vc-fileset-diff-incoming' and 'vc-fileset-diff-outgoing' are similar +but limited to the current VC fileset. + +++ *** New user option 'vc-use-incoming-outgoing-prefixes'. If this is customized to non-nil, 'C-x v I' and 'C-x v O' become prefix diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 7d46f9f0ee3..e3b2d207156 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -976,9 +976,11 @@ In the latter case, VC mode is deactivated for this buffer." (defvar-keymap vc-incoming-prefix-map "L" #'vc-log-incoming + "=" #'vc-fileset-diff-incoming "D" #'vc-root-diff-incoming) (defvar-keymap vc-outgoing-prefix-map "L" #'vc-log-outgoing + "=" #'vc-fileset-diff-outgoing "D" #'vc-root-diff-outgoing) (defcustom vc-use-incoming-outgoing-prefixes nil diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 73f4f5d6f1d..6f8985dc0c9 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2546,12 +2546,27 @@ See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." (interactive (list (vc--maybe-read-remote-location))) (vc--with-backend-in-rootdir "VC root-diff" - (let ((incoming (vc--incoming-revision backend - (or remote-location "")))) - (vc-diff-internal vc-allow-async-diff (list backend (list rootdir)) - (vc-call-backend backend 'mergebase incoming) - incoming - (called-interactively-p 'interactive))))) + (vc-fileset-diff-incoming remote-location `(,backend (,rootdir))))) + +;;;###autoload +(defun vc-fileset-diff-incoming (&optional remote-location fileset) + "Report changes to VC fileset that would be pulled from REMOTE-LOCATION. +When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from. +When called interactively with a prefix argument, prompt for REMOTE-LOCATION. +In some version control systems REMOTE-LOCATION can be a remote branch name. +When called from Lisp optional argument FILESET overrides the VC fileset. + +See `vc-use-incoming-outgoing-prefixes' regarding giving this command a +global binding." + (interactive (list (vc--maybe-read-remote-location) nil)) + (let* ((fileset (or fileset (vc-deduce-fileset t))) + (backend (car fileset)) + (incoming (vc--incoming-revision backend + (or remote-location "")))) + (vc-diff-internal vc-allow-async-diff fileset + (vc-call-backend backend 'mergebase incoming) + incoming + (called-interactively-p 'interactive)))) ;;;###autoload (defun vc-root-diff-outgoing (&optional remote-location) @@ -2560,6 +2575,20 @@ When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. When called interactively with a prefix argument, prompt for REMOTE-LOCATION. In some version control systems REMOTE-LOCATION can be a remote branch name. +See `vc-use-incoming-outgoing-prefixes' regarding giving this command a +global binding." + (interactive (list (vc--maybe-read-remote-location))) + (vc--with-backend-in-rootdir "VC root-diff" + (vc-fileset-diff-outgoing remote-location `(,backend (,rootdir))))) + +;;;###autoload +(defun vc-fileset-diff-outgoing (&optional remote-location fileset) + "Report changes to VC fileset that would be pushed to REMOTE-LOCATION. +When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. +When called interactively with a prefix argument, prompt for REMOTE-LOCATION. +In some version control systems REMOTE-LOCATION can be a remote branch name. +When called from Lisp optional argument FILESET overrides the VC fileset. + See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." ;; For this command, for distributed VCS, we want to ignore @@ -2568,36 +2597,37 @@ global binding." ;; changes and remote committed changes. ;; (Hence why we don't call `vc-buffer-sync-fileset'.) (interactive (list (vc--maybe-read-remote-location))) - (vc--with-backend-in-rootdir "VC root-diff" - (let ((incoming (vc--incoming-revision backend - (or remote-location "")))) - (vc-diff-internal vc-allow-async-diff (list backend (list rootdir)) - (vc-call-backend backend 'mergebase incoming) - ;; FIXME: In order to exclude uncommitted - ;; changes we need to pass the most recent - ;; revision as REV2. Calling `working-revision' - ;; like this works for all the backends we have - ;; in core that implement `mergebase' and so can - ;; be used with this command (Git and Hg). - ;; However, it is not clearly permitted by the - ;; current semantics of `working-revision' to - ;; call it on a directory. - ;; - ;; A possible alternative would be something - ;; like this which effectively falls back to - ;; including uncommitted changes in the case of - ;; an older VCS or where the backend rejects our - ;; attempt to call `working-revision' on a - ;; directory: - ;; (and (eq (vc-call-backend backend - ;; 'revision-granularity) - ;; 'repository) - ;; (ignore-errors - ;; (vc-call-backend backend 'working-revision - ;; rootdir))) - (vc-call-backend backend 'working-revision - rootdir) - (called-interactively-p 'interactive))))) + (let* ((fileset (or fileset (vc-deduce-fileset t))) + (backend (car fileset)) + (incoming (vc--incoming-revision backend + (or remote-location "")))) + (vc-diff-internal vc-allow-async-diff fileset + (vc-call-backend backend 'mergebase incoming) + ;; FIXME: In order to exclude uncommitted + ;; changes we need to pass the most recent + ;; revision as REV2. Calling `working-revision' + ;; like this works for all the backends we have + ;; in core that implement `mergebase' and so can + ;; be used with this command (Git and Hg). + ;; However, it is not clearly permitted by the + ;; current semantics of `working-revision' to + ;; call it on a directory. + ;; + ;; A possible alternative would be something + ;; like this which effectively falls back to + ;; including uncommitted changes in the case of + ;; an older VCS or where the backend rejects our + ;; attempt to call `working-revision' on a + ;; directory: + ;; (and (eq (vc-call-backend backend + ;; 'revision-granularity) + ;; 'repository) + ;; (ignore-errors + ;; (vc-call-backend backend 'working-revision + ;; (car fileset))) + (vc-call-backend backend 'working-revision + (car fileset)) + (called-interactively-p 'interactive)))) (declare-function ediff-load-version-control "ediff" (&optional silent)) (declare-function ediff-vc-internal "ediff-vers" From 1f4e2e82649bb2a122b1406caf645ea06a933dc6 Mon Sep 17 00:00:00 2001 From: JD Smith <93749+jdtsmith@users.noreply.github.com> Date: Sun, 10 Aug 2025 17:17:47 -0400 Subject: [PATCH 009/158] Adapt tramp to new autoload-macro expand Bug #78995. * lisp/net/tramp-compat.el (tramp-loaddefs): suppress error on requiring tramp-loaddef. * lisp/net/tramp.el (tramp--with-startup): declare autoload-macro expand, and suppress warnings about this declare form on older versions of Emacs. --- lisp/net/tramp-compat.el | 2 +- lisp/net/tramp.el | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 9787e3a6553..5db8f1f61da 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -29,7 +29,7 @@ ;;; Code: -(require 'tramp-loaddefs) +(require 'tramp-loaddefs nil t) ; guard against load during autoload gen (require 'ansi-color) (require 'auth-source) (require 'format-spec) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 503b370cb3d..e80a470957f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -103,8 +103,15 @@ (put 'tramp--startup-hook 'tramp-suppress-trace t) + ;; TODO: once (autoload-macro expand) is available in all supported + ;; Emacs versions, this can be eliminated: + ;; backward compatibility for autoload-macro declare form + (unless (assq 'autoload-macro macro-declarations-alist) + (push '(autoload-macro ignore) macro-declarations-alist)) + (defmacro tramp--with-startup (&rest body) "Schedule BODY to be executed at the end of tramp.el." + (declare (autoload-macro expand)) `(add-hook 'tramp--startup-hook (lambda () ,@body))) (eval-and-compile From 888dc2a0b5e937ae8976ebef0f4b8091c0cd542c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 17 Aug 2025 16:48:35 +0200 Subject: [PATCH 010/158] Reject invalid error symbols (Bug#76447) * src/eval.c (signal_or_quit): Signal an error if 'signal' gets called with an invalid error symbol. --- src/eval.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/eval.c b/src/eval.c index 0d4ae91136e..2dc14b6d431 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1948,6 +1948,8 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) } conditions = Fget (real_error_symbol, Qerror_conditions); + if (NILP (conditions)) + signal_error ("Invalid error symbol", error_symbol); /* Remember from where signal was called. Skip over the frame for `signal' itself. If a frame for `error' follows, skip that, From bf652e6844601bb42daaac2ed867e047f2eb615f Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 18 Aug 2025 09:49:36 +0300 Subject: [PATCH 011/158] Silence byte-compile warnings when treesit is not available * lisp/progmodes/c-ts-mode.el: * lisp/progmodes/cmake-ts-mode.el: * lisp/progmodes/csharp-mode.el: * lisp/progmodes/dockerfile-ts-mode.el: * lisp/progmodes/elixir-ts-mode.el: * lisp/progmodes/go-ts-mode.el: * lisp/progmodes/heex-ts-mode.el: * lisp/progmodes/java-ts-mode.el: * lisp/progmodes/js.el: * lisp/progmodes/json-ts-mode.el: * lisp/progmodes/lua-ts-mode.el: * lisp/progmodes/php-ts-mode.el: * lisp/progmodes/ruby-ts-mode.el: * lisp/progmodes/rust-ts-mode.el: * lisp/progmodes/sh-script.el: * lisp/progmodes/typescript-ts-mode.el: * lisp/textmodes/css-mode.el: * lisp/textmodes/markdown-ts-mode.el: * lisp/textmodes/mhtml-ts-mode.el: * lisp/textmodes/toml-ts-mode.el: * lisp/textmodes/yaml-ts-mode.el: Declare 'treesit-major-mode-remap-alist' and 'treesit-language-available-p' to silence warnings that are false alarms. Also improve docstrings. --- lisp/progmodes/c-ts-mode.el | 1 + lisp/progmodes/cmake-ts-mode.el | 6 +++++- lisp/progmodes/csharp-mode.el | 1 + lisp/progmodes/dockerfile-ts-mode.el | 6 +++++- lisp/progmodes/elixir-ts-mode.el | 6 +++++- lisp/progmodes/go-ts-mode.el | 18 +++++++++++++++--- lisp/progmodes/heex-ts-mode.el | 6 +++++- lisp/progmodes/java-ts-mode.el | 1 + lisp/progmodes/js.el | 1 + lisp/progmodes/json-ts-mode.el | 1 + lisp/progmodes/lua-ts-mode.el | 6 +++++- lisp/progmodes/php-ts-mode.el | 6 +++++- lisp/progmodes/ruby-ts-mode.el | 1 + lisp/progmodes/rust-ts-mode.el | 6 +++++- lisp/progmodes/sh-script.el | 1 + lisp/progmodes/typescript-ts-mode.el | 12 ++++++++++-- lisp/textmodes/css-mode.el | 1 + lisp/textmodes/markdown-ts-mode.el | 6 +++++- lisp/textmodes/mhtml-ts-mode.el | 1 + lisp/textmodes/toml-ts-mode.el | 1 + lisp/textmodes/yaml-ts-mode.el | 6 +++++- 21 files changed, 80 insertions(+), 14 deletions(-) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 55240c3869a..174eb47cb3a 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1675,6 +1675,7 @@ the code is C or C++, and based on that chooses whether to enable ;;;###autoload (when (treesit-available-p) + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(c-mode . c-ts-mode)) (add-to-list 'treesit-major-mode-remap-alist diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index 3f879e37ba2..84589b1eb73 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -257,7 +257,10 @@ Return nil if there is no name or if NODE is not a defun node." ;;;###autoload (defun cmake-ts-mode-maybe () - "Enable `cmake-ts-mode' when its grammar is available." + "Enable `cmake-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name." + (declare-function treesit-language-available-p "treesit.c") (if (or (treesit-language-available-p 'cmake) (eq treesit-enabled-modes t) (memq 'cmake-ts-mode treesit-enabled-modes)) @@ -269,6 +272,7 @@ Return nil if there is no name or if NODE is not a defun node." (add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode-maybe)) ;; To be able to toggle between an external package and core ts-mode: + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(cmake-mode . cmake-ts-mode))) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index fb05389ba91..2ef97ccc687 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -1225,6 +1225,7 @@ Key bindings: ;;;###autoload (when (treesit-available-p) + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(csharp-mode . csharp-ts-mode))) diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index 79a2197c078..40259792b52 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -204,7 +204,10 @@ Return nil if there is no name or if NODE is not a stage node." ;;;###autoload (defun dockerfile-ts-mode-maybe () - "Enable `dockerfile-ts-mode' when its grammar is available." + "Enable `dockerfile-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name." + (declare-function treesit-language-available-p "treesit.c") (if (or (treesit-language-available-p 'dockerfile) (eq treesit-enabled-modes t) (memq 'dockerfile-ts-mode treesit-enabled-modes)) @@ -218,6 +221,7 @@ Return nil if there is no name or if NODE is not a stage node." '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . dockerfile-ts-mode-maybe)) ;; To be able to toggle between an external package and core ts-mode: + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(dockerfile-mode . dockerfile-ts-mode))) diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index 05ad76d100f..04227599630 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -808,7 +808,10 @@ Return nil if NODE is not a defun node or doesn't have a name." ;;;###autoload (defun elixir-ts-mode-maybe () - "Enable `elixir-ts-mode' when its grammar is available." + "Enable `elixir-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name." + (declare-function treesit-language-available-p "treesit.c") (if (or (treesit-language-available-p 'elixir) (eq treesit-enabled-modes t) (memq 'elixir-ts-mode treesit-enabled-modes)) @@ -822,6 +825,7 @@ Return nil if NODE is not a defun node or doesn't have a name." (add-to-list 'auto-mode-alist '("\\.exs\\'" . elixir-ts-mode-maybe)) (add-to-list 'auto-mode-alist '("mix\\.lock" . elixir-ts-mode-maybe)) ;; To be able to toggle between an external package and core ts-mode: + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(elixir-mode . elixir-ts-mode))) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 40f3de0bc15..e149e9230ec 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -361,7 +361,10 @@ ;;;###autoload (defun go-ts-mode-maybe () - "Enable `go-ts-mode' when its grammar is available." + "Enable `go-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name." + (declare-function treesit-language-available-p "treesit.c") (if (or (treesit-language-available-p 'go) (eq treesit-enabled-modes t) (memq 'go-ts-mode treesit-enabled-modes)) @@ -372,6 +375,7 @@ (when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode-maybe)) ;; To be able to toggle between an external package and core ts-mode: + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(go-mode . go-ts-mode))) @@ -635,7 +639,10 @@ what the parent of the node would be if it were a node." ;;;###autoload (defun go-mod-ts-mode-maybe () - "Enable `go-mod-ts-mode' when its grammar is available." + "Enable `go-mod-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name." + (declare-function treesit-language-available-p "treesit.c") (if (or (treesit-language-available-p 'gomod) (eq treesit-enabled-modes t) (memq 'go-mod-ts-mode treesit-enabled-modes)) @@ -646,6 +653,7 @@ what the parent of the node would be if it were a node." (when (treesit-available-p) (add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode-maybe)) ;; To be able to toggle between an external package and core ts-mode: + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(go-mod-mode . go-mod-ts-mode))) @@ -736,7 +744,10 @@ what the parent of the node would be if it were a node." ;;;###autoload (defun go-work-ts-mode-maybe () - "Enable `go-work-ts-mode' when its grammar is available." + "Enable `go-work-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name." + (declare-function treesit-language-available-p "treesit.c") (if (or (treesit-language-available-p 'gowork) (eq treesit-enabled-modes t) (memq 'go-work-ts-mode treesit-enabled-modes)) @@ -747,6 +758,7 @@ what the parent of the node would be if it were a node." (when (treesit-available-p) (add-to-list 'auto-mode-alist '("/go\\.work\\'" . go-work-ts-mode-maybe)) ;; To be able to toggle between an external package and core ts-mode: + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(go-work-mode . go-work-ts-mode))) diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el index 41634d0e6a4..2b8b75c444e 100644 --- a/lisp/progmodes/heex-ts-mode.el +++ b/lisp/progmodes/heex-ts-mode.el @@ -267,7 +267,10 @@ Return nil if NODE is not a defun node or doesn't have a name." ;;;###autoload (defun heex-ts-mode-maybe () - "Enable `heex-ts-mode' when its grammar is available." + "Enable `heex-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name." + (declare-function treesit-language-available-p "treesit.c") (if (or (treesit-language-available-p 'heex) (eq treesit-enabled-modes t) (memq 'heex-ts-mode treesit-enabled-modes)) @@ -280,6 +283,7 @@ Return nil if NODE is not a defun node or doesn't have a name." ;; with the tree-sitter-heex grammar. (add-to-list 'auto-mode-alist '("\\.[hl]?eex\\'" . heex-ts-mode-maybe)) ;; To be able to toggle between an external package and core ts-mode: + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(heex-mode . heex-ts-mode))) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index e989d1b3f5d..979f5456c6d 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -526,6 +526,7 @@ Return nil if there is no name or if NODE is not a defun node." ;;;###autoload (when (treesit-available-p) + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(java-mode . java-ts-mode))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index c44b2adf146..1e4c832254c 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4111,6 +4111,7 @@ See `treesit-thing-settings' for more information.") ;;;###autoload (when (treesit-available-p) + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(javascript-mode . js-ts-mode))) diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index b0db0a12210..a08e9a29fe8 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -183,6 +183,7 @@ Return nil if there is no name or if NODE is not a defun node." ;;;###autoload (when (treesit-available-p) + (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(js-json-mode . json-ts-mode))) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 07a8f0aef55..5089e17c287 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -771,7 +771,10 @@ Calls REPORT-FN directly." ;;;###autoload (defun lua-ts-mode-maybe () - "Enable `lua-ts-mode' when its grammar is available." + "Enable `lua-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name." + (declare-function treesit-language-available-p "treesit.c") (if (or (treesit-language-available-p 'lua) (eq treesit-enabled-modes t) (memq 'lua-ts-mode treesit-enabled-modes)) @@ -783,6 +786,7 @@ Calls REPORT-FN directly." (add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-ts-mode-maybe)) (add-to-list 'interpreter-mode-alist '("\\ Date: Mon, 18 Aug 2025 11:23:26 +0200 Subject: [PATCH 012/158] Catch all non-local exits when running ERT tests. See discussion in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=76447. * lisp/emacs-lisp/ert.el (ert--run-test-internal): Catch all non-local exits in 'handler-bind'. --- lisp/emacs-lisp/ert.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index cf21af8f101..1ebddf98fe4 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -813,7 +813,7 @@ This mainly sets up debugger-related bindings." (letrec ((debugfun (lambda (err) (ert--run-test-debugger test-execution-info err debugfun)))) - (handler-bind (((error quit) debugfun)) + (handler-bind ((t debugfun)) (funcall (ert-test-body (ert--test-execution-info-test test-execution-info)))))))) (ert-pass)) From 4204a9572a9fd84f92a1bcd78d1cfaaa9b8550ae Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 19 Aug 2025 09:48:29 +0300 Subject: [PATCH 013/158] ; * lisp/vc/vc.el (vc--maybe-read-remote-location): Fix args of read-string. --- lisp/vc/vc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 6f8985dc0c9..95b8a6f3a23 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3474,7 +3474,7 @@ The command prompts for the branch whose change log to show." (defun vc--maybe-read-remote-location () (and current-prefix-arg - (read-string "Remote location/branch (empty for default): " + (read-string "Remote location/branch (empty for default): " nil 'vc-remote-location-history))) (defun vc--incoming-revision (backend remote-location) From d40c7549297bd08be09b72debe35c0b1bf345cea Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 19 Aug 2025 11:09:46 +0200 Subject: [PATCH 014/158] Clarify that sequence/map functions don't alter their argument * lisp/emacs-lisp/seq.el (seq-sort, seq-sort-by, seq-reverse) (seq-concatenate, seq-into-sequence, seq-into, seq-filter, seq-remove) (seq-remove-at-position, seq-reduce, seq-find, seq-uniq, seq-mapcat) (seq-partition, seq-union, seq-intersection, seq-difference) (seq-group-by, seq-split, seq-keep): * lisp/emacs-lisp/map.el (map-filter, map-remove, map-merge) (map-merge-with): Clarify that these functions don't modify their sequence/map arguments. --- lisp/emacs-lisp/map.el | 12 ++++++--- lisp/emacs-lisp/seq.el | 58 ++++++++++++++++++++++++++++-------------- 2 files changed, 47 insertions(+), 23 deletions(-) diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index deeeec132cf..1e88630959d 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -350,7 +350,8 @@ The default implementation delegates to `map-apply'." (cl-defgeneric map-filter (pred map) "Return an alist of key/val pairs for which (PRED key val) is non-nil in MAP. -The default implementation delegates to `map-apply'." +The default implementation delegates to `map-apply'. +This does not modify MAP." (delq nil (map-apply (lambda (key val) (and (funcall pred key val) (cons key val))) @@ -358,7 +359,8 @@ The default implementation delegates to `map-apply'." (cl-defgeneric map-remove (pred map) "Return an alist of the key/val pairs for which (PRED key val) is nil in MAP. -The default implementation delegates to `map-filter'." +The default implementation delegates to `map-filter'. +This does not modify MAP." (map-filter (lambda (key val) (not (funcall pred key val))) map)) @@ -457,7 +459,8 @@ MAP may be of a type other than TYPE." (defun map-merge (type &rest maps) "Merge into a map of TYPE all the key/value pairs in MAPS. -See `map-into' for all supported values of TYPE." +See `map-into' for all supported values of TYPE. +This does not modify any of the MAPS." (apply #'map--merge (lambda (result key value) (setf (map-elt result key) value) @@ -469,7 +472,8 @@ See `map-into' for all supported values of TYPE." When two maps contain the same key, call FUNCTION on the two values and use the value FUNCTION returns. Each of MAPS can be an alist, plist, hash-table, or array. -See `map-into' for all supported values of TYPE." +See `map-into' for all supported values of TYPE. +This does not modify any of the MAPS." (let ((not-found (list nil))) (apply #'map--merge (lambda (result key value) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index a7954e7614c..d8ffdb1fa20 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -274,7 +274,8 @@ Value is a sequence of the same type as SEQUENCE." (cl-defgeneric seq-sort (pred sequence) "Sort SEQUENCE using PRED as the sorting comparison function. -The result is a sequence of the same type as SEQUENCE." +The result is a sequence of the same type as SEQUENCE. The sort +operates on a copy of SEQUENCE and does not modify SEQUENCE." (let ((result (seq-sort pred (append sequence nil)))) (seq-into result (type-of sequence)))) @@ -285,7 +286,8 @@ The result is a sequence of the same type as SEQUENCE." (defun seq-sort-by (function pred sequence) "Sort SEQUENCE transformed by FUNCTION using PRED as the comparison function. Elements of SEQUENCE are transformed by FUNCTION before being -sorted. FUNCTION must be a function of one argument." +sorted. FUNCTION must be a function of one argument. The sort +operates on a copy of SEQUENCE and does not modify SEQUENCE." (seq-sort (lambda (a b) (funcall pred (funcall function a) @@ -293,7 +295,8 @@ sorted. FUNCTION must be a function of one argument." sequence)) (cl-defgeneric seq-reverse (sequence) - "Return a sequence with elements of SEQUENCE in reverse order." + "Return a sequence with elements of SEQUENCE in reverse order. +This does not modify SEQUENCE." (let ((result '())) (seq-map (lambda (elt) (push elt result)) @@ -307,6 +310,7 @@ sorted. FUNCTION must be a function of one argument." (cl-defgeneric seq-concatenate (type &rest sequences) "Concatenate SEQUENCES into a single sequence of type TYPE. TYPE must be one of following symbols: `vector', `string' or `list'. +This does not modify any of the SEQUENCES. \n(fn TYPE SEQUENCE...)" (setq sequences (mapcar #'seq-into-sequence sequences)) @@ -321,7 +325,9 @@ TYPE must be one of following symbols: `vector', `string' or `list'. The default implementation is to signal an error if SEQUENCE is not a sequence, specific functions should be implemented for new types -of sequence." +of sequence. + +This does not modify SEQUENCE." (unless (sequencep sequence) (error "Cannot convert %S into a sequence" sequence)) sequence) @@ -329,7 +335,7 @@ of sequence." (cl-defgeneric seq-into (sequence type) "Concatenate the elements of SEQUENCE into a sequence of type TYPE. TYPE can be one of the following symbols: `vector', `string' or -`list'." +`list'. This does not modify SEQUENCE." (pcase type (`vector (seq--into-vector sequence)) (`string (seq--into-string sequence)) @@ -338,7 +344,8 @@ TYPE can be one of the following symbols: `vector', `string' or ;;;###autoload (cl-defgeneric seq-filter (pred sequence) - "Return a list of all the elements in SEQUENCE for which PRED returns non-nil." + "Return a list of all the elements in SEQUENCE for which PRED returns non-nil. +This does not modify SEQUENCE." (let ((exclude (make-symbol "exclude"))) (delq exclude (seq-map (lambda (elt) (if (funcall pred elt) @@ -348,7 +355,8 @@ TYPE can be one of the following symbols: `vector', `string' or ;;;###autoload (cl-defgeneric seq-remove (pred sequence) - "Return a list of all the elements in SEQUENCE for which PRED returns nil." + "Return a list of all the elements in SEQUENCE for which PRED returns nil. +This does not modify SEQUENCE." (seq-filter (lambda (elt) (not (funcall pred elt))) sequence)) @@ -359,7 +367,8 @@ TYPE can be one of the following symbols: `vector', `string' or N is the (zero-based) index of the element that should not be in the result. -The result is a sequence of the same type as SEQUENCE." +The result is a sequence of the same type as SEQUENCE. +This does not modify SEQUENCE." (seq-concatenate (if (listp sequence) 'list (type-of sequence)) (seq-subseq sequence 0 n) @@ -376,7 +385,9 @@ third element of SEQUENCE, etc. FUNCTION will be called with INITIAL-VALUE (and then the accumulated value) as the first argument, and the elements from SEQUENCE as the second argument. -If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called." +If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called. + +This does not modify SEQUENCE." (if (seq-empty-p sequence) initial-value (let ((acc initial-value)) @@ -411,7 +422,9 @@ If no such element is found, return DEFAULT. Note that `seq-find' has an ambiguity if the found element is identical to DEFAULT, as in that case it is impossible to know -whether an element was found or not." +whether an element was found or not. + +This does not modify SEQUENCE." (catch 'seq--break (seq-doseq (elt sequence) (when (funcall pred elt) @@ -485,7 +498,8 @@ The result is a list of (zero-based) indices." ;;;###autoload (cl-defgeneric seq-uniq (sequence &optional testfn) "Return a list of the elements of SEQUENCE with duplicates removed. -TESTFN is used to compare elements, and defaults to `equal'." +TESTFN is used to compare elements, and defaults to `equal'. +This does not modify SEQUENCE." (let ((result '())) (seq-doseq (elt sequence) (unless (seq-contains-p result elt testfn) @@ -521,14 +535,16 @@ TESTFN is used to compare elements, and defaults to `equal'." (cl-defgeneric seq-mapcat (function sequence &optional type) "Concatenate the results of applying FUNCTION to each element of SEQUENCE. -The result is a sequence of type TYPE; TYPE defaults to `list'." +The result is a sequence of type TYPE; TYPE defaults to `list'. +This does not modify SEQUENCE." (apply #'seq-concatenate (or type 'list) (seq-map function sequence))) (cl-defgeneric seq-partition (sequence n) "Return list of elements of SEQUENCE grouped into sub-sequences of length N. The last sequence may contain less than N elements. If N is a -negative integer or 0, the function returns nil." +negative integer or 0, the function returns nil. +This does not modify SEQUENCE." (unless (< n 1) (let ((result '())) (while (not (seq-empty-p sequence)) @@ -540,7 +556,8 @@ negative integer or 0, the function returns nil." (cl-defgeneric seq-union (sequence1 sequence2 &optional testfn) "Return a list of all the elements that appear in either SEQUENCE1 or SEQUENCE2. \"Equality\" of elements is defined by the function TESTFN, which -defaults to `equal'." +defaults to `equal'. +This does not modify SEQUENCE1 or SEQUENCE2." (let* ((accum (lambda (acc elt) (if (seq-contains-p acc elt testfn) acc @@ -553,7 +570,8 @@ defaults to `equal'." (cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn) "Return a list of all the elements that appear in both SEQUENCE1 and SEQUENCE2. \"Equality\" of elements is defined by the function TESTFN, which -defaults to `equal'." +defaults to `equal'. +This does not modify SEQUENCE1 or SEQUENCE2." (seq-reduce (lambda (acc elt) (if (seq-contains-p sequence2 elt testfn) (cons elt acc) @@ -564,7 +582,8 @@ defaults to `equal'." (cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn) "Return list of all the elements that appear in SEQUENCE1 but not in SEQUENCE2. \"Equality\" of elements is defined by the function TESTFN, which -defaults to `equal'." +defaults to `equal'. +This does not modify SEQUENCE1 or SEQUENCE2." (seq-reduce (lambda (acc elt) (if (seq-contains-p sequence2 elt testfn) acc @@ -576,7 +595,7 @@ defaults to `equal'." (cl-defgeneric seq-group-by (function sequence) "Apply FUNCTION to each element of SEQUENCE. Separate the elements of SEQUENCE into an alist using the results as -keys. Keys are compared using `equal'." +keys. Keys are compared using `equal'. This does not modify SEQUENCE." (seq-reduce (lambda (acc elt) (let* ((key (funcall function elt)) @@ -692,7 +711,7 @@ Signal an error if SEQUENCE is empty." (defun seq-split (sequence length) "Split SEQUENCE into a list of sub-sequences of at most LENGTH elements. All the sub-sequences will be LENGTH long, except the last one, -which may be shorter." +which may be shorter. This does not modify SEQUENCE." (when (< length 1) (error "Sub-sequence length must be larger than zero")) (let ((result nil) @@ -705,7 +724,8 @@ which may be shorter." (nreverse result))) (defun seq-keep (function sequence) - "Apply FUNCTION to SEQUENCE and return the list of all the non-nil results." + "Apply FUNCTION to SEQUENCE and return the list of all the non-nil results. +This does not modify SEQUENCE." (delq nil (seq-map function sequence))) (provide 'seq) From e92da50e057787c6ebbe0f4eb6ced3b2bc8d5bc4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gerd=20M=C3=B6llmann?= Date: Tue, 19 Aug 2025 13:02:34 +0200 Subject: [PATCH 015/158] ; Pacify byte-compiler * lisp/progmodes/eglot.el (eglot--managed-mode): Use revert-buffer-in-progress instead of revert-buffer-in-progress-p. * lisp/vc/vc-hooks.el (vc-dir-resynch-file): Declare some functions. --- lisp/progmodes/eglot.el | 2 +- lisp/vc/vc-hooks.el | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 4a7c525003c..96391ca8dfe 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2242,7 +2242,7 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (when (and eglot-autoshutdown (null (eglot--managed-buffers server)) ;; Don't shutdown if up again soon. - (not revert-buffer-in-progress-p)) + (not revert-buffer-in-progress)) (eglot-shutdown server))))))) (defun eglot--managed-mode-off () diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index e3b2d207156..53602491cad 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -687,6 +687,9 @@ Before doing that, check if there are any old backups and get rid of them." (vc-make-version-backup file))))) (declare-function vc-dir-resynch-file "vc-dir" (&optional fname)) +(declare-function vc-fileset-diff-outgoing "vc" (&optional remote-location fileset)) +(declare-function vc-fileset-diff-incoming "vc" (&optional remote-location fileset)) +(declare-function vc-working-tree-switch-project "vc" (dir)) (defvar vc-dir-buffers nil "List of `vc-dir' buffers.") From ab577467e4feb681246a8d28afde729c6040dfc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gerd=20M=C3=B6llmann?= Date: Tue, 19 Aug 2025 14:43:58 +0200 Subject: [PATCH 016/158] ; Revert last change in eglot * lisp/progmodes/eglot.el (eglot--managed-mode): Use revert-buffer-in-progress-p again. --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 96391ca8dfe..4a7c525003c 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2242,7 +2242,7 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (when (and eglot-autoshutdown (null (eglot--managed-buffers server)) ;; Don't shutdown if up again soon. - (not revert-buffer-in-progress)) + (not revert-buffer-in-progress-p)) (eglot-shutdown server))))))) (defun eglot--managed-mode-off () From 63662f6ceeb7644d24cbd8b50c8bd8d0c19e79ed Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 8 Apr 2025 17:13:08 -0400 Subject: [PATCH 017/158] Signal end-of-file with more correct data end_of_file_error previously always signaled end-of-file with load-true-file-name if that was non-nil (and a string). However, this might be the wrong thing to do; for example, if a file being loaded calls read on a buffer. * src/lread.c (end_of_file_error): : New argument; check it to determine what data to signal with. (bug#68546) (read_char_escape, read_char_literal, read_string_literal) (skip_space_and_comments, read0): Pass source to end_of_file_error. --- src/lread.c | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/lread.c b/src/lread.c index 57d3239e283..80172dbe7c8 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2114,12 +2114,16 @@ build_load_history (Lisp_Object filename, bool entire) information. */ static AVOID -end_of_file_error (void) +end_of_file_error (source_t *source) { - if (STRINGP (Vload_true_file_name)) + if (from_file_p (source)) + /* Only Fload calls read on a file, and Fload always binds + load-true-file-name around the call. */ xsignal1 (Qend_of_file, Vload_true_file_name); - - xsignal0 (Qend_of_file); + else if (source->get == source_buffer_get) + xsignal1 (Qend_of_file, source->object); + else + xsignal0 (Qend_of_file); } static Lisp_Object @@ -2604,7 +2608,7 @@ read_char_escape (source_t *source, int next_char) switch (c) { case -1: - end_of_file_error (); + end_of_file_error (source); case 'a': chr = '\a'; break; case 'b': chr = '\b'; break; @@ -2777,7 +2781,7 @@ read_char_escape (source_t *source, int next_char) { int c = readchar (source); if (c < 0) - end_of_file_error (); + end_of_file_error (source); if (c == '}') break; if (c >= 0x80) @@ -2819,7 +2823,7 @@ read_char_escape (source_t *source, int next_char) break; } if (chr < 0) - end_of_file_error (); + end_of_file_error (source); eassert (chr >= 0 && chr < (1 << CHARACTERBITS)); /* Apply Control modifiers, using the rules: @@ -2982,7 +2986,7 @@ read_char_literal (source_t *source) { int ch = readchar (source); if (ch < 0) - end_of_file_error (); + end_of_file_error (source); /* Accept `single space' syntax like (list ? x) where the whitespace character is SPC or TAB. @@ -3118,7 +3122,7 @@ read_string_literal (source_t *source) } if (ch < 0) - end_of_file_error (); + end_of_file_error (source); if (!force_multibyte && force_singlebyte) { @@ -3548,7 +3552,7 @@ skip_space_and_comments (source_t *source) c = readchar (source); while (c >= 0 && c != '\n'); if (c < 0) - end_of_file_error (); + end_of_file_error (source); } while (c <= 32 || c == NO_BREAK_SPACE); unreadchar (source, c); @@ -3734,7 +3738,7 @@ read0 (source_t *source, bool locate_syms) Lisp_Object obj; int c = readchar (source); if (c < 0) - end_of_file_error (); + end_of_file_error (source); switch (c) { @@ -4151,7 +4155,7 @@ read0 (source_t *source, bool locate_syms) { c = readchar (source); if (c < 0) - end_of_file_error (); + end_of_file_error (source); quoted = true; } From 218fc1cc04fa4af4182e076668fc6ebe6967f286 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 19 Aug 2025 19:18:28 +0300 Subject: [PATCH 018/158] ; * lisp/progmodes/eglot.el (eglot--managed-mode): Pacify byte-compiler. --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 4a7c525003c..29e6c269fdf 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2242,7 +2242,7 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (when (and eglot-autoshutdown (null (eglot--managed-buffers server)) ;; Don't shutdown if up again soon. - (not revert-buffer-in-progress-p)) + (with-no-warnings (not revert-buffer-in-progress-p))) (eglot-shutdown server))))))) (defun eglot--managed-mode-off () From c60db19ee2376b5f8fab667511144d902108d976 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 20 Aug 2025 13:11:14 +0100 Subject: [PATCH 019/158] Rename some incoming & outgoing diff commands * lisp/vc/vc.el (vc-fileset-diff-incoming) (vc-fileset-diff-outgoing): Rename to ... (vc-diff-incoming, vc-diff-outgoing): ... these. All uses changed. --- doc/emacs/maintaining.texi | 19 +++++++++---------- etc/NEWS | 4 ++-- lisp/vc/vc-hooks.el | 8 ++++---- lisp/vc/vc.el | 8 ++++---- 4 files changed, 19 insertions(+), 20 deletions(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 4e531805f26..3de00fe8684 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1075,7 +1075,7 @@ Display a diff of all changes that a pull operation will retrieve. If you customize @code{vc-use-incoming-outgoing-prefixes} to non-@code{nil}, this command becomes available on @kbd{C-x v I D}. -@item M-x vc-fileset-diff-incoming +@item M-x vc-diff-incoming Display a diff of changes that a pull operation will retrieve, but limited to the current fileset. @@ -1097,7 +1097,7 @@ operation. If you customize @code{vc-use-incoming-outgoing-prefixes} to non-@code{nil}, this command is bound to @kbd{C-x v O D}. -@item M-x vc-fileset-diff-outgoing +@item M-x vc-diff-outgoing Display a diff of changes that will be sent by the next push operation, but limited to the current fileset. @@ -1197,14 +1197,13 @@ use a prefix argument here too to specify a particular remote location. quickly check that all and only the changes you intended to include were committed and will be pushed. -@findex vc-fileset-diff-incoming -@findex vc-fileset-diff-outgoing - The commands @code{vc-fileset-diff-incoming} and -@code{vc-fileset-diff-outgoing} are very similar. They also display -changes that would be pulled or pushed. The difference is that the -diffs reported are limited to the current fileset. Don't forget that -actual pull and push operations always affect the whole working tree, -not just the current fileset. +@findex vc-diff-incoming +@findex vc-diff-outgoing + The commands @code{vc-diff-incoming} and @code{vc-diff-outgoing} are +very similar. They also display changes that would be pulled or pushed. +The difference is that the diffs reported are limited to the current +fileset. Don't forget that actual pull and push operations always +affect the whole working tree, not just the current fileset. @cindex VC log buffer, commands in @cindex vc-log buffer diff --git a/etc/NEWS b/etc/NEWS index ebf03b53e12..f45ee437bf9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2141,8 +2141,8 @@ In particular, 'vc-root-diff-outgoing' is useful as a way to preview your push and ensure that all and only the changes you intended to include were committed and will be pushed. -'vc-fileset-diff-incoming' and 'vc-fileset-diff-outgoing' are similar -but limited to the current VC fileset. +'vc-diff-incoming' and 'vc-diff-outgoing' are similar but limited to the +current VC fileset. +++ *** New user option 'vc-use-incoming-outgoing-prefixes'. diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 53602491cad..e4c174ed859 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -687,8 +687,8 @@ Before doing that, check if there are any old backups and get rid of them." (vc-make-version-backup file))))) (declare-function vc-dir-resynch-file "vc-dir" (&optional fname)) -(declare-function vc-fileset-diff-outgoing "vc" (&optional remote-location fileset)) -(declare-function vc-fileset-diff-incoming "vc" (&optional remote-location fileset)) +(declare-function vc-diff-outgoing "vc" (&optional remote-location fileset)) +(declare-function vc-diff-incoming "vc" (&optional remote-location fileset)) (declare-function vc-working-tree-switch-project "vc" (dir)) (defvar vc-dir-buffers nil "List of `vc-dir' buffers.") @@ -979,11 +979,11 @@ In the latter case, VC mode is deactivated for this buffer." (defvar-keymap vc-incoming-prefix-map "L" #'vc-log-incoming - "=" #'vc-fileset-diff-incoming + "=" #'vc-diff-incoming "D" #'vc-root-diff-incoming) (defvar-keymap vc-outgoing-prefix-map "L" #'vc-log-outgoing - "=" #'vc-fileset-diff-outgoing + "=" #'vc-diff-outgoing "D" #'vc-root-diff-outgoing) (defcustom vc-use-incoming-outgoing-prefixes nil diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 95b8a6f3a23..9634b06a40e 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2546,10 +2546,10 @@ See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." (interactive (list (vc--maybe-read-remote-location))) (vc--with-backend-in-rootdir "VC root-diff" - (vc-fileset-diff-incoming remote-location `(,backend (,rootdir))))) + (vc-diff-incoming remote-location `(,backend (,rootdir))))) ;;;###autoload -(defun vc-fileset-diff-incoming (&optional remote-location fileset) +(defun vc-diff-incoming (&optional remote-location fileset) "Report changes to VC fileset that would be pulled from REMOTE-LOCATION. When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from. When called interactively with a prefix argument, prompt for REMOTE-LOCATION. @@ -2579,10 +2579,10 @@ See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." (interactive (list (vc--maybe-read-remote-location))) (vc--with-backend-in-rootdir "VC root-diff" - (vc-fileset-diff-outgoing remote-location `(,backend (,rootdir))))) + (vc-diff-outgoing remote-location `(,backend (,rootdir))))) ;;;###autoload -(defun vc-fileset-diff-outgoing (&optional remote-location fileset) +(defun vc-diff-outgoing (&optional remote-location fileset) "Report changes to VC fileset that would be pushed to REMOTE-LOCATION. When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. When called interactively with a prefix argument, prompt for REMOTE-LOCATION. From 0c277ad022c9aae0b34eb090583f2eb7f9974e84 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gerd=20M=C3=B6llmann?= Date: Wed, 20 Aug 2025 14:52:18 +0200 Subject: [PATCH 020/158] ; Remove declarations introduced in e92da50e057 --- lisp/vc/vc-hooks.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index e4c174ed859..cfca7b4662e 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -687,9 +687,6 @@ Before doing that, check if there are any old backups and get rid of them." (vc-make-version-backup file))))) (declare-function vc-dir-resynch-file "vc-dir" (&optional fname)) -(declare-function vc-diff-outgoing "vc" (&optional remote-location fileset)) -(declare-function vc-diff-incoming "vc" (&optional remote-location fileset)) -(declare-function vc-working-tree-switch-project "vc" (dir)) (defvar vc-dir-buffers nil "List of `vc-dir' buffers.") From 55f7f00f91677153ef5afcc586e44ea159817dcf Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 20 Aug 2025 18:14:37 +0200 Subject: [PATCH 021/158] Change default of tramp-debug-buffer-limit MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/net/tramp-message.el (tramp-debug-buffer-limit): Change default to 100MB. Suggested by Francesco Potortì . --- lisp/net/tramp-message.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index 7f66f7d8087..a328183e184 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -94,7 +94,7 @@ This increases `tramp-verbose' to 6 if necessary." :type 'boolean :link '(info-link :tag "Tramp manual" "(tramp) Traces and Profiles")) -(defcustom tramp-debug-buffer-limit (* 3 1024 1024 1024) ;3GB +(defcustom tramp-debug-buffer-limit (* 100 1024 1024) ;100MB "The upper limit of a Tramp debug buffer. If the size of a debug buffer exceeds this limit, a warning is raised. Set it to 0 if there is no limit." From 6eb6ef3d0c731f180b588088a100b190848f24b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gerd=20M=C3=B6llmann?= Date: Wed, 20 Aug 2025 17:40:06 +0100 Subject: [PATCH 022/158] ; Makefile.in: Fix ldefs-boot.el rule for BSD sed. --- lisp/Makefile.in | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 17182357739..9dacf766108 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -212,7 +212,8 @@ autoloads-force: $(MAKE) autoloads ldefs-boot.el: autoloads-force - sed '/^;; Local Variables:/a ;; no-byte-compile: t'\ + sed '/^;; Local Variables:/a\ +;; no-byte-compile: t'\ < $(lisp)/loaddefs.el > $(lisp)/ldefs-boot.el # This is required by the bootstrap-emacs target in ../src/Makefile, so From 33adf9ea4e6ed1b494938ad87c3405e3b8a8f3af Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 20 Aug 2025 15:33:49 -0700 Subject: [PATCH 023/158] Update comments re GCC bugs 117423 and 119085 --- configure.ac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index 8c2e6b421d9..140ff76029e 100644 --- a/configure.ac +++ b/configure.ac @@ -2232,9 +2232,9 @@ AC_CACHE_CHECK([for flag to work around GCC union bugs], [/* Work around GCC bugs 117423 and 119085 re holes in unions: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=117423 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=119085 - These are fixed in GCC 15.2. + These are fixed in GCC 14.4 and 15.2. - Working wround them also works around GCC bug 58416 + Working around them also works around GCC bug 58416 with double in unions on x86, where the generated insns copy non-floating-point data via fldl/fstpl instruction pairs. This can misbehave if the data's bit pattern looks like a NaN. From 1bd7b6ac27c1b2baae2733e190f2b508557d5f2f Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Mon, 18 Aug 2025 14:50:44 -0400 Subject: [PATCH 024/158] Treat point more consistently in PCM completion Properly fix bug#38458, which is fundamentally an issue with completion-ignore-case, by checking if the completions are unique ignoring case. When the completions are unique, the normal code to delete a wildcard naturally causes point to be moved to the end of the minibuffer, which is the correct behavior. Now that the bug is fixed properly, remove a hack which previously was used to "fix" it, which made point behave inconsistently if it was in the middle of the minibuffer versus at the end of the minibuffer. * lisp/minibuffer.el (completion-pcm--merge-completions): Respect completion-ignore-case when checking for completion uniqueness. (bug#79265) (completion-pcm--string->pattern) (completion-pcm--optimize-pattern): Allow point at the end of the pattern. * test/lisp/minibuffer-tests.el (completion-table-test-quoting) (completion-test--pcm-bug38458, completion-pcm-test-8): Update tests for more correct behavior. --- lisp/minibuffer.el | 19 +++++++++++-------- test/lisp/minibuffer-tests.el | 28 +++++++++++++++++++++------- 2 files changed, 32 insertions(+), 15 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index f0994adbb70..b5060614841 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4117,7 +4117,7 @@ style." "Split STRING into a pattern. A pattern is a list where each element is either a string or a symbol, see `completion-pcm--merge-completions'." - (if (and point (< point (length string))) + (if (and point (<= point (length string))) (let ((prefix (substring string 0 point)) (suffix (substring string point))) (append (completion-pcm--string->pattern prefix) @@ -4178,12 +4178,6 @@ or a symbol, see `completion-pcm--merge-completions'." (pcase p (`(,(or 'any 'any-delim) ,(or 'any 'point) . ,_) (setq p (cdr p))) - ;; This is not just a performance improvement: it turns a - ;; terminating `point' into an implicit `any', which affects - ;; the final position of point (because `point' gets turned - ;; into a non-greedy ".*?" regexp whereas we need it to be - ;; greedy when it's at the end, see bug#38458). - (`(point) (setq p nil)) ;Implicit terminating `any'. (_ (push (pop p) n)))) (nreverse n))) @@ -4634,10 +4628,19 @@ the same set of elements." ;; different capitalizations in different parts. ;; In practice, it doesn't seem to make any difference. (setq ccs (nreverse ccs)) + ;; FIXED is a prefix of all of COMPS. Try to grow that prefix. (let* ((prefix (try-completion fixed comps)) (unique (or (and (eq prefix t) (setq prefix fixed)) (and (stringp prefix) - (eq t (try-completion prefix comps)))))) + ;; If PREFIX is equal to all of COMPS, + ;; then PREFIX is a unique completion. + (seq-every-p + ;; PREFIX is still a prefix of all of + ;; COMPS, so if COMP is the same length, + ;; they're equal. + (lambda (comp) + (= (length prefix) (length comp))) + comps))))) ;; If there's only one completion, `elem' is not useful ;; any more: it can only match the empty string. ;; FIXME: in some cases, it may be necessary to turn an diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index f9a26d17e58..59b72899e22 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -100,10 +100,10 @@ ;; Test that $$ in input is properly unquoted. ("data/m-cttq$$t" "data/minibuffer-test-cttq$$tion") ;; Test that env-vars are preserved. - ("lisp/c${CTTQ1}et/se-u" "lisp/c${CTTQ1}et/semantic-utest") - ("lisp/ced${CTTQ2}se-u" "lisp/ced${CTTQ2}semantic-utest") + ("lisp/c${CTTQ1}et/se-u-c" "lisp/c${CTTQ1}et/semantic-utest-c.test") + ("lisp/ced${CTTQ2}se-u-c" "lisp/ced${CTTQ2}semantic-utest-c.test") ;; Test that env-vars don't prevent partial-completion. - ("lis/c${CTTQ1}/se-u" "lisp/c${CTTQ1}et/semantic-utest") + ("lis/c${CTTQ1}/se-u-c" "lisp/c${CTTQ1}et/semantic-utest-c.test") )) (should (equal (completion-try-completion input #'completion--file-name-table @@ -118,11 +118,11 @@ ;; When an env var is in the completion bounds, try-completion ;; won't change letter case. ("lisp/c${CTTQ1}E" "lisp/c${CTTQ1}Et/") - ("lisp/ced${CTTQ2}SE-U" "lisp/ced${CTTQ2}SEmantic-utest") + ("lisp/ced${CTTQ2}SE-U-c" "lisp/ced${CTTQ2}SEmantic-utest-c.test") ;; If the env var is before the completion bounds, try-completion ;; *will* change letter case. - ("lisp/c${CTTQ1}et/SE-U" "lisp/c${CTTQ1}et/semantic-utest") - ("lis/c${CTTQ1}/SE-U" "lisp/c${CTTQ1}et/semantic-utest") + ("lisp/c${CTTQ1}et/SE-U-c" "lisp/c${CTTQ1}et/semantic-utest-c.test") + ("lis/c${CTTQ1}/SE-U-c" "lisp/c${CTTQ1}et/semantic-utest-c.test") )) (should (equal (car (completion-try-completion input #'completion--file-name-table @@ -224,7 +224,11 @@ (completion-pcm--merge-try '("tes" point "ing") '("Testing" "testing") "" "")) - '("testing" . 4)))) + '("testing" . 7))) + (should (equal + (let ((completion-ignore-case t)) + (completion-pcm-try-completion "tes" '("Testing" "testing") nil 3)) + '("testing" . 7)))) (ert-deftest completion-pcm-test-1 () ;; Point is at end, this does not match anything @@ -318,6 +322,16 @@ '(prefix any "bar" any) '("xbarxfoo" "ybaryfoo") "" "") '("bar" . 3)))) +(ert-deftest completion-pcm-test-8 () + ;; try-completion inserts the common prefix and suffix at point. + (should (equal (completion-pcm-try-completion + "r" '("fooxbar" "fooybar") nil 0) + '("foobar" . 3))) + ;; Even if point is at the end of the minibuffer. + (should (equal (completion-pcm-try-completion + "" '("fooxbar" "fooybar") nil 0) + '("foobar" . 3)))) + (ert-deftest completion-substring-test-1 () ;; One third of a match! (should (equal From b511c38bba5354ff21c697e4d27279bf73e4d3cf Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 20 Aug 2025 13:23:34 -0400 Subject: [PATCH 025/158] Avoid duplicating strings in pcm--merge-completions Make completion-pcm--merge-completions operate only on the text matched by the wildcards, instead of also the text in between the wildcards. This improves performance and simplifies the code by removing the need for the previous mutable variable "fixed". * lisp/minibuffer.el (completion-pcm--merge-completions): Operate only on text matched by wildcards. (bug#79265) --- lisp/minibuffer.el | 39 +++++++++++++++------------------------ 1 file changed, 15 insertions(+), 24 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index b5060614841..2dd5e09f8bb 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4586,38 +4586,35 @@ the same set of elements." (cond ((null (cdr strs)) (list (car strs))) (t - (let ((re (completion-pcm--pattern->regex pattern 'group)) + (let ((re (concat + (completion-pcm--pattern->regex pattern 'group) + ;; The implicit trailing `any' is greedy. + "\\([^z-a]*\\)")) (ccs ())) ;Chopped completions. - ;; First chop each string into the parts corresponding to each - ;; non-constant element of `pattern', using regexp-matching. + ;; First match each string against PATTERN as a regex and extract + ;; the text matched by each wildcard. (let ((case-fold-search completion-ignore-case)) (dolist (str strs) (unless (string-match re str) (error "Internal error: %s doesn't match %s" str re)) (let ((chopped ()) - (last 0) (i 1) next) - (while (setq next (match-end i)) - (push (substring str last next) chopped) - (setq last next) + (while (setq next (match-string i str)) + (push next chopped) (setq i (1+ i))) - ;; Add the text corresponding to the implicit trailing `any'. - (push (substring str last) chopped) (push (nreverse chopped) ccs)))) - ;; Then for each of those non-constant elements, extract the - ;; commonality between them. + ;; Then for each of those wildcards, extract the commonality between them. (let ((res ()) - (fixed "") ;; Accumulate each stretch of wildcards, and process them as a unit. (wildcards ())) ;; Make the implicit trailing `any' explicit. (dolist (elem (append pattern '(any))) (if (stringp elem) (progn - (setq fixed (concat fixed elem)) + (push elem res) (setq wildcards nil)) (let ((comps ())) (push elem wildcards) @@ -4628,18 +4625,13 @@ the same set of elements." ;; different capitalizations in different parts. ;; In practice, it doesn't seem to make any difference. (setq ccs (nreverse ccs)) - ;; FIXED is a prefix of all of COMPS. Try to grow that prefix. - (let* ((prefix (try-completion fixed comps)) - (unique (or (and (eq prefix t) (setq prefix fixed)) + (let* ((prefix (try-completion "" comps)) + (unique (or (and (eq prefix t) (setq prefix "")) (and (stringp prefix) ;; If PREFIX is equal to all of COMPS, ;; then PREFIX is a unique completion. (seq-every-p - ;; PREFIX is still a prefix of all of - ;; COMPS, so if COMP is the same length, - ;; they're equal. - (lambda (comp) - (= (length prefix) (length comp))) + (lambda (comp) (= (length prefix) (length comp))) comps))))) ;; If there's only one completion, `elem' is not useful ;; any more: it can only match the empty string. @@ -4654,7 +4646,7 @@ the same set of elements." ;; `prefix' only wants to include the fixed part before the ;; wildcard, not the result of growing that fixed part. (when (seq-some (lambda (elem) (eq elem 'prefix)) wildcards) - (setq prefix fixed)) + (setq prefix "")) (push prefix res) ;; Push all the wildcards in this stretch, to preserve `point' and ;; `star' wildcards before ELEM. @@ -4678,8 +4670,7 @@ the same set of elements." (unless (equal suffix "") (push suffix res)))) ;; We pushed these wildcards on RES, so we're done with them. - (setq wildcards nil)) - (setq fixed ""))))) + (setq wildcards nil)))))) ;; We return it in reverse order. res))))) From c6bf09d5c3a7c514348a7afc2bde7138173e78d2 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 21 Aug 2025 04:06:44 +0300 Subject: [PATCH 026/158] ; Fix typo (wrong-type-argument not wrong-argument-type) --- doc/misc/eieio.texi | 2 +- lisp/emacs-lisp/eieio.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 39225535089..bf6f2fdb430 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -881,7 +881,7 @@ help with this a plethora of predicates have been created. @anchor{find-class} Return the class that @var{symbol} represents. If there is no class, @code{nil} is returned if @var{errorp} is @code{nil}. -If @var{errorp} is non-@code{nil}, @code{wrong-argument-type} is signaled. +If @var{errorp} is non-@code{nil}, @code{wrong-type-argument} is signaled. @end defun @defun class-p class diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index e1051eb7d4e..7f7b2adde45 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -593,7 +593,7 @@ OBJECT can be an instance or a class." (defun find-class (symbol &optional errorp) "Return the class that SYMBOL represents. If there is no class, nil is returned if ERRORP is nil. -If ERRORP is non-nil, `wrong-argument-type' is signaled." +If ERRORP is non-nil, `wrong-type-argument' is signaled." (let ((class (cl--find-class symbol))) (cond ((eieio--class-p class) class) From fdad3417dcfc9e1925e96a035e52fdcad3248f68 Mon Sep 17 00:00:00 2001 From: john muhl Date: Wed, 20 Aug 2025 12:28:24 -0500 Subject: [PATCH 027/158] ; Fix typo in 'cursor-type' widget * lisp/cus-start.el: Swap height/width in descriptions for bar type cursors. (Bug#79281) --- lisp/cus-start.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 91cc6e22152..56471c1eae3 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -77,10 +77,10 @@ (const box) integer) (const :tag "Hollow cursor" hollow) (const :tag "Vertical bar" bar) - (cons :tag "Vertical bar with specified height" + (cons :tag "Vertical bar with specified width" (const bar) integer) (const :tag "Horizontal bar" hbar) - (cons :tag "Horizontal bar with specified width" + (cons :tag "Horizontal bar with specified height" (const hbar) integer) (const :tag "None "nil)))) (pcase-dolist From 6392f5d61f62f9c8b4a836f288bf3d07c31d3f8a Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 24 Jul 2025 20:41:51 -0500 Subject: [PATCH 028/158] ; Remove duplicate menu item in 'eww' * lisp/net/eww.el (eww-mode-map): Delete "Exit" menu item. It once called 'eww-quit', which was deleted in Dec 2013, so now it does the same as "Close browser" menu item. (Bug#79284) --- lisp/net/eww.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index e0ec7d91090..6f06302cb3f 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1356,7 +1356,6 @@ This consults the entries in `eww-readable-urls' (which see)." "" #'eww-forward-url :menu '("Eww" - ["Exit" quit-window t] ["Close browser" quit-window t] ["Reload" eww-reload t] ["Follow URL in new buffer" eww-open-in-new-buffer] From 475a5d56d06253c688d5481dd58d21a9844b33ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 20 Aug 2025 13:05:12 +0200 Subject: [PATCH 029/158] ; * src/lread.c (from_buffer_p): New abstraction. --- src/lread.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/lread.c b/src/lread.c index 80172dbe7c8..1a667ce163a 100644 --- a/src/lread.c +++ b/src/lread.c @@ -522,6 +522,12 @@ from_file_p (source_t *source) return source->get == source_file_get; } +static bool +from_buffer_p (source_t *source) +{ + return source->get == source_buffer_get; +} + static void skip_dyn_bytes (source_t *source, ptrdiff_t n) { @@ -630,7 +636,7 @@ unreadbyte_from_file (unsigned char c) static AVOID invalid_syntax_lisp (Lisp_Object s, source_t *source) { - if (source->get == source_buffer_get) + if (from_buffer_p (source)) { Lisp_Object buffer = source->object; /* Get the line/column in the buffer. */ @@ -2120,7 +2126,7 @@ end_of_file_error (source_t *source) /* Only Fload calls read on a file, and Fload always binds load-true-file-name around the call. */ xsignal1 (Qend_of_file, Vload_true_file_name); - else if (source->get == source_buffer_get) + else if (from_buffer_p (source)) xsignal1 (Qend_of_file, source->object); else xsignal0 (Qend_of_file); From 14c2e5f1bec51523ec5d3793aa733a2f60d92fe4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 8 Aug 2025 21:23:23 +0200 Subject: [PATCH 030/158] Eliminate some gratuitous string mutation * lisp/play/zone.el (zone-replace-char): * lisp/international/quail.el (quail-get-translations): * lisp/hippie-exp.el (he-capitalize-first): Clarify the code by removing mutation that is probably not resizing but just in case. --- lisp/hippie-exp.el | 11 ++++++----- lisp/international/quail.el | 12 ++++++++---- lisp/play/zone.el | 5 +++-- 3 files changed, 17 insertions(+), 11 deletions(-) diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index 3b89521e0fd..a7bb6ef92e9 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -334,11 +334,12 @@ undoes the expansion." (defun he-capitalize-first (str) (save-match-data - (if (string-match "\\Sw*\\(\\sw\\).*" str) - (let ((res (downcase str)) - (no (match-beginning 1))) - (aset res no (upcase (aref str no))) - res) + (if (string-match "\\Sw*\\(\\sw\\)" str) + (let ((b (match-beginning 1)) + (e (match-end 1))) + (concat (substring str 0 b) + (upcase (substring str b e)) + (downcase (substring str e)))) str))) (defun he-ordinary-case-p (str) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 20649082941..d015b73e955 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -2135,10 +2135,14 @@ minibuffer and the selected frame has no other windows)." (let ((guidance (quail-guidance))) (if (listp guidance) ;; We must replace the typed key with the specified PROMPT-KEY. - (dotimes (i (length str)) - (let ((prompt-key (cdr (assoc (aref str i) guidance)))) - (if prompt-key - (aset str i (aref prompt-key 0))))))) + (setq str (apply #'string + (mapcar + (lambda (c) + (let ((prompt-key (assq c guidance))) + (if prompt-key + (aref (cdr prompt-key) 0) + c))) + str))))) ;; Show followable keys. (if (and (> (length quail-current-key) 0) (cdr map)) diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 39a33f1e2a0..5f817c10371 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -433,8 +433,9 @@ run a specific program. The program must be a member of (defsubst zone-replace-char (count del-count char-as-string new-value) (delete-char (or del-count (- count))) - (aset char-as-string 0 new-value) - (dotimes (_ count) (insert char-as-string))) + (let ((s (apply #'propertize (string new-value) + (text-properties-at 0 char-as-string)))) + (dotimes (_ count) (insert s)))) (defsubst zone-park/sit-for (pos seconds) (let ((p (point))) From 3b80b706e552732825f80594c8459935a940a353 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 19 Aug 2025 21:03:15 +0200 Subject: [PATCH 031/158] Free tar-mode helper buffers after use in package.el (bug#79280) The auxiliary buffer used by tar-mode is normally destroyed when the parent buffer is, but package.el uses tar-mode in temporary buffers which inhibit kill-buffer-hook and this made package installation leave orphaned buffers behind. * lisp/emacs-lisp/package.el (package-untar-buffer) (package-install-file): Switch away from tar-mode before the buffer is killed, triggering a tar-data buffer purge. --- lisp/emacs-lisp/package.el | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index fe6bebc67ff..ba9999c20e6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -995,18 +995,22 @@ Newer versions are always activated, regardless of FORCE." This uses `tar-untar-buffer' from Tar mode. All files should untar into a directory named DIR; otherwise, signal an error." (tar-mode) - ;; Make sure everything extracts into DIR. - (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) - (case-fold-search (file-name-case-insensitive-p dir))) - (dolist (tar-data tar-parse-info) - (let ((name (expand-file-name (tar-header-name tar-data)))) - (or (string-match regexp name) - ;; Tarballs created by some utilities don't list - ;; directories with a trailing slash (Bug#13136). - (and (string-equal (expand-file-name dir) name) - (eq (tar-header-link-type tar-data) 5)) - (error "Package does not untar cleanly into directory %s/" dir))))) - (tar-untar-buffer)) + (unwind-protect + (progn + ;; Make sure everything extracts into DIR. + (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) + (case-fold-search (file-name-case-insensitive-p dir))) + (dolist (tar-data tar-parse-info) + (let ((name (expand-file-name (tar-header-name tar-data)))) + (or (string-match regexp name) + ;; Tarballs created by some utilities don't list + ;; directories with a trailing slash (Bug#13136). + (and (string-equal (expand-file-name dir) name) + (eq (tar-header-link-type tar-data) 5)) + (error "Package does not untar cleanly into directory %s/" + dir))))) + (tar-untar-buffer)) + (fundamental-mode))) ; free auxiliary tar-mode data (defun package--alist-to-plist-args (alist) (mapcar #'macroexp-quote @@ -2455,7 +2459,9 @@ directory." (set-visited-file-name file) (set-buffer-modified-p nil) (when (string-match "\\.tar\\'" file) (tar-mode))) - (package-install-from-buffer))) + (unwind-protect + (package-install-from-buffer) + (fundamental-mode)))) ; free auxiliary data ;;;###autoload (defun package-install-selected-packages (&optional noconfirm) From c04553f655a05810f02dd77dac4f544018158e94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 6 Aug 2025 15:29:58 +0200 Subject: [PATCH 032/158] Speed up JSON parsing by not maintaining line and column (bug#79192) We use the current parsing position instead. The line and column in the error weren't used (nor very accurate to begin with) and the user can easily compute them when needed. The line number calculation is kept just in case but deprecated, for removal in Emacs 32. * src/json.c (struct json_parser, json_parser_init): Update parser state. (json_signal_error): New position computation. (json_skip_whitespace_internal): Remove. (is_json_whitespace): New. (json_skip_whitespace, json_skip_whitespace_if_possible) (json_parse_unicode, json_parse_string, json_parse_number) (json_parse_value): Simplify and rewrite for efficiency. (count_chars, count_newlines) (string_byte_to_pos, string_byte_to_line) (buffer_byte_to_pos, buffer_byte_to_line): New. (Fjson_parse_string, Fjson_parse_buffer): Adapt to new parser state. * test/src/json-tests.el (json-tests--parse-string-error-pos) (json-tests--parse-buffer-error-pos, json-parse-error-position): New. * etc/NEWS: Note deprecation of line and column. --- etc/NEWS | 5 + src/json.c | 223 ++++++++++++++++++++++++----------------- test/src/json-tests.el | 29 ++++++ 3 files changed, 167 insertions(+), 90 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index f45ee437bf9..e94464b203b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3010,6 +3010,11 @@ a remote host. It must be used in conjunction with the function +++ ** 'read-directory-name' now accepts an optional PREDICATE argument. +--- +** JSON parse error line and column are now obsolete. +The column number is no longer available; the line number will be +removed in next Emacs release. + * Changes in Emacs 31.1 on Non-Free Operating Systems diff --git a/src/json.c b/src/json.c index 44eae653eb5..30a22dc8038 100644 --- a/src/json.c +++ b/src/json.c @@ -684,10 +684,6 @@ struct json_parser const unsigned char *secondary_input_begin; const unsigned char *secondary_input_end; - ptrdiff_t current_line; - ptrdiff_t current_column; - ptrdiff_t point_of_current_line; - /* The parser has a maximum allowed depth. available_depth decreases at each object/array begin. If reaches zero, then an error is generated */ @@ -717,15 +713,22 @@ struct json_parser unsigned char *byte_workspace; unsigned char *byte_workspace_end; unsigned char *byte_workspace_current; + + Lisp_Object obj; + ptrdiff_t (*byte_to_pos) (Lisp_Object obj, ptrdiff_t byte); + ptrdiff_t (*byte_to_line) (Lisp_Object obj, ptrdiff_t byte); }; static AVOID -json_signal_error (struct json_parser *parser, Lisp_Object error) +json_signal_error (struct json_parser *p, Lisp_Object error) { - xsignal3 (error, INT_TO_INTEGER (parser->current_line), - INT_TO_INTEGER (parser->current_column), - INT_TO_INTEGER (parser->point_of_current_line - + parser->current_column)); + ptrdiff_t byte = (p->input_current - p->input_begin + + p->additional_bytes_count); + ptrdiff_t pos = p->byte_to_pos (p->obj, byte); + ptrdiff_t line = p->byte_to_line (p->obj, byte) + 1; + /* The line number here is deprecated and provided for compatibility only. + It is scheduled for removal in Emacs 32. */ + xsignal3 (error, INT_TO_INTEGER (line), Qnil, INT_TO_INTEGER (pos)); } static void @@ -734,7 +737,10 @@ json_parser_init (struct json_parser *parser, const unsigned char *input, const unsigned char *input_end, const unsigned char *secondary_input, - const unsigned char *secondary_input_end) + const unsigned char *secondary_input_end, + ptrdiff_t (*byte_to_pos) (Lisp_Object, ptrdiff_t), + ptrdiff_t (*byte_to_line) (Lisp_Object, ptrdiff_t), + Lisp_Object obj) { if (secondary_input >= secondary_input_end) { @@ -761,9 +767,6 @@ json_parser_init (struct json_parser *parser, parser->input_current = parser->input_begin; - parser->current_line = 1; - parser->current_column = 0; - parser->point_of_current_line = 0; parser->available_depth = 10000; parser->conf = conf; @@ -777,6 +780,9 @@ json_parser_init (struct json_parser *parser, parser->byte_workspace = parser->internal_byte_workspace; parser->byte_workspace_end = (parser->byte_workspace + JSON_PARSER_INTERNAL_BYTE_WORKSPACE_SIZE); + parser->byte_to_pos = byte_to_pos; + parser->byte_to_line = byte_to_line; + parser->obj = obj; } static void @@ -956,20 +962,9 @@ json_input_put_back (struct json_parser *parser) } static bool -json_skip_whitespace_internal (struct json_parser *parser, int c) +is_json_whitespace (int c) { - parser->current_column++; - if (c == 0x20 || c == 0x09 || c == 0x0d) - return false; - else if (c == 0x0a) - { - parser->current_line++; - parser->point_of_current_line += parser->current_column; - parser->current_column = 0; - return false; - } - else - return true; + return c == 0x20 || c == 0x09 || c == 0x0d || c == 0x0a; } /* Skips JSON whitespace, and returns with the first non-whitespace @@ -980,7 +975,7 @@ json_skip_whitespace (struct json_parser *parser) for (;;) { int c = json_input_get (parser); - if (json_skip_whitespace_internal (parser, c)) + if (!is_json_whitespace (c)) return c; } } @@ -994,9 +989,7 @@ json_skip_whitespace_if_possible (struct json_parser *parser) for (;;) { int c = json_input_get_if_possible (parser); - if (c < 0) - return c; - if (json_skip_whitespace_internal (parser, c)) + if (!is_json_whitespace (c) || c < 0) return c; } } @@ -1022,7 +1015,6 @@ json_parse_unicode (struct json_parser *parser) for (int i = 0; i < 4; i++) { int c = json_hex_value (json_input_get (parser)); - parser->current_column++; if (c < 0) json_signal_error (parser, Qjson_escape_sequence_error); v[i] = c; @@ -1068,13 +1060,11 @@ json_parse_string (struct json_parser *parser, bool intern, bool leading_colon) json_byte_workspace_put (parser, c2); json_byte_workspace_put (parser, c3); parser->input_current += 4; - parser->current_column += 4; continue; } } int c = json_input_get (parser); - parser->current_column++; if (json_plain_char[c]) { json_byte_workspace_put (parser, c); @@ -1137,7 +1127,6 @@ json_parse_string (struct json_parser *parser, bool intern, bool leading_colon) { /* Handle escape sequences */ c = json_input_get (parser); - parser->current_column++; if (c == '"') json_byte_workspace_put (parser, '"'); else if (c == '\\') @@ -1160,11 +1149,9 @@ json_parse_string (struct json_parser *parser, bool intern, bool leading_colon) /* is the first half of the surrogate pair */ if (num >= 0xd800 && num < 0xdc00) { - parser->current_column++; if (json_input_get (parser) != '\\') json_signal_error (parser, Qjson_invalid_surrogate_error); - parser->current_column++; if (json_input_get (parser) != 'u') json_signal_error (parser, Qjson_invalid_surrogate_error); @@ -1285,7 +1272,6 @@ json_parse_number (struct json_parser *parser, int c) negative = true; c = json_input_get (parser); json_byte_workspace_put (parser, c); - parser->current_column++; } if (c < '0' || c > '9') json_signal_error (parser, Qjson_parse_error); @@ -1317,7 +1303,6 @@ json_parse_number (struct json_parser *parser, int c) if (c < '0' || c > '9') break; json_byte_workspace_put (parser, c); - parser->current_column++; integer_overflow |= ckd_mul (&integer, integer, 10); integer_overflow |= ckd_add (&integer, integer, c - '0'); @@ -1328,12 +1313,10 @@ json_parse_number (struct json_parser *parser, int c) if (c == '.') { json_byte_workspace_put (parser, c); - parser->current_column++; is_float = true; c = json_input_get (parser); json_byte_workspace_put (parser, c); - parser->current_column++; if (c < '0' || c > '9') json_signal_error (parser, Qjson_parse_error); for (;;) @@ -1344,23 +1327,19 @@ json_parse_number (struct json_parser *parser, int c) if (c < '0' || c > '9') break; json_byte_workspace_put (parser, c); - parser->current_column++; } } if (c == 'e' || c == 'E') { json_byte_workspace_put (parser, c); - parser->current_column++; is_float = true; c = json_input_get (parser); json_byte_workspace_put (parser, c); - parser->current_column++; if (c == '-' || c == '+') { c = json_input_get (parser); json_byte_workspace_put (parser, c); - parser->current_column++; } if (c < '0' || c > '9') json_signal_error (parser, Qjson_parse_error); @@ -1372,7 +1351,6 @@ json_parse_number (struct json_parser *parser, int c) if (c < '0' || c > '9') break; json_byte_workspace_put (parser, c); - parser->current_column++; } } @@ -1605,57 +1583,67 @@ json_is_token_char (int c) || (c >= '0' && c <= '9') || (c == '-')); } -/* This is the entry point to the value parser, this parses a JSON - * value */ -Lisp_Object +static Lisp_Object json_parse_value (struct json_parser *parser, int c) { - if (c == '{') - return json_parse_object (parser); - else if (c == '[') - return json_parse_array (parser); - else if (c == '"') - return json_parse_string (parser, false, false); - else if ((c >= '0' && c <= '9') || (c == '-')) - return json_parse_number (parser, c); - else + switch (c) { - int c2 = json_input_get_if_possible (parser); - int c3 = json_input_get_if_possible (parser); - int c4 = json_input_get_if_possible (parser); - int c5 = json_input_get_if_possible (parser); - - if (c == 't' && c2 == 'r' && c3 == 'u' && c4 == 'e' - && (c5 < 0 || !json_is_token_char (c5))) + case '{': + return json_parse_object (parser); + case '[': + return json_parse_array (parser); + case '"': + return json_parse_string (parser, false, false); + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + case '-': + return json_parse_number (parser, c); + case 't': + if (json_input_get_if_possible (parser) == 'r' + && json_input_get_if_possible (parser) == 'u' + && json_input_get_if_possible (parser) == 'e') { - if (c5 >= 0) - json_input_put_back (parser); - parser->current_column += 3; - return Qt; - } - if (c == 'n' && c2 == 'u' && c3 == 'l' && c4 == 'l' - && (c5 < 0 || !json_is_token_char (c5))) - { - if (c5 >= 0) - json_input_put_back (parser); - parser->current_column += 3; - return parser->conf.null_object; - } - if (c == 'f' && c2 == 'a' && c3 == 'l' && c4 == 's' - && c5 == 'e') - { - int c6 = json_input_get_if_possible (parser); - if (c6 < 0 || !json_is_token_char (c6)) + int c2 = json_input_get_if_possible (parser); + if (!json_is_token_char (c2)) { - if (c6 >= 0) + if (c2 >= 0) + json_input_put_back (parser); + return Qt; + } + } + break; + case 'f': + if (json_input_get_if_possible (parser) == 'a' + && json_input_get_if_possible (parser) == 'l' + && json_input_get_if_possible (parser) == 's' + && json_input_get_if_possible (parser) == 'e') + { + int c2 = json_input_get_if_possible (parser); + if (!json_is_token_char (c2)) + { + if (c2 >= 0) json_input_put_back (parser); - parser->current_column += 4; return parser->conf.false_object; } } - - json_signal_error (parser, Qjson_parse_error); + break; + case 'n': + if (json_input_get_if_possible (parser) == 'u' + && json_input_get_if_possible (parser) == 'l' + && json_input_get_if_possible (parser) == 'l') + { + int c2 = json_input_get_if_possible (parser); + if (!json_is_token_char (c2)) + { + if (c2 >= 0) + json_input_put_back (parser); + return parser->conf.null_object; + } + } + break; } + + json_signal_error (parser, Qjson_parse_error); } static Lisp_Object @@ -1664,6 +1652,42 @@ json_parse (struct json_parser *parser) return json_parse_value (parser, json_skip_whitespace (parser)); } +/* Count number of characters in the NBYTES bytes at S. */ +static ptrdiff_t +count_chars (const unsigned char *s, ptrdiff_t nbytes) +{ + ptrdiff_t nchars = 0; + for (ptrdiff_t i = 0; i < nbytes; i++) + nchars += (s[i] & 0xc0) != 0x80; + return nchars; +} + +/* Count number of newlines in the NBYTES bytes at S. */ +static ptrdiff_t +count_newlines (const unsigned char *s, ptrdiff_t nbytes) +{ + ptrdiff_t nls = 0; + for (ptrdiff_t i = 0; i < nbytes; i++) + nls += (s[i] == '\n'); + return nls; +} + +static ptrdiff_t +string_byte_to_pos (Lisp_Object obj, ptrdiff_t byte) +{ + eassert (STRINGP (obj)); + eassert (byte <= SBYTES (obj)); + return STRING_MULTIBYTE (obj) ? count_chars (SDATA (obj), byte) : byte; +} + +static ptrdiff_t +string_byte_to_line (Lisp_Object obj, ptrdiff_t byte) +{ + eassert (STRINGP (obj)); + eassert (byte <= SBYTES (obj)); + return count_newlines (SDATA (obj), byte); +} + DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, NULL, doc: /* Parse the JSON STRING into a Lisp value. @@ -1703,7 +1727,8 @@ usage: (json-parse-string STRING &rest ARGS) */) struct json_parser p; const unsigned char *begin = SDATA (string); - json_parser_init (&p, conf, begin, begin + SBYTES (string), NULL, NULL); + json_parser_init (&p, conf, begin, begin + SBYTES (string), NULL, NULL, + string_byte_to_pos, string_byte_to_line, string); record_unwind_protect_ptr (json_parser_done, &p); Lisp_Object result = json_parse (&p); @@ -1713,6 +1738,24 @@ usage: (json-parse-string STRING &rest ARGS) */) return unbind_to (count, result); } +static ptrdiff_t +buffer_byte_to_pos (Lisp_Object obj, ptrdiff_t byte) +{ + /* The position from the start of the parse (for compatibility). */ + return BYTE_TO_CHAR (PT_BYTE + byte) - PT; +} + +static ptrdiff_t +buffer_byte_to_line (Lisp_Object obj, ptrdiff_t byte) +{ + /* Line from start of the parse (for compatibility). */ + ptrdiff_t to_gap = GPT_BYTE - PT_BYTE; + return (to_gap > 0 && to_gap < byte + ? (count_newlines (PT_ADDR, to_gap) + + count_newlines (GAP_END_ADDR, byte - to_gap)) + : count_newlines (PT_ADDR, byte)); +} + DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, 0, MANY, NULL, doc: /* Read a JSON value from current buffer starting at point. @@ -1766,8 +1809,8 @@ usage: (json-parse-buffer &rest args) */) secondary_end = ZV_ADDR; } - json_parser_init (&p, conf, begin, end, secondary_begin, - secondary_end); + json_parser_init (&p, conf, begin, end, secondary_begin, secondary_end, + buffer_byte_to_pos, buffer_byte_to_line, Qnil); record_unwind_protect_ptr (json_parser_done, &p); Lisp_Object result = json_parse (&p); @@ -1776,7 +1819,7 @@ usage: (json-parse-buffer &rest args) */) ptrdiff_t position = (NILP (BVAR (current_buffer, enable_multibyte_characters)) ? byte - : PT + p.point_of_current_line + p.current_column); + : BYTE_TO_CHAR (byte)); SET_PT_BOTH (position, byte); return unbind_to (count, result); diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 1cb667ddeac..30cf32039f9 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -424,5 +424,34 @@ See also `with-temp-buffer'." (puthash 1 2 table) (should-error (json-serialize table) :type 'wrong-type-argument))) +(defun json-tests--parse-string-error-pos (s) + (condition-case e + (json-parse-string s) + (json-error (nth 3 e)) + (:success 'no-error))) + +(defun json-tests--parse-buffer-error-pos () + (condition-case e + (json-parse-buffer) + (json-error (nth 3 e)) + (:success 'no-error))) + +(ert-deftest json-parse-error-position () + (let* ((s "[\"*Ωßœ☃*\",,8]") + (su (encode-coding-string s 'utf-8-emacs))) + (should (equal (json-tests--parse-string-error-pos s) 11)) + (should (equal (json-tests--parse-string-error-pos su) 16)) + + (with-temp-buffer + (let ((junk "some leading junk")) + (insert junk) + (insert s) + (goto-char (1+ (length junk))) + (should (equal (json-tests--parse-buffer-error-pos) 11)) + + (set-buffer-multibyte nil) + (goto-char (1+ (length junk))) + (should (equal (json-tests--parse-buffer-error-pos) 16)))))) + (provide 'json-tests) ;;; json-tests.el ends here From fdf5e5dc415ef692e86f34c7eb4f7fa5bd9b18cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Harald=20J=C3=B6rg?= Date: Thu, 21 Aug 2025 17:52:30 +0200 Subject: [PATCH 033/158] ; cperl-mode.el: fix indentation for multiline signatures This fixes the first (and more important) part of Bug#79269. * lisp/progmodes/cperl-mode.el (cperl-get-state): Replace `beginning-of-defun' by `beginning-of-defun-raw'. Also fix a typo in the docstring. * test/lisp/progmodes/cperl-mode-tests.el (test-indentation): Skip tests unless in cperl-mode. The test file cperl-indents.erts explicitly invokes cperl-mode. Due to different indentation defaults the tests do not pass in perl-mode. * test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts: Add test cperl-subroutine-signatures for Bug#79269 --- lisp/progmodes/cperl-mode.el | 4 +-- .../cperl-mode-resources/cperl-indents.erts | 25 +++++++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 3 +++ 3 files changed, 30 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 8643b69ef83..1e2aca73161 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -2766,7 +2766,7 @@ PARSE-DATA is used to save status between calls in a loop." START is a good place to start parsing, or equal to PARSE-START if preset. STATE is what is returned by `parse-partial-sexp'. -DEPTH is true is we are immediately after end of block +DEPTH is true if we are immediately after end of block which contains START. PRESTART is the position basing on which START was found. START-STATE should be a good guess for the start of a function." @@ -2775,7 +2775,7 @@ START-STATE should be a good guess for the start of a function." (if (and parse-start (<= parse-start start-point)) (goto-char parse-start) - (beginning-of-defun) + (beginning-of-defun-raw) (when (cperl-declaration-header-p (point)) (goto-char (cperl-beginning-of-property (point) 'syntax-type)) (beginning-of-line)) diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts index ab00e9ce6d4..3a779442a8a 100644 --- a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts @@ -98,3 +98,28 @@ Name: cperl-keyword-without-space my %h = map{$_=>1} @ARGV; =-=-= + +Name: cperl-subroutine-signatures + +=-= +# -*- mode: cperl -*- +# John Ciolfi reported as Bug#79269 +use strict; +use warnings; +use experimental 'signatures'; + +foo(1); + +sub foo ( + $in1, + $optionsHPtr = {}, + $otherOption1 = 1, # Bug: wrong face for this option + ) { + + my $a = 1; # Bug: should be indented by 2 spaces + + # Bug: following are not indented due to use of signatures + my $b = 2; + return $a + $b + $in1; +} +=-=-= diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 00116986b4b..469345e74c9 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -1605,6 +1605,9 @@ It must not be mistaken for \"$)\"." (forward-line 1)))) (ert-deftest test-indentation () + ;; The erts file explicitly invokes cperl-mode, so skip in perl-mode. + ;; Indentation defaults are different, so it won't pass in perl-mode + (skip-unless (eq cperl-test-mode #'cperl-mode)) (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) ;;; cperl-mode-tests.el ends here From 1a549762ed9f7cb09a1269503566837f91794ed6 Mon Sep 17 00:00:00 2001 From: Rahguzar Date: Sun, 17 Aug 2025 16:06:54 +0500 Subject: [PATCH 034/158] Correctly document the format of tabulated-list-groups * lisp/emacs-lisp/tabulated-list.el (tabulated-list-groups): Correct format in doc string (bug#79220). * doc/lispref/modes.texi (Tabulated List Mode): Correct format in manual. --- doc/lispref/modes.texi | 7 ++++--- lisp/emacs-lisp/tabulated-list.el | 5 +++-- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index ba86b2d7b13..33c02aaabe3 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1289,10 +1289,11 @@ the Tabulated List buffer. Its value should be either a list or a function. If the value is a list, each list element corresponds to one group, and -should have the form @w{@code{(@var{group-name} @var{entries})}}, where +should have the form +@w{@code{(@var{group-name} @var{entry1} @var{entry2} @dots{})}}, where @var{group-name} is a string inserted before all group entries, and -@var{entries} have the same format as @code{tabulated-list-entries} -(see above). +@var{entry1}, @var{entry2} and so on each have the same format as an +element of @code{tabulated-list-entries} (see above). Otherwise, the value should be a function which returns a list of the above form when called with no arguments. diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 40b2fb0886b..f4220501b35 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -142,13 +142,14 @@ arguments and must return a list of the above form.") (defvar-local tabulated-list-groups nil "Groups displayed in the current Tabulated List buffer. This should be either a function, or a list. -If a list, each element has the form (GROUP-NAME ENTRIES), +If a list, each element has the form (GROUP-NAME ENTRY1 ENTRY2 ...), where: - GROUP-NAME is a group name as a string, which is displayed at the top line of each group. - - ENTRIES is a list described in `tabulated-list-entries'. + - ENTRY1, ENTRY2 and so on each have the same format as an element + of `tabulated-list-entries'. If `tabulated-list-groups' is a function, it is called with no arguments and must return a list of the above form.") From f0b987c32c358703d85d3be010bb2fe0299192be Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Tue, 19 Aug 2025 11:12:01 -0700 Subject: [PATCH 035/158] rust-ts-mode: handle invalid rust syntax without signaling Don't signal an error when encountering invalid rust syntax. Without this patch, invalid rust code would prevent a chunk of the buffer from being highlighted (bug#79272). * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--fontify-scope): (rust-ts-mode--fontify-pattern): Avoid calling `string-match-p' on nil when a node is missing a parent. * test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs: Rust file that reproduces the issue. * test/lisp/progmodes/rust-ts-mode-tests.el: Test case to reproduce the issue. --- lisp/progmodes/rust-ts-mode.el | 9 +++++---- .../rust-ts-mode-resources/font-lock-no-parent.rs | 7 +++++++ test/lisp/progmodes/rust-ts-mode-tests.el | 7 +++++++ 3 files changed, 19 insertions(+), 4 deletions(-) create mode 100644 test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index a5c217c0a4b..a98d621af65 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -366,7 +366,8 @@ See https://doc.rust-lang.org/reference/tokens.html#suffixes.") tail-p (string-match-p "\\`\\(?:use_list\\|call_expression\\|use_as_clause\\|use_declaration\\)\\'" - (treesit-node-type (treesit-node-parent (treesit-node-parent node))))) + (or (treesit-node-type (treesit-node-parent (treesit-node-parent node))) + "no_parent"))) nil) (t 'font-lock-constant-face)))) (when face @@ -387,9 +388,9 @@ See https://doc.rust-lang.org/reference/tokens.html#suffixes.") ,(treesit-query-compile 'rust '((identifier) @id (shorthand_field_identifier) @id))))) (pcase-dolist (`(_name . ,id) captures) - (unless (string-match-p "\\`scoped_\\(?:type_\\)?identifier\\'" - (treesit-node-type - (treesit-node-parent id))) + (unless (string-match-p + "\\`scoped_\\(?:type_\\)?identifier\\'" + (or (treesit-node-type (treesit-node-parent id)) "no_parent")) (treesit-fontify-with-override (treesit-node-start id) (treesit-node-end id) 'font-lock-variable-name-face override start end))))))) diff --git a/test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs b/test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs new file mode 100644 index 00000000000..85d0ccc9bf3 --- /dev/null +++ b/test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs @@ -0,0 +1,7 @@ ++// intentionally invalid syntax ++const THING: [u8; 48] = []; + +// should recover here and highlight the text below +trait Foo() { +// ^ font-lock-keyword-face +} diff --git a/test/lisp/progmodes/rust-ts-mode-tests.el b/test/lisp/progmodes/rust-ts-mode-tests.el index d2e28dcfbd7..32d64260a87 100644 --- a/test/lisp/progmodes/rust-ts-mode-tests.el +++ b/test/lisp/progmodes/rust-ts-mode-tests.el @@ -39,6 +39,13 @@ (ert-font-lock-test-file (ert-resource-file "font-lock-number.rs") 'rust-ts-mode))) +(ert-deftest rust-ts-test-no-parent () + (skip-unless (treesit-ready-p 'rust)) + (let ((treesit-font-lock-level 4) + (rust-ts-mode-fontify-number-suffix-as-type t)) + (ert-font-lock-test-file (ert-resource-file "font-lock-no-parent.rs") + 'rust-ts-mode))) + (provide 'rust-ts-mode-tests) ;;; rust-ts-mode-tests.el ends here From 3f7c16d858e579ed03a195841ba9805fbc2899ba Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 20 Aug 2025 14:27:59 -0400 Subject: [PATCH 036/158] Add minibuffer--completions-visible and use it At various places, instead of just checking that there's any window displaying a buffer named *Completions*, we should additionally check that that *Completions* buffer is actually for the current completion session. minibuffer--completions-visible does that. * lisp/comint.el (comint-complete-input-ring) (comint-dynamic-list-completions): Call minibuffer--completions-visible. * lisp/minibuffer.el (minibuffer--completions-visible): Add. (bug#77253) (completion--do-completion, completions--post-command-update) (completions--after-change, minibuffer-hide-completions) (minibuffer-visible-completions) (minibuffer-visible-completions--always-bind) (minibuffer-visible-completions--filter) (with-minibuffer-completions-window, minibuffer-complete-history) (minibuffer-complete-defaults): Call minibuffer--completions-visible. * lisp/pcomplete.el (pcomplete-show-completions): Call minibuffer--completions-visible. * lisp/simple.el (switch-to-completions): Call minibuffer--completions-visible. * test/lisp/minibuffer-tests.el (completion-auto-help-test) (completion-auto-select-test): Call minibuffer--completions-visible. --- lisp/comint.el | 4 ++-- lisp/minibuffer.el | 40 +++++++++++++++++++++-------------- lisp/pcomplete.el | 2 +- lisp/simple.el | 4 ++-- test/lisp/minibuffer-tests.el | 14 ++++++------ 5 files changed, 36 insertions(+), 28 deletions(-) diff --git a/lisp/comint.el b/lisp/comint.el index b9c910eff43..bbb9820c16a 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1197,7 +1197,7 @@ This function makes `comint-dynamic-list-input-ring' obsolete." (ring-elements comint-input-ring) (user-error "No history available"))) (completion-in-region-mode-predicate - (lambda () (get-buffer-window "*Completions*" 0)))) + (lambda () (minibuffer--completions-visible)))) (completion-in-region (comint-line-beginning-position) (point-max) (completion-table-with-metadata @@ -3521,7 +3521,7 @@ The optional argument COMMON-SUBSTRING, if non-nil, should be a string specifying a common substring for adding the faces `completions-first-difference' and `completions-common-part' to the completions." - (let ((window (get-buffer-window "*Completions*" 0))) + (let ((window (minibuffer--completions-visible))) (setq completions (sort completions #'string-lessp)) (if (and (eq last-command this-command) window (window-live-p window) (window-buffer window) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 2dd5e09f8bb..3c80d606cfc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1616,7 +1616,7 @@ when the buffer's text is already an exact match." (completed (cond ((pcase completion-auto-help - ('visible (get-buffer-window "*Completions*" 0)) + ('visible (minibuffer--completions-visible)) ('always t)) (minibuffer-completion-help beg end)) (t (minibuffer-hide-completions) @@ -2677,13 +2677,13 @@ so that the update is less likely to interfere with user typing." (defun completions--post-command-update () "Update displayed *Completions* buffer after command, once." (remove-hook 'post-command-hook #'completions--post-command-update) - (when (and completion-eager-update (get-buffer-window "*Completions*" 0)) + (when (and completion-eager-update (minibuffer--completions-visible)) (completions--background-update))) (defun completions--after-change (_start _end _old-len) "Update displayed *Completions* buffer after change in buffer contents." (when (or completion-auto-deselect completion-eager-update) - (when-let* ((window (get-buffer-window "*Completions*" 0))) + (when-let* ((window (minibuffer--completions-visible))) (when completion-auto-deselect (with-selected-window window (completions--deselect))) @@ -2885,7 +2885,7 @@ so that the update is less likely to interfere with user typing." ;; FIXME: We could/should use minibuffer-scroll-window here, but it ;; can also point to the minibuffer-parent-window, so it's a bit tricky. (interactive) - (when-let* ((win (get-buffer-window "*Completions*" 0))) + (when-let* ((win (minibuffer--completions-visible))) (with-selected-window win ;; Move point off any completions, so we don't move point there ;; again the next time `minibuffer-completion-help' is called. @@ -3332,18 +3332,26 @@ and `RET' accepts the input typed into the minibuffer." (defvar minibuffer-visible-completions--always-bind nil "If non-nil, force the `minibuffer-visible-completions' bindings on.") +(defun minibuffer--completions-visible () + "Return the window where the current *Completions* buffer is visible, if any." + (when-let* ((window (get-buffer-window "*Completions*" 0))) + (when (eq (buffer-local-value 'completion-reference-buffer + (window-buffer window)) + ;; If there's no active minibuffer, we call + ;; `window-buffer' on nil, assuming that completion is + ;; happening in the selected window. + (window-buffer (active-minibuffer-window))) + window))) + (defun minibuffer-visible-completions--filter (cmd) "Return CMD if `minibuffer-visible-completions' bindings should be active." (if minibuffer-visible-completions--always-bind cmd - (when-let* ((window (get-buffer-window "*Completions*" 0))) - (when (and (eq (buffer-local-value 'completion-reference-buffer - (window-buffer window)) - (window-buffer (active-minibuffer-window))) - (if (eq cmd #'minibuffer-choose-completion-or-exit) - (with-current-buffer (window-buffer window) - (get-text-property (point) 'completion--string)) - t)) + (when-let* ((window (minibuffer--completions-visible))) + (when (if (eq cmd #'minibuffer-choose-completion-or-exit) + (with-current-buffer (window-buffer window) + (get-text-property (point) 'completion--string)) + t) cmd)))) (defun minibuffer-visible-completions--bind (binding) @@ -5107,10 +5115,10 @@ the minibuffer was activated, and execute the forms." When used in a minibuffer window, select the window with completions, and execute the forms." (declare (indent 0) (debug t)) - `(let ((window (or (get-buffer-window "*Completions*" 0) + `(let ((window (or (minibuffer--completions-visible) ;; Make sure we have a completions window. (progn (minibuffer-completion-help) - (get-buffer-window "*Completions*" 0))))) + (minibuffer--completions-visible))))) (when window (with-selected-window window (completion--lazy-insert-strings) @@ -5205,7 +5213,7 @@ inputs for the prompting command, instead of the default completion table." (user-error "No history available")))) ;; FIXME: Can we make it work for CRM? (let ((completion-in-region-mode-predicate - (lambda () (get-buffer-window "*Completions*" 0)))) + (lambda () (minibuffer--completions-visible)))) (completion-in-region (minibuffer--completion-prompt-end) (point-max) (completion-table-with-metadata @@ -5223,7 +5231,7 @@ provided by the prompting command, instead of the completion table." minibuffer-default (funcall minibuffer-default-add-function))) (let ((completions (ensure-list minibuffer-default)) (completion-in-region-mode-predicate - (lambda () (get-buffer-window "*Completions*" 0)))) + (lambda () (minibuffer--completions-visible)))) (completion-in-region (minibuffer--completion-prompt-end) (point-max) (completion-table-with-metadata diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 43d149d5c90..c3b7f9d52d3 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -1150,7 +1150,7 @@ Typing SPC flushes the help buffer." ((or (eq event 'tab) ;; Needed on a terminal (eq event 9)) - (let ((win (or (get-buffer-window "*Completions*" 0) + (let ((win (or (minibuffer--completions-visible) (display-buffer "*Completions*" 'not-this-window)))) (with-selected-window win diff --git a/lisp/simple.el b/lisp/simple.el index f7f059793ca..b0f6621b37e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10598,10 +10598,10 @@ to move point between completions.\n\n"))))))) (defun switch-to-completions () "Select the completion list window." (interactive) - (when-let* ((window (or (get-buffer-window "*Completions*" 0) + (when-let* ((window (or (minibuffer--completions-visible) ;; Make sure we have a completions window. (progn (minibuffer-completion-help) - (get-buffer-window "*Completions*" 0))))) + (minibuffer--completions-visible))))) (select-window window) (completion--lazy-insert-strings) (when (bobp) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 59b72899e22..c2c37e63012 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -454,21 +454,21 @@ '("a" "ab" "ac") (execute-kbd-macro (kbd "a TAB TAB")) (should (equal (car messages) "Complete, but not unique")) - (should-not (get-buffer-window "*Completions*" 0)) + (should-not (minibuffer--completions-visible)) (execute-kbd-macro (kbd "b TAB")) (should (equal (car messages) "Sole completion")))) (let ((completion-auto-help t)) (completing-read-with-minibuffer-setup '("a" "ab" "ac") (execute-kbd-macro (kbd "a TAB TAB")) - (should (get-buffer-window "*Completions*" 0)) + (should (minibuffer--completions-visible)) (execute-kbd-macro (kbd "b TAB")) (should (equal (car messages) "Sole completion")))) (let ((completion-auto-help 'visible)) (completing-read-with-minibuffer-setup '("a" "ab" "ac" "achoo") (execute-kbd-macro (kbd "a TAB TAB")) - (should (get-buffer-window "*Completions*" 0)) + (should (minibuffer--completions-visible)) (execute-kbd-macro (kbd "ch TAB")) (should (equal (car messages) "Sole completion"))))))) @@ -477,19 +477,19 @@ (completing-read-with-minibuffer-setup '("aa" "ab" "ac") (execute-kbd-macro (kbd "a TAB")) - (should (and (get-buffer-window "*Completions*" 0) + (should (and (minibuffer--completions-visible) (eq (current-buffer) (get-buffer "*Completions*")))) (execute-kbd-macro (kbd "TAB TAB TAB")) - (should (and (get-buffer-window "*Completions*" 0) + (should (and (minibuffer--completions-visible) (eq (current-buffer) (get-buffer " *Minibuf-1*")))) (execute-kbd-macro (kbd "S-TAB")) - (should (and (get-buffer-window "*Completions*" 0) + (should (and (minibuffer--completions-visible) (eq (current-buffer) (get-buffer "*Completions*")))))) (let ((completion-auto-select 'second-tab)) (completing-read-with-minibuffer-setup '("aa" "ab" "ac") (execute-kbd-macro (kbd "a TAB")) - (should (and (get-buffer-window "*Completions*" 0) + (should (and (minibuffer--completions-visible) (not (eq (current-buffer) (get-buffer "*Completions*"))))) (execute-kbd-macro (kbd "TAB TAB")) (should (eq (current-buffer) (get-buffer "*Completions*")))))) From ade6608e2587452c8ea565ce3057879379ebd0b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?El=C3=ADas=20Gabriel=20P=C3=A9rez?= Date: Sat, 5 Jul 2025 13:29:24 -0600 Subject: [PATCH 037/158] project: Improve pruning of zombie projects. * etc/NEWS: Update 'project-prune-zombie-projects' entry. * lisp/progmodes/project.el (project-prune-zombie-projects): Change default value (bug#77566). (project--ensure-read-project-list, project--write-project-list) (project-prompt-project-dir, project-prompt-project-name): Rework for use 'project-prune-zombie-projects' value. (project-forget-zombie-projects): Move code... (project--delete-zombie-projects): ... to this new function. --- etc/NEWS | 11 ++++--- lisp/progmodes/project.el | 65 ++++++++++++++++++++++++++------------- 2 files changed, 49 insertions(+), 27 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index e94464b203b..99026f936b6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -504,12 +504,13 @@ This user option controls the automatic deletion of projects from 'project-list-file' that cannot be accessed when prompting for a project. -The value can be a predicate which takes one argument and should return -non-nil if the project should be removed. If set to nil, all the -inaccessible projects will not be removed automatically. +The value must be an alist where each element must be in the form: -By default this is set to 'project-prune-zombies-default' function -which removes all non-remote projects. + (WHEN . PREDICATE) + +where WHEN specifies where the deletion will be performed, and PREDICATE +a function which takes one argument, and must return non-nil if the +project should be removed. --- *** New command 'project-save-some-buffers' bound to 'C-x p C-x s'. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index efc00ac8733..8438060afa3 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1650,16 +1650,28 @@ general form of conditions." :group 'project :package-version '(project . "0.8.2")) -(defcustom project-prune-zombie-projects #'project-prune-zombies-default - "Remove automatically from project list all the projects that were removed. -The value can be a predicate function which takes one argument, and -should return non-nil if the project should be removed. -If set to nil, all the inaccessible projects will not be removed automatically." - :type '(choice (const :tag "Default (remove non-remote projects)" - project-prune-zombies-default) - (const :tag "Remove any project" identity) - (function :tag "Custom function") - (const :tag "Disable auto-deletion" nil)) +(defcustom project-prune-zombie-projects + '((prompt . project-prune-zombies-default)) + "Remove automatically from project list the projects that were removed. +Each element of this alist must be in the form: + (WHEN . PREDICATE) + +where WHEN specifies where the deletion will be performed, +the value can be: + + `list-first-read' - delete on the first reading of the list. + `list-write' - delete after saving project list to `project-list-file'. + `prompt' - delete before every prompting. + `interactively' - delete only when `project-forget-zombie-projects' + is called interactively. + +PREDICATE must be a function which takes one argument, and should return +non-nil if the project must be removed." + :type 'alist + :options '((list-first-read function) + (list-write function) + (prompt function) + (interactively function)) :version "31.1" :group 'project) @@ -2029,10 +2041,10 @@ With some possible metadata (to be decided).") "Initialize `project--list' if it isn't already initialized." (when (eq project--list 'unset) (project--read-project-list) - (if-let* (project-prune-zombie-projects + (if-let* ((pred (alist-get 'list-first-read project-prune-zombie-projects)) ((consp project--list)) (inhibit-message t)) - (project-forget-zombie-projects)))) + (project--delete-zombie-projects pred)))) (defun project--write-project-list () "Save `project--list' in `project-list-file'." @@ -2041,6 +2053,10 @@ With some possible metadata (to be decided).") (insert ";;; -*- lisp-data -*-\n") (let ((print-length nil) (print-level nil)) + (if-let* ((pred (alist-get 'list-write project-prune-zombie-projects)) + ((consp project--list)) + (inhibit-message t)) + (project--delete-zombie-projects pred)) (pp (mapcar (lambda (elem) (let ((name (car elem))) (list (if (file-remote-p name) name @@ -2124,9 +2140,9 @@ function; see `project-prompter' for more details. Unless REQUIRE-KNOWN is non-nil, it's also possible to enter an arbitrary directory not in the list of known projects." (project--ensure-read-project-list) - (if-let* (project-prune-zombie-projects + (if-let* ((pred (alist-get 'prompt project-prune-zombie-projects)) (inhibit-message t)) - (project-forget-zombie-projects)) + (project--delete-zombie-projects pred)) (let* ((dir-choice "... (choose a dir)") (choices ;; XXX: Just using this for the category (for the substring @@ -2165,9 +2181,9 @@ If PREDICATE is non-nil, filter possible project choices using this function; see `project-prompter' for more details. Unless REQUIRE-KNOWN is non-nil, it's also possible to enter an arbitrary directory not in the list of known projects." - (if-let* (project-prune-zombie-projects + (if-let* ((pred (alist-get 'prompt project-prune-zombie-projects)) (inhibit-message t)) - (project-forget-zombie-projects)) + (project--delete-zombie-projects pred)) (let* ((dir-choice "... (choose a dir)") project--name-history (choices @@ -2295,16 +2311,21 @@ Return the number of detected projects." count) count)) count)) -(defun project-forget-zombie-projects () - "Forget all known projects that don't exist any more." - (interactive) +(defun project--delete-zombie-projects (predicate) + "Helper function used by `project-forget-zombie-projects'. +PREDICATE can be a function with 1 argument which determines which +projects should be deleted." (dolist (proj (project-known-project-roots)) - (when (and (if project-prune-zombie-projects - (funcall project-prune-zombie-projects proj) - t) + (when (and (funcall (or predicate #'identity) proj) (not (file-exists-p proj))) (project-forget-project proj)))) +(defun project-forget-zombie-projects (&optional interactive) + "Forget all known projects that don't exist any more." + (interactive (list t)) + (let ((pred (when interactive (alist-get 'interactively project-prune-zombie-projects)))) + (project--delete-zombie-projects pred))) + (defun project-forget-projects-under (dir &optional recursive) "Forget all known projects below a directory DIR. Interactively, prompt for DIR. From 680ef7b5f0bdc1c215a66e165851a07177db7ed0 Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Thu, 21 Aug 2025 11:15:02 -0700 Subject: [PATCH 038/158] Fix 'submit-emacs-patch' MIME type * lisp/mail/emacsbug.el (submit-emacs-patch): Use the correct MIME type for patches. Otherwise, `mm-inline-media-tests' won't recognize and fontify the patch. (Bug#79287) --- lisp/mail/emacsbug.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index d43647a12ca..4872f721aa5 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -587,7 +587,7 @@ Message buffer where you can explain more about the patch." (message-goto-body) (insert "\n\n\n") (emacs-build-description) - (mml-attach-file file "text/patch" nil "attachment") + (mml-attach-file file "text/x-patch" nil "attachment") (message-goto-body) (message "Write a description of the patch and use %s to send it" (substitute-command-keys "\\[message-send-and-exit]")) From a419e92bc6a8e36c14f881b411d3f2d48d1f3b83 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Harald=20J=C3=B6rg?= Date: Fri, 22 Aug 2025 01:26:28 +0200 Subject: [PATCH 039/158] ; cperl-mode.el: Fix fontification error with signatures This fixes the second issue in Bug#79269. * lisp/progmodes/cperl-mode.el (cperl-init-faces): Move handling of signatures with initializers from the "anchor" to the "anchored" matcher * test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl (sub_7): Test case for Bug#79269, wrong face report * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-fontify-attrs-and-signatures): Make sure that the test catches sub_7 for Bug#79269 --- lisp/progmodes/cperl-mode.el | 12 ++++++++---- .../cperl-mode-resources/proto-and-attrs.pl | 7 +++++++ test/lisp/progmodes/cperl-mode-tests.el | 2 +- 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 1e2aca73161..fdb841cfffd 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6374,9 +6374,7 @@ functions (which they are not). Inherits from `default'.") (sequence (eval cperl--signature-rx) (eval cperl--ws*-rx)) ;; ... or the start of a "sloppy" signature - (sequence (eval cperl--sloppy-signature-rx) - ;; arbitrarily continue "a few lines" - (repeat 0 200 (not (in "{")))) + (sequence (eval cperl--sloppy-signature-rx)) ;; make sure we have a reasonably ;; short match for an incomplete sub (not (in ";{(")) @@ -6392,7 +6390,13 @@ functions (which they are not). Inherits from `default'.") (group (eval cperl--basic-variable-rx)))) (progn (goto-char (match-beginning 2)) ; pre-match: Back to sig - (match-end 2)) + ;; While typing, forward-sexp might fail with a scan error. + ;; If so, stop looking for declarations at (match-end 2) + (condition-case nil + (save-excursion + (forward-sexp) + (point)) + (error (match-end 2)))) nil (1 font-lock-variable-name-face))) ;; -------- flow control diff --git a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl index 1f898250252..d95b3d0a453 100644 --- a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl +++ b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl @@ -41,6 +41,13 @@ sub sub_6 { } +# Braces in initializers (Bug79269) +sub sub_7 + ($foo = { }, + $bar //= "baz") +{ +} + # Part 2: Same constructs for anonymous subs # A plain named subroutine without any optional stuff diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 469345e74c9..424e89604b3 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -173,7 +173,7 @@ attributes, prototypes and signatures." (should (equal (get-text-property (match-beginning 0) 'face) 'font-lock-function-name-face)) (let ((start-of-sub (match-beginning 0)) - (end-of-sub (save-excursion (search-forward "}") (point)))) + (end-of-sub (save-excursion (search-forward "}\n") (point)))) ;; Prototypes are shown as strings (when (search-forward-regexp " ([$%@*]*) " end-of-sub t) From 6571b632ed1654a260a609ee3a5e9923dc5c25e3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 22 Aug 2025 09:57:28 +0300 Subject: [PATCH 040/158] ; * admin/MAINTAINERS: Update entries for Dmitry and Spencer. --- admin/MAINTAINERS | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 945e69fc690..b942fb3ba38 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -96,6 +96,10 @@ Dmitry Gutov test/indent/ruby.rb lisp/progmodes/xref.el lisp/progmodes/project.el + lisp/thread.el + src/thread.c + + Thread-related code in src/process.c Ulf Jasper Newsticker @@ -381,6 +385,10 @@ Harald Jörg Spencer Baugh lisp/progmodes/flymake.el + lisp/thread.el + src/thread.c + + Thread-related code in src/process.c Yuan Fu lisp/progmodes/c-ts-mode.el From 384483e26368137bc6d0ffc962235277b886eae3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Harald=20J=C3=B6rg?= Date: Fri, 22 Aug 2025 12:42:00 +0200 Subject: [PATCH 041/158] ; cperl-mode.el: Indent labels only in code (Bug#79271) * lisp/progmodes/cperl-mode.el (cperl-indent-line): Make sure that labels are indented in code only * test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts: Two new testcases for non-indentable "labels" in a regex pattern and a qw list --- lisp/progmodes/cperl-mode.el | 1 + .../cperl-mode-resources/cperl-indents.erts | 22 +++++++++++++++++++ 2 files changed, 23 insertions(+) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index fdb841cfffd..be8f36def58 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -2726,6 +2726,7 @@ PARSE-DATA is used to save status between calls in a loop." (if (listp indent) (setq indent (car indent))) (cond ((and (looking-at (rx (sequence (eval cperl--label-rx) (not (in ":"))))) + (null (get-text-property (point) 'syntax-type)) (not (looking-at (rx (eval cperl--false-label-rx))))) (and (> indent 0) (setq indent (max cperl-min-label-indent diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts index 3a779442a8a..65ce757d048 100644 --- a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts @@ -123,3 +123,25 @@ sub foo ( return $a + $b + $in1; } =-=-= + +Name: cperl-false-label-in-regex + +=-= +# -*- mode: cperl -*- +# John Ciolfi reported as Bug#79271 +my $str =~ s/^ + (Field1: [^\n]+) \s* + Field2: \s* (\S+) \s* + //xsm; +=-=-= + +Name: cperl-false-label-in-qw + +=-= +# Related to cperl-false-label-in-regex / Bug#79271 +my @chunks = qw( + sub + LABEL: + more words + ); +=-=-= From 7658f4c30a2d0f42a7e1c95962236f183c50c967 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 22 Aug 2025 13:18:08 +0200 Subject: [PATCH 042/158] Skip eglot-test-rust-completion-exit-function on emba --- test/lisp/progmodes/eglot-tests.el | 1 + 1 file changed, 1 insertion(+) diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 2b98da4134b..7fd4f0f0491 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -710,6 +710,7 @@ directory hierarchy." ;; This originally appeared in github#1339 (skip-unless (executable-find "rust-analyzer")) (skip-unless (executable-find "cargo")) + (skip-when (getenv "EMACS_EMBA_CI")) (eglot--with-fixture '(("cmpl-project" . (("main.rs" . From 64bb65c7d8897a861d103f609abaa0b8de317a8e Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 22 Aug 2025 14:08:26 +0200 Subject: [PATCH 043/158] ; * admin/MAINTAINERS: Add myself for connection-local variables. --- admin/MAINTAINERS | 2 ++ 1 file changed, 2 insertions(+) diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index b942fb3ba38..c8388f74577 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -327,12 +327,14 @@ Michael Albinus lisp/autorevert.el lisp/eshell/em-tramp.el lisp/files.el (file-name-non-special) + lisp/files-x.el (connection-local variables) lisp/net/ange-ftp.el lisp/notifications.el lisp/shadowfile.el test/infra/* test/lisp/autorevert-tests.el test/lisp/files-tests.el (file-name-non-special) + test/lisp/files-x-tests.el (connection-local variables) test/lisp/shadowfile-tests.el test/src/inotify-test.el From ce9def14c6df39a94958b48250adeda9f50421e5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 22 Aug 2025 14:08:52 +0200 Subject: [PATCH 044/158] Minor tramp.texi changes * doc/misc/tramp.texi (File name syntax): Describe port for IPv6 address. (Traces and Profiles): Fix default value of tramp-debug-buffer-limit. --- doc/misc/tramp.texi | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 182323d0f25..2944978f8ee 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3661,6 +3661,8 @@ behavior: @file{@trampfn{method,user@@host,path/to/file}}. For specifying port numbers, affix @file{#} to the host name. For example: @file{@trampfn{ssh,daniel@@melancholia#42,.emacs}}. +If the host is an IPv6 address, the port is appended like this: +@file{@trampfn{ssh,@value{ipv6prefix}::1@value{ipv6postfix}#42,.emacs}}. All method, user name, host name, port number and local name parts are optional, @xref{Default Method}, @xref{Default User}, @xref{Default Host}. @@ -6924,7 +6926,7 @@ maintainers, analyzing the remote commands for performance analysis. The debug buffer can be very large, if @code{tramp-verbose} is high, and @value{tramp} runs for a long time. If the buffer size exceeds -@code{tramp-debug-buffer-limit} (3GB by default), a warning will be +@code{tramp-debug-buffer-limit} (100MB by default), a warning will be raised. This user option can be adapted to your needs; a value of 0 means that there is no limit (no warning). From bc0202bc8867024a0ddbecf171ed7e9a5341238f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Harald=20J=C3=B6rg?= Date: Fri, 22 Aug 2025 14:59:59 +0200 Subject: [PATCH 045/158] ; cperl-mode.el: Do not warn with valid character escapes See https://github.com/emacs-mirror/emacs/pull/41. This is a one-liner, safely exempt from copyright paperwork. * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): delete valid character escapes from the list which causes warning-face to be applied --- lisp/progmodes/cperl-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index be8f36def58..23ff955f389 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5065,7 +5065,7 @@ recursive calls in starting lines of here-documents." (cperl-postpone-fontification (- (point) 2) (- (point) 1) 'face (if (memq qtag - (append "ghijkmoqvFHIJKMORTVY" nil)) + (append "gijkmoqFIJKMOTY" nil)) 'font-lock-warning-face my-cperl-REx-0length-face)) (if (and (eq (char-after b) qtag) From f3434a4f53f210504554006b598ca4320ad9039e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Aug 2025 11:34:10 +0300 Subject: [PATCH 046/158] Fix line-prefix display when there's a 'display' string at BOL * src/xdisp.c (push_it): Reset the 'string_from_prefix_prop_p' flag. (try_window_id): Disable this optimization if the last unchanged at-beg row begins with a display or overlay string and there;s a line/wrap-prefix property on the row. (push_prefix_prop): Accept an additional argument FROM_BUFFER to indicate that the prefix property was found on buffer text underlying a display or overlay property, and set up the position to pop to accordingly. Reset the 'string_from_display_prop_p' flag of the iterator after pushing IT to set up for iterating the prefix string. (get_it_property): Use it->string, not it->object, as indication that prefix property is on a string. (get_line_prefix_it_property): Accept an additional argument: pointer to a flag indicating that the prefix property was found on buffer text underlying a display or overlay property. Callers adjusted. (handle_line_prefix): Use the FROM_BUFFER flag to correctly handle prefix properties on buffer text at the same position as a display string. (Bug#79275) --- src/xdisp.c | 86 +++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 67 insertions(+), 19 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 2691296b282..b8088f692c4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -7261,6 +7261,8 @@ push_it (struct it *it, struct text_pos *position) p->from_disp_prop_p = it->from_disp_prop_p; ++it->sp; + it->string_from_prefix_prop_p = false; + /* Save the state of the bidi iterator as well. */ if (it->bidi_p) bidi_push_it (&it->bidi_it); @@ -22657,8 +22659,23 @@ try_window_id (struct window *w) /* Give up if the row starts with a display property that draws on the fringes, since that could prevent correct display of line-prefix and wrap-prefix. */ - if (it.sp > 1 + if ((it.sp > 1 && it.method == GET_FROM_IMAGE && it.image_id == -1) + /* Give up if there's a line/wrap-prefix property on buffer + text, and the row begins with a display or overlay string. + This is because in that case the iterator state produced by + init_to_row_end is already set to the display/overlay + string, and thus cannot be used to display the prefix + before the display/overlay string. */ + || (it.sp == 1 + && it.method == GET_FROM_STRING + && !it.string_from_prefix_prop_p + && (!NILP (Fget_char_property (make_fixnum (IT_CHARPOS (it)), + Qline_prefix, + it.w->contents)) + || !NILP (Fget_char_property (make_fixnum (IT_CHARPOS (it)), + Qwrap_prefix, + it.w->contents))))) GIVE_UP (26); start_pos = it.current.pos; @@ -24710,15 +24727,29 @@ cursor_row_p (struct glyph_row *row) /* Push the property PROP so that it will be rendered at the current - position in IT. Return true if PROP was successfully pushed, false - otherwise. Called from handle_line_prefix to handle the - `line-prefix' and `wrap-prefix' properties. */ + position in IT. FROM_BUFFER non-zero means the property was found on + buffer text, even though IT is set to iterate a string. + Return true if PROP was successfully pushed, false otherwise. + Called from handle_line_prefix to handle the `line-prefix' and + `wrap-prefix' properties. */ static bool -push_prefix_prop (struct it *it, Lisp_Object prop) +push_prefix_prop (struct it *it, Lisp_Object prop, int from_buffer) { - struct text_pos pos = - STRINGP (it->string) ? it->current.string_pos : it->current.pos; + struct text_pos pos; + + if (STRINGP (it->string)) + { + if (from_buffer) /* a string, but prefix property from buffer */ + pos = it->current.string_pos; + else /* a string and prefix property from string */ + pos.charpos = pos.bytepos = 0; /* we have yet to iterate that string */ + } + else /* a buffer and prefix property from buffer */ + pos = it->current.pos; + + bool phoney_display_string = + from_buffer && STRINGP (it->string) && it->string_from_display_prop_p; eassert (it->method == GET_FROM_BUFFER || it->method == GET_FROM_DISPLAY_VECTOR @@ -24737,6 +24768,13 @@ push_prefix_prop (struct it *it, Lisp_Object prop) it->position not yet set when this function is called. */ push_it (it, &pos); + /* Reset this flag, since it is not relevant (comes from a display + string that follows iterator position). If we don't do that, any + display properties on the prefix string will be ignored. The call + to pop_it when we are done with the prefix will restore the flag. */ + if (phoney_display_string) + it->string_from_display_prop_p = false; + if (STRINGP (prop)) { if (SCHARS (prop) == 0) @@ -24794,7 +24832,7 @@ push_prefix_prop (struct it *it, Lisp_Object prop) #endif /* HAVE_WINDOW_SYSTEM */ else { - pop_it (it); /* bogus display property, give up */ + pop_it (it); /* bogus prefix property, give up */ return false; } @@ -24806,11 +24844,14 @@ push_prefix_prop (struct it *it, Lisp_Object prop) static Lisp_Object get_it_property (struct it *it, Lisp_Object prop) { - Lisp_Object position, object = it->object; + Lisp_Object position, object; - if (STRINGP (object)) - position = make_fixnum (IT_STRING_CHARPOS (*it)); - else if (BUFFERP (object)) + if (STRINGP (it->string)) + { + position = make_fixnum (IT_STRING_CHARPOS (*it)); + object = it->string; + } + else if (BUFFERP (it->object)) { position = make_fixnum (IT_CHARPOS (*it)); object = it->window; @@ -24825,15 +24866,21 @@ get_it_property (struct it *it, Lisp_Object prop) current IT->OBJECT and the underlying buffer text. */ static Lisp_Object -get_line_prefix_it_property (struct it *it, Lisp_Object prop) +get_line_prefix_it_property (struct it *it, Lisp_Object prop, + int *from_buffer) { Lisp_Object prefix = get_it_property (it, prop); + *from_buffer = false; + /* If we are looking at a display or overlay string, check also the underlying buffer text. */ - if (NILP (prefix) && it->sp > 0 && STRINGP (it->object)) - return Fget_char_property (make_fixnum (IT_CHARPOS (*it)), prop, - it->w->contents); + if (NILP (prefix) && it->sp > 0 && STRINGP (it->string)) + { + *from_buffer = true; + return Fget_char_property (make_fixnum (IT_CHARPOS (*it)), prop, + it->w->contents); + } return prefix; } @@ -24844,21 +24891,22 @@ handle_line_prefix (struct it *it) { Lisp_Object prefix; bool wrap_prop = false; + int from_buffer; if (it->continuation_lines_width > 0) { - prefix = get_line_prefix_it_property (it, Qwrap_prefix); + prefix = get_line_prefix_it_property (it, Qwrap_prefix, &from_buffer); if (NILP (prefix)) prefix = Vwrap_prefix; wrap_prop = true; } else { - prefix = get_line_prefix_it_property (it, Qline_prefix); + prefix = get_line_prefix_it_property (it, Qline_prefix, &from_buffer); if (NILP (prefix)) prefix = Vline_prefix; } - if (! NILP (prefix) && push_prefix_prop (it, prefix)) + if (! NILP (prefix) && push_prefix_prop (it, prefix, from_buffer)) { /* If the prefix is wider than the window, and we try to wrap it, it would acquire its own wrap prefix, and so on till the From 1d88931a1c3ed71f9516f254513b4a91187d5924 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 23 Aug 2025 12:20:02 +0200 Subject: [PATCH 047/158] Minor fixes for file notifications on MS Windows * lisp/filenotify.el (file-notify-rm-all-watches): Clear hash. * test/lisp/filenotify-tests.el (file-notify--test-event-test): Fix check. (file-notify-test09-watched-file-in-watched-dir): Adapt test. --- lisp/filenotify.el | 3 ++- test/lisp/filenotify-tests.el | 8 +++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 311da73a8ef..9e35f5413fb 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -500,7 +500,8 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." (maphash (lambda (key _value) (file-notify-rm-watch key)) - file-notify-descriptors)) + file-notify-descriptors) + (setq file-notify-descriptors (clrhash file-notify-descriptors))) (defun file-notify-valid-p (descriptor) "Check a watch specified by its DESCRIPTOR. diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index e4cd3a27c2d..d1e1ac25007 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -519,8 +519,9 @@ When returning, they are deleted." We cannot pass arguments, so we assume that `file-notify--test-event' and `file-notify--test-file' are bound somewhere." ;; Check the descriptor. - (should (equal (file-notify--test-event-desc file-notify--test-event) - file-notify--test-desc)) + (unless (eq (file-notify--test-event-action file-notify--test-event) 'stopped) + (should (equal (file-notify--test-event-desc file-notify--test-event) + file-notify--test-desc))) ;; Check the file name. (should (string-prefix-p @@ -1439,7 +1440,8 @@ the file watch." (:random deleted deleted deleted stopped)) (delete-file file-notify--test-tmpfile)) (should (file-notify-valid-p file-notify--test-desc1)) - (should-not (file-notify-valid-p file-notify--test-desc2)) + (unless (string-equal (file-notify--test-library) "w32notify") + (should-not (file-notify-valid-p file-notify--test-desc2))) ;; Now we delete the directory. (file-notify--test-with-actions From b3ed4876b63cc61ef803775cfbb6af4776203a2d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Aug 2025 13:44:23 +0300 Subject: [PATCH 048/158] ; Improve documentation of Edebug * doc/lispref/edebug.texi (Edebug Execution Modes, Jumping) (Edebug Misc, Breaks, Breakpoints, Global Break Condition) (Source Breakpoints, Edebug Views, Edebug Eval, Eval List) (Printing in Edebug, Trace Buffer, Coverage Testing) (Checking Whether to Stop, Edebug Display Update) (Edebug Recursive Edit, Edebug and Macros) (Instrumenting Macro Calls, Specification List, Edebug Options): Improve indexing and cross-references. --- doc/lispref/edebug.texi | 179 ++++++++++++++++++++++++++++++---------- 1 file changed, 136 insertions(+), 43 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 0effe48e9a3..813a0d85633 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -256,38 +256,47 @@ commands; all except for @kbd{S} resume execution of the program, at least for a certain distance. @table @kbd +@findex edebug-stop @item S Stop: don't execute any more of the program, but wait for more Edebug commands (@code{edebug-stop}). @c FIXME Does not work. https://debbugs.gnu.org/9764 +@findex edebug-step-mode @item @key{SPC} Step: stop at the next stop point encountered (@code{edebug-step-mode}). +@findex edebug-next-mode @item n Next: stop at the next stop point encountered after an expression (@code{edebug-next-mode}). Also see @code{edebug-forward-sexp} in @ref{Jumping}. +@findex edebug-trace-mode @item t Trace: pause (normally one second) at each Edebug stop point (@code{edebug-trace-mode}). +@findex edebug-Trace-fast-mode @item T Rapid trace: update the display at each stop point, but don't actually pause (@code{edebug-Trace-fast-mode}). +@findex edebug-go-mode @item g Go: run until the next breakpoint (@code{edebug-go-mode}). @xref{Breakpoints}. +@findex edebug-continue-mode @item c Continue: pause one second at each breakpoint, and then continue (@code{edebug-continue-mode}). +@findex edebug-Continue-fast-mode @item C Rapid continue: move point to each breakpoint, but don't pause (@code{edebug-Continue-fast-mode}). +@findex edebug-Go-nonstop-mode @item G Go non-stop: ignore breakpoints (@code{edebug-Go-nonstop-mode}). You can still stop the program by typing @kbd{S}, or any editing command. @@ -345,25 +354,30 @@ in trace mode or continue mode. The default is 1 second. The commands described in this section execute until they reach a specified location. All except @kbd{i} make a temporary breakpoint to -establish the place to stop, then switch to go mode. Any other -breakpoint reached before the intended stop point will also stop -execution. @xref{Breakpoints}, for the details on breakpoints. +establish the place to stop, then switch to go mode (@pxref{Edebug +Execution Modes}). Any other breakpoint reached before the intended +stop point will also stop execution. @xref{Breakpoints}, for the +details on breakpoints. These commands may fail to work as expected in case of nonlocal exit, as that can bypass the temporary breakpoint where you expected the program to stop. @table @kbd +@findex edebug-goto-here @item h Proceed to the stop point near where point is (@code{edebug-goto-here}). +@findex edebug-forward-sexp @item f Run the program for one expression (@code{edebug-forward-sexp}). +@findex edebug-step-out @item o Run the program until the end of the containing sexp (@code{edebug-step-out}). +@findex edebug-step-in @item i Step into the function or macro called by the form after point (@code{edebug-step-in}). @@ -397,7 +411,7 @@ containing sexp is a function definition itself, @kbd{o} continues until just before the last sexp in the definition. If that is where you are now, it returns from the function and then stops. In other words, this command does not exit the currently executing function unless you are -positioned after the last sexp. +positioned after the last sexp of that function. Normally, the @kbd{h}, @kbd{f}, and @kbd{o} commands display ``Break'' and pause for @code{edebug-sit-for-seconds} before showing the result @@ -421,14 +435,17 @@ arrange to deinstrument it. Some miscellaneous Edebug commands are described here. @table @kbd +@findex edebug-help @item ? Display the help message for Edebug (@code{edebug-help}). +@findex abort-recursive-edit @r{(Edebug)} @item a @itemx C-] Abort one level back to the previous command level -(@code{abort-recursive-edit}). +(@code{abort-recursive-edit}). @xref{Recursive Editing}. +@findex top-level @r{(Edebug)} @item q Return to the top level editor command loop (@code{top-level}). This exits all recursive editing levels, including all levels of Edebug @@ -436,14 +453,17 @@ activity. However, instrumented code protected with @code{unwind-protect} or @code{condition-case} forms may resume debugging. +@findex edebug-top-level-nonstop @item Q Like @kbd{q}, but don't stop even for protected code (@code{edebug-top-level-nonstop}). +@findex edebug-previous-result @item r Redisplay the most recently known expression result in the echo area (@code{edebug-previous-result}). +@findex edebug-pop-to-backtrace @item d Display a backtrace, excluding Edebug's own functions for clarity (@code{edebug-pop-to-backtrace}). @@ -473,9 +493,10 @@ display a backtrace of all the pending evaluations with @kbd{d}. @node Breaks @subsection Breaks -Edebug's step mode stops execution when the next stop point is reached. -There are three other ways to stop Edebug execution once it has started: -breakpoints, the global break condition, and source breakpoints. +Edebug's step mode (@pxref{Edebug Execution Modes}) stops execution when +the next stop point is reached. There are three other ways to stop +Edebug execution once it has started: breakpoints, the global break +condition, and source breakpoints. @menu * Breakpoints:: Breakpoints at stop points. @@ -495,6 +516,9 @@ the first one at or after point in the source code buffer. Here are the Edebug commands for breakpoints: @table @kbd +@findex edebug-set-breakpoint +@vindex edebug-enabled-breakpoint @r{(face)} +@vindex edebug-disabled-breakpoint @r{(face)} @item b Set a breakpoint at the stop point at or after point (@code{edebug-set-breakpoint}). If you use a prefix argument, the @@ -502,26 +526,34 @@ breakpoint is temporary---it turns off the first time it stops the program. An overlay with the @code{edebug-enabled-breakpoint} or @code{edebug-disabled-breakpoint} faces is put at the breakpoint. +@findex edebug-unset-breakpoint @item u Unset the breakpoint (if any) at the stop point at or after point (@code{edebug-unset-breakpoint}). +@findex edebug-unset-breakpoints @item U Unset any breakpoints in the current form (@code{edebug-unset-breakpoints}). +@findex edebug-toggle-disable-breakpoint @item D Toggle whether to disable the breakpoint near point (@code{edebug-toggle-disable-breakpoint}). This command is mostly useful if the breakpoint is conditional and it would take some work to recreate the condition. +@findex edebug-set-conditional-breakpoint @item x @var{condition} @key{RET} Set a conditional breakpoint which stops the program only if evaluating @var{condition} produces a non-@code{nil} value (@code{edebug-set-conditional-breakpoint}). With a prefix argument, the breakpoint is temporary. +@item X @var{condition} @key{RET} +Set @code{edebug-global-break-condition} to @var{condition}. + +@findex edebug-next-breakpoint @item B Move point to the next breakpoint in the current definition (@code{edebug-next-breakpoint}). @@ -542,6 +574,8 @@ conditional breakpoint, use @kbd{x}, and specify the condition expression in the minibuffer. Setting a conditional breakpoint at a stop point that has a previously established conditional breakpoint puts the previous condition expression in the minibuffer so you can edit it. +(You can also use @kbd{X} to set the global break condition, to be +evaluated at every stop point, @pxref{Global Break Condition}.) You can make a conditional or unconditional breakpoint @dfn{temporary} by using a prefix argument with the command to set the @@ -566,8 +600,9 @@ point in the buffer. condition is satisfied, no matter where that may occur. Edebug evaluates the global break condition at every stop point; if it evaluates to a non-@code{nil} value, then execution stops or pauses -depending on the execution mode, as if a breakpoint had been hit. If -evaluating the condition gets an error, execution does not stop. +depending on the execution mode (@pxref{Edebug Execution Modes}), as if +a breakpoint had been hit. If evaluating the condition gets an error, +execution does not stop. @findex edebug-set-global-break-condition The condition expression is stored in @@ -603,7 +638,8 @@ argument reaches zero: When the @code{fac} definition is instrumented and the function is called, the call to @code{edebug} acts as a breakpoint. Depending on -the execution mode, Edebug stops or pauses there. +the execution mode (@pxref{Edebug Execution Modes}), Edebug stops or +pauses there. If no instrumented code is being executed when @code{edebug} is called, that function calls @code{debug}. @@ -640,17 +676,20 @@ configuration is the collection of windows and contents that were in effect outside of Edebug. @table @kbd +@findex edebug-view-outside @item P @itemx v Switch to viewing the outside window configuration (@code{edebug-view-outside}). Type @kbd{C-x X w} to return to Edebug. +@findex edebug-bounce-point @item p Temporarily display the outside current buffer with point at its outside position (@code{edebug-bounce-point}), pausing for one second before returning to Edebug. With a prefix argument @var{n}, pause for @var{n} seconds instead. +@findex edebug-where @item w Move point back to the current stop point in the source code buffer (@code{edebug-where}). @@ -659,6 +698,7 @@ If you use this command in a different window displaying the same buffer, that window will be used instead to display the current definition in the future. +@findex edebug-toggle-save-windows @item W @c Its function is not simply to forget the saved configuration -- dan Toggle whether Edebug saves and restores the outside window @@ -697,6 +737,7 @@ explicitly saves and restores. @xref{The Outside Context}, for details on this process. @table @kbd +@findex edebug-eval-expression @item e @var{exp} @key{RET} Evaluate expression @var{exp} in the context outside of Edebug (@code{edebug-eval-expression}). That is, Edebug tries to minimize @@ -707,37 +748,47 @@ pretty-print the result there. By default, this command suppresses the debugger during evaluation, so that an error in the evaluated expression won't add a new error on top of the existing one. -Set the @code{debug-allow-recursive-debug} user option to a -non-@code{nil} value to override this. +Set the @code{debug-allow-recursive-debug} user option (@pxref{Error +Debugging}) to a non-@code{nil} value to override this. +@findex eval-expression @r{(Edebug)} @item M-: @var{exp} @key{RET} Evaluate expression @var{exp} in the context of Edebug itself (@code{eval-expression}). +@findex edebug-eval-last-sexp @item C-x C-e Evaluate the expression before point, in the context outside of Edebug -(@code{edebug-eval-last-sexp}). With the prefix argument of zero -(@kbd{C-u 0 C-x C-e}), don't shorten long items (like strings and -lists). Any other prefix will result in the value being -pretty-printed in a separate buffer. +(@code{edebug-eval-last-sexp}) and show the value in the minibuffer. +With the prefix argument of zero (@kbd{C-u 0 C-x C-e}), don't shorten +long items (like strings and lists) when showing the value, due to +@code{edebug-print-length} and @code{edebug-print-level} +(@pxref{Printing in Edebug}). Any other prefix will result in the value +being pretty-printed in a separate buffer instead of the minibuffer. @end table +@xref{Eval List}, for additional Edebug features related to evaluating +lists of expressions interactively. + @cindex lexical binding (Edebug) +@findex cl-macrolet @r{(Edebug)} +@findex cl-symbol-macrolet @r{(Edebug)} Edebug supports evaluation of expressions containing references to lexically bound symbols created by the following constructs in -@file{cl.el}: @code{lexical-let}, @code{macrolet}, and -@code{symbol-macrolet}. +@file{cl-lib.el}: @code{cl-macrolet} and @code{cl-symbol-macrolet}. @c FIXME? What about lexical-binding = t? @node Eval List @subsection Evaluation List Buffer +@cindex evaluation list buffer You can use the @dfn{evaluation list buffer}, called @file{*edebug*}, to evaluate expressions interactively. You can also set up the @dfn{evaluation list} of expressions to be evaluated automatically each time Edebug updates the display. @table @kbd +@findex edebug-visit-eval-list @item E Switch to the evaluation list buffer @file{*edebug*} (@code{edebug-visit-eval-list}). @@ -748,20 +799,25 @@ Interaction mode (@pxref{Lisp Interaction,,, emacs, The GNU Emacs Manual}) as well as these special commands: @table @kbd +@findex edebug-eval-print-last-sexp @item C-j Evaluate the expression before point, in the outside context, and insert the value in the buffer (@code{edebug-eval-print-last-sexp}). With prefix argument of zero (@kbd{C-u 0 C-j}), don't shorten long -items (like strings and lists). +items (like strings and lists) due to @code{edebug-print-length} and +@code{edebug-print-level} (@pxref{Printing in Edebug}). +@findex edebug-eval-last-sexp @item C-x C-e Evaluate the expression before point, in the context outside of Edebug (@code{edebug-eval-last-sexp}). +@findex edebug-update-eval-list @item C-c C-u Build a new evaluation list from the contents of the buffer (@code{edebug-update-eval-list}). +@findex edebug-delete-eval-item @item C-c C-d Delete the evaluation list group that point is in (@code{edebug-delete-eval-item}). @@ -804,24 +860,36 @@ not interrupt your debugging. several expressions have been added to it: @smallexample +@group (current-buffer) # ;--------------------------------------------------------------- +@end group +@group (selected-window) # ;--------------------------------------------------------------- +@end group +@group (point) 196 ;--------------------------------------------------------------- +@end group +@group bad-var "Symbol's value as variable is void: bad-var" ;--------------------------------------------------------------- +@end group +@group (recursion-depth) 0 ;--------------------------------------------------------------- +@end group +@group this-command eval-last-sexp ;--------------------------------------------------------------- +@end group @end smallexample To delete a group, move point into it and type @kbd{C-c C-d}, or simply @@ -832,8 +900,9 @@ the expression at a suitable place, insert a new comment line, then type contents don't matter. After selecting @file{*edebug*}, you can return to the source code -buffer with @kbd{C-c C-w}. The @file{*edebug*} buffer is killed when -you continue execution, and recreated next time it is needed. +buffer with @kbd{C-c C-w} (@pxref{Edebug Views}). The @file{*edebug*} +buffer is killed when you continue execution, and recreated next time it +is needed. @node Printing in Edebug @subsection Printing in Edebug @@ -867,8 +936,10 @@ to a non-@code{nil} value. Here is an example of code that creates a circular structure: @example +@group (setq a (list 'x 'y)) (setcar a a) +@end group @end example @noindent @@ -890,11 +961,14 @@ printing results. The default value is @code{t}. @node Trace Buffer @subsection Trace Buffer @cindex trace buffer +@cindex Edebug trace buffer +@cindex tracing in Edebug Edebug can record an execution trace, storing it in a buffer named @file{*edebug-trace*}. This is a log of function calls and returns, showing the function names and their arguments and values. To enable -trace recording, set @code{edebug-trace} to a non-@code{nil} value. +trace recording, set @code{edebug-trace} to a non-@code{nil} value +(@pxref{Edebug Options}). Making a trace buffer is not the same thing as using trace execution mode (@pxref{Edebug Execution Modes}). @@ -925,7 +999,7 @@ value of the last form in @var{body}. @defun edebug-trace format-string &rest format-args This function inserts text in the trace buffer. It computes the text -with @code{(apply 'format @var{format-string} @var{format-args})}. +with @w{@code{(apply 'format @var{format-string} @var{format-args})}}. It also appends a newline to separate entries. @end defun @@ -952,10 +1026,10 @@ correctly; Edebug will tell you when you have tried enough different conditions that each form has returned two different values. Coverage testing makes execution slower, so it is only done if -@code{edebug-test-coverage} is non-@code{nil}. Frequency counting is -performed for all executions of an instrumented function, even if the -execution mode is Go-nonstop, and regardless of whether coverage testing -is enabled. +@code{edebug-test-coverage} is non-@code{nil} (@pxref{Edebug Options}). +Frequency counting is performed for all executions of an instrumented +function, even if the execution mode is Go-nonstop, and regardless of +whether coverage testing is enabled. @kindex C-x X = @findex edebug-temp-display-freq-count @@ -988,6 +1062,7 @@ breakpoint, and setting @code{edebug-test-coverage} to @code{t}, when the breakpoint is reached, the frequency data looks like this: @example +@group (defun fac (n) (if (= n 0) (edebug)) ;#6 1 = =5 @@ -996,7 +1071,8 @@ the breakpoint is reached, the frequency data looks like this: (* n (fac (1- n))) ;# 5 0 1)) -;# 0 +a;# 0 +@end group @end example The comment lines show that @code{fac} was called 6 times. The @@ -1037,15 +1113,19 @@ using Edebug. You can also enlarge the value of @code{edebug-max-depth} if Edebug reaches the limit of recursion depth instrumenting code that contains very large quoted lists. +@vindex executing-kbd-macro @r{(Edebug)} @item The state of keyboard macro execution is saved and restored. While Edebug is active, @code{executing-kbd-macro} is bound to @code{nil} -unless @code{edebug-continue-kbd-macro} is non-@code{nil}. +unless @code{edebug-continue-kbd-macro} is non-@code{nil} (@pxref{Edebug +Options}). @end itemize @node Edebug Display Update @subsubsection Edebug Display Update +@cindex Edebug and display updates +@cindex display updates, and Edebug @c This paragraph is not filled, because LaLiberte's conversion script @c needs an xref to be on just one line. @@ -1066,13 +1146,13 @@ following data (though some of them are deliberately not restored if an error or quit signal occurs). @itemize @bullet -@item @cindex current buffer point and mark (Edebug) +@item Which buffer is current, and the positions of point and the mark in the current buffer, are saved and restored. -@item @cindex window configuration (Edebug) +@item The outside window configuration is saved and restored if @code{edebug-save-windows} is non-@code{nil} (@pxref{Edebug Options}). If the value of @code{edebug-save-windows} is a list, only the listed @@ -1086,7 +1166,7 @@ The window start and horizontal scrolling of the source code buffer are not restored, however, so that the display remains coherent within Edebug. @cindex buffer point changed by Edebug -@cindex edebug overwrites buffer point position +@cindex Edebug overwrites buffer point position Saving and restoring the outside window configuration can sometimes change the positions of point in the buffers on which the Lisp program you are debugging operates, especially if your program moves point. @@ -1098,11 +1178,14 @@ set @code{edebug-save-windows} to @code{nil} The value of point in each displayed buffer is saved and restored if @code{edebug-save-displayed-buffer-points} is non-@code{nil}. +@vindex overlay-arrow-position @r{(Edebug)} +@vindex overlay-arrow-string @r{(Edebug)} @item The variables @code{overlay-arrow-position} and @code{overlay-arrow-string} are saved and restored, so you can safely invoke Edebug from the recursive edit elsewhere in the same buffer. +@vindex cursor-in-echo-area @r{(Edebug)} @item @code{cursor-in-echo-area} is locally bound to @code{nil} so that the cursor shows up in the window. @@ -1110,6 +1193,8 @@ the cursor shows up in the window. @node Edebug Recursive Edit @subsubsection Edebug Recursive Edit +@cindex Edebug and recursive edit +@cindex recursive edit, and Edebug When Edebug is entered and actually reads commands from the user, it saves (and later restores) these additional data: @@ -1156,6 +1241,8 @@ Edebug is active, @code{defining-kbd-macro} is bound to @node Edebug and Macros @subsection Edebug and Macros +@cindex Edebug and macros +@cindex macros, debugging with Edebug To make Edebug properly instrument expressions that call macros, some extra care is needed. This subsection explains the details. @@ -1179,23 +1266,26 @@ time later.) Therefore, you must define an Edebug specification for each macro that Edebug will encounter, to explain the format of calls to that -macro. To do this, add a @code{debug} declaration to the macro -definition. Here is a simple example that shows the specification for -the @code{for} example macro (@pxref{Argument Evaluation}). +macro. To do this, add a @code{debug} declaration (@pxref{Declare +Form}) to the macro definition. Here is a simple example that shows the +specification for the @code{for} example macro (@pxref{Argument +Evaluation}). @smallexample +@group (defmacro for (var from init to final do &rest body) "Execute a simple \"for\" loop. For example, (for i from 1 to 10 do (print i))." (declare (debug (symbolp "from" form "to" form "do" &rest form))) ...) +@end group @end smallexample The Edebug specification says which parts of a call to the macro are forms to be evaluated. For simple macros, the specification often looks very similar to the formal argument list of the macro definition, but specifications are much more general than macro -arguments. @xref{Defining Macros}, for more explanation of +arguments. @xref{Declare Form}, for more details about the @code{declare} form. @c See, e.g., https://debbugs.gnu.org/10577 @@ -1259,6 +1349,7 @@ are instrumented. @subsubsection Specification List @cindex Edebug specification list +@cindex specification list, Edebug A @dfn{specification list} is required for an Edebug specification if some arguments of a macro call are evaluated while others are not. Some elements in a specification list match one or more arguments, but others @@ -1365,12 +1456,12 @@ This is successful when there are no more arguments to match at the current argument list level; otherwise it fails. See sublist specifications and the backquote example. +@cindex preventing backtracking, in Edebug specification list @item gate -@cindex preventing backtracking No argument is matched but backtracking through the gate is disabled while matching the remainder of the specifications at this level. This -is primarily used to generate more specific syntax error messages. See -@ref{Backtracking}, for more details. Also see the @code{let} example. +is primarily used to generate more specific syntax error messages. +@xref{Backtracking}, for more details. Also see the @code{let} example. @item &error @code{&error} should be followed by a string, an error message, in the @@ -1392,8 +1483,8 @@ sexps whose first element is a symbol and then lets with that head symbol according to @code{pcase--match-pat-args} and pass them to the @var{pf} it received as argument. -@item @var{other-symbol} @cindex indirect specifications +@item @var{other-symbol} Any other symbol in a specification list may be a predicate or an indirect specification. @@ -1415,8 +1506,8 @@ specification fails and the argument is not instrumented. Some suitable predicates include @code{symbolp}, @code{integerp}, @code{stringp}, @code{vectorp}, and @code{atom}. -@item [@var{elements}@dots{}] @cindex [@dots{}] (Edebug) +@item [@var{elements}@dots{}] A vector of elements groups the elements into a single @dfn{group specification}. Its meaning has nothing to do with vectors. @@ -1477,8 +1568,8 @@ The argument, a symbol, is the name of an argument of the defining form. However, lambda-list keywords (symbols starting with @samp{&}) are not allowed. -@item lambda-list @cindex lambda-list (Edebug) +@item lambda-list This matches a lambda list---the argument list of a lambda expression. @item def-body @@ -1798,6 +1889,7 @@ a breakpoint. Set to @code{nil} to prevent the pause, non-@code{nil} to allow it. @end defopt +@cindex Edebug, changing behavior with instrumented code @defopt edebug-behavior-alist By default, this alist contains one entry with the key @code{edebug} and a list of three functions, which are the default implementations @@ -1805,6 +1897,7 @@ of the functions inserted in instrumented code: @code{edebug-enter}, @code{edebug-before} and @code{edebug-after}. To change Edebug's behavior globally, modify the default entry. +@vindex edebug-behavior, symbol property Edebug's behavior may also be changed on a per-definition basis by adding an entry to this alist, with a key of your choice and three functions. Then set the @code{edebug-behavior} symbol property of an From 60a2923d50e0dd802cfb131e06506ec7834ac0af Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Aug 2025 14:25:06 +0300 Subject: [PATCH 049/158] ; * lisp/play/doctor.el (llm): Add. --- lisp/play/doctor.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index b3ddabf9823..0e75bd108eb 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -589,6 +589,7 @@ reads the sentence before point, and prints the Doctor's answer." (doctor-put-meaning pc 'mach) (doctor-put-meaning gnu 'mach) (doctor-put-meaning linux 'mach) +(doctor-put-meaning llm 'mach) (doctor-put-meaning bitching 'foul) (doctor-put-meaning shit 'foul) (doctor-put-meaning bastard 'foul) From aae9eddb58a618d9a90dcd4232688b31b0df9f81 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Fri, 15 Aug 2025 10:13:16 -0400 Subject: [PATCH 050/158] flymake: stop trying to automatically fall back to margins The code to automatically fallback to margins is not correct: it relies implicitly on the buffer being displayed in a window while flymake-mode is running. If the buffer is created while not displayed, we will always automatically fallback to margins, which is incorrect. Avoid the regression by simply disabling this code. I'll try again to fall back automatically in the future. (Bug#79244) * doc/misc/flymake.texi (Customizable variables): Remove section about automatic fallback to margins. * etc/NEWS: Un-announce removed feature. * lisp/progmodes/flymake.el (flymake-indicator-type) (flymake-mode): Stop automatically falling back to margins. (bug#77313) --- doc/misc/flymake.texi | 6 ++---- etc/NEWS | 5 ----- lisp/progmodes/flymake.el | 9 --------- 3 files changed, 2 insertions(+), 18 deletions(-) diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index d6c8778d785..cc364813f8b 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -316,10 +316,8 @@ reported. The indicator type which Flymake should use to indicate lines with errors or warnings. Depending on your preference, this can either use @code{fringes} or -@code{margins} for indicating errors. -If set to @code{fringes} (the default), it will automatically fall back -to using margins in windows or frames without fringes, such as text -terminals. +@code{margins} for indicating errors. On text terminals, only +@code{margins} is available. @item flymake-error-bitmap A bitmap used in the fringe to mark lines for which an error has diff --git a/etc/NEWS b/etc/NEWS index 99026f936b6..27244565d19 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2496,11 +2496,6 @@ file names in above buffers. The default is nil. --- ** Flymake -*** Windows without fringes now automatically use margin indicators. -When 'flymake-indicator-type' is set to 'fringes', as is now the default, -flymake will automatically fall back to using margin indicators in -windows without fringes, including any window on a text terminal. - *** Enhanced 'flymake-show-diagnostics-at-end-of-line' The new value 'fancy' allowed for this user option will attempt to layout diagnostics below the affected line using unicode graphics to diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index c5380a9bb64..8b6d477c385 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -195,8 +195,6 @@ margins). Difference between fringes and margin is that fringes support displaying bitmaps on graphical displays and margins display text in a blank area from current buffer that works in both graphical and text displays. -Thus, even when `fringes' is selected, margins will still be used on -text displays and also when fringes are disabled. See Info node `Fringes' and Info node `(elisp)Display Margins'." :version "31.1" @@ -1496,13 +1494,6 @@ special *Flymake log* buffer." :group 'flymake :lighter (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) (add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t) - (when (and (eq flymake-indicator-type 'fringes) - (not (cl-case flymake-fringe-indicator-position - (left-fringe (< 0 (nth 0 (window-fringes)))) - (right-fringe (< 0 (nth 1 (window-fringes))))))) - ;; There are no fringes in the buffer, fallback to margins. - (setq-local flymake-indicator-type 'margins)) - ;; AutoResize margins. (flymake--resize-margins) From 45bc42bddfe8d9376ede6e71e4ddccb02c3d45a3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Aug 2025 14:55:09 +0300 Subject: [PATCH 051/158] Rmail can fetch email from several inboxes with different passwords * lisp/mail/rmail.el (rmail--remote-password-host) (rmail--remote-password-user): New variables. (rmail-get-remote-password): Use them to ask for the password whenever we need to fetch email from an inbox whose user or host are different from the last ones. (Bug#79214) --- lisp/mail/rmail.el | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 41b0813707f..b8aa937aec2 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4515,6 +4515,11 @@ TEXT and INDENT are not used." ;; to "prying eyes." Obviously, this encoding isn't "real security," ;; nor is it meant to be. +(defvar rmail--remote-password-host nil + "Last recorded value of the HOST argument to `rmail-get-remote-password'.") +(defvar rmail--remote-password-user nil + "Last recorded value of the USER argument to `rmail-get-remote-password'.") + ;;;###autoload (defun rmail-set-remote-password (password) "Set PASSWORD to be used for retrieving mail from a POP or IMAP server." @@ -4535,7 +4540,12 @@ machine mymachine login myloginname password mypassword If auth-source search yields no result, prompt the user for the password." - (when (not rmail-encoded-remote-password) + (when (or (not rmail-encoded-remote-password) + (not (equal user rmail--remote-password-user)) + (not (equal host rmail--remote-password-host))) + ;; Record the values we will be using from now on. + (setq rmail--remote-password-host host + rmail--remote-password-user user) (if (not rmail-remote-password) (setq rmail-remote-password (let ((found (nth 0 (auth-source-search From 8e9277042c73b9029c84917ac0021f8f6aeefa3b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Aug 2025 15:09:31 +0300 Subject: [PATCH 052/158] Use better temporary file names under 'file-precious-flag' * lisp/files.el (basic-save-buffer-2): Use a more meaningful temporary file name under 'file-precious-flag'. (Bug#79252) * etc/NEWS: Announce the change in behavior. --- etc/NEWS | 9 +++++++++ lisp/files.el | 8 +++++++- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 27244565d19..f88f7b9e23e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -709,6 +709,15 @@ to the value 'fill-region-as-paragraph-semlf' to enable functions like 'fill-paragraph' and 'fill-region' to fill text using "semantic linefeeds". +--- +** Temporary files are named differently when 'file-precious-flag' is set. +When the user option 'file-precious-flag' is set to a non-nil value, +Emacs now names the temporary file it creates while saving buffers using +the original file name with ".tmp" appended to it. Thus, if saving the +buffer fails for some reason, and the temporary file is not renamed back +to the original file's name, you can easily identify which file's saving +failed. + +++ ** 'C-u C-x .' clears the fill prefix. You can now use 'C-u C-x .' to clear the fill prefix, similarly to how diff --git a/lisp/files.el b/lisp/files.el index 84e9254ca46..3e85244e4e9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6245,7 +6245,13 @@ Before and after saving the buffer, this function runs ;; for saving the buffer. (setq tempname (make-temp-file - (expand-file-name "tmp" dir))) + ;; The MSDOS 8+3 restricted namespace cannot be + ;; relied upon to produce a different file name + ;; if we append ".tmp". + (if (and (eq system-type 'ms-dos) + (not (msdos-long-file-names))) + (expand-file-name "tmp" dir) + (concat buffer-file-name ".tmp")))) ;; Pass in nil&nil rather than point-min&max ;; cause we're saving the whole buffer. ;; write-region-annotate-functions may use it. From 5d23fc9467ebc26a93c1b5bc45bf26026b9319cb Mon Sep 17 00:00:00 2001 From: Jeremy Bryant Date: Fri, 22 Aug 2025 21:57:30 +0100 Subject: [PATCH 053/158] * doc/lispref/control.texi (cond* Macro): Update bind* entry Update manual to match docstring of (bind*) clause, including the qualifier `all subsequent clauses'. (Bug#79246) --- doc/lispref/control.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 4d00d27bd46..8df8cd215f5 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1489,8 +1489,8 @@ Each clause normally has the form @w{@code{(@var{condition} @findex bind* @code{(bind* @var{bindings}@dots{})} means to bind @var{bindings} (like the bindings list in @code{let*}, @pxref{Local Variables}) for the body -of the clause. As a condition, it counts as true if the first binding's -value is non-@code{nil}. +of the clause, and all subsequent clauses. As a condition, it counts as +true if the first binding's value is non-@code{nil}. @findex match* @findex pcase* From 90c44826f545f71f0f7621c33eff0e5ec5ec4ffc Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Aug 2025 16:33:45 +0300 Subject: [PATCH 054/158] Improve and clarify documentation of 'dired-click-to-select-mode' * lisp/dired.el (dired-click-to-select-mode) (dired-post-do-command): * doc/emacs/dired.texi (Marks vs Flags): Improve documentation of 'dired-click-to-select-mode'. --- doc/emacs/dired.texi | 14 +++++++------- lisp/dired.el | 19 ++++++++++++------- 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 602c8e5bfb2..e49823384ce 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -702,14 +702,14 @@ the directory. @kindex touchscreen-hold @r{(Dired)} @findex dired-click-to-select-mode @findex dired-enable-click-to-select-mode -Enter a ``click to select'' mode, where using the mouse button -@kbd{mouse-2} on a file name will cause its mark to be toggled. This -mode is useful when performing file management using a touch screen -device. +Enter a ``click to select'' mode (@code{dired-click-to-select-mode}), +where using the mouse button @kbd{mouse-2} on a file name will cause its +mark to be toggled. This mode is useful when performing file management +using a touch screen device. -It is enabled when a ``hold'' gesture (@pxref{Touchscreens}) is -detected over a file name, and is automatically disabled once a Dired -command operates on the marked files. +It is enabled when a ``hold'' gesture (@pxref{Touchscreens}) is detected +over a file name, and is automatically disabled once a Dired command +that operates on the marked files finishes. @end table @node Operating on Files diff --git a/lisp/dired.el b/lisp/dired.el index 103c273ccfd..996ca9c23bb 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4057,7 +4057,10 @@ non-empty directories is allowed." (message "(No deletions requested)"))))) (defun dired-post-do-command () - "Disable `dired-click-to-select-mode' after an operation." + "Disable `dired-click-to-select-mode' if enabled.. +This is called after Dired finishes an operation on marked files, and it +disables `dired-click-to-select-mode' that is automatically enabled +by the \"hold\" touch-screen gestures." (when dired-click-to-select-mode (dired-click-to-select-mode -1))) @@ -5381,12 +5384,14 @@ When this minor mode is enabled, using `mouse-2' on a file name within a Dired buffer will toggle its mark instead of going to it within another window. -Disabling this minor mode will unmark all files within the Dired -buffer. - -`dired-click-to-select-mode' is automatically disabled after any -Dired operation (command whose name starts with `dired-do') -completes." +This minor mode is intended to be used when performing file management +using a touch-screen device. The mode is automatically enabled when a +\"hold\" gesture over a file name is received, and is therefore +automatically disabled after any Dired operation on the marked +files (any command whose name starts with \"dired-do-\" and which +performs some operation on the marked files) completes. When the mode +is automatically disabled, it unmarks all the marked files in the Dired +buffer." :group 'dired :lighter " Click-To-Select" (unless (derived-mode-p '(dired-mode wdired-mode)) From 26329bed6e8863dd2586000104f06c788c6f86a3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Aug 2025 16:34:43 +0300 Subject: [PATCH 055/158] ; * etc/symbol-releases.eld (dired-click-to-select-mode): Add. --- etc/symbol-releases.eld | 2 ++ 1 file changed, 2 insertions(+) diff --git a/etc/symbol-releases.eld b/etc/symbol-releases.eld index 9732f60fc16..3c666423cc0 100644 --- a/etc/symbol-releases.eld +++ b/etc/symbol-releases.eld @@ -9,6 +9,8 @@ ;; TYPE being `fun' or `var'. ( + ("30.1" fun dired-click-to-select-mode) + ("30.1" var dired-click-to-select-mode) ("29.1" fun plistp) ("29.1" fun help-key) ("28.1" fun always) From eabb5f450c85afead99d7613d621dbd402d9e914 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Aug 2025 16:33:45 +0300 Subject: [PATCH 056/158] Improve and clarify documentation of 'dired-click-to-select-mode' * lisp/dired.el (dired-click-to-select-mode) (dired-post-do-command): * doc/emacs/dired.texi (Marks vs Flags): Improve documentation of 'dired-click-to-select-mode'. (cherry picked from commit 90c44826f545f71f0f7621c33eff0e5ec5ec4ffc) --- doc/emacs/dired.texi | 14 +++++++------- lisp/dired.el | 19 ++++++++++++------- 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 8882049dae1..53cbcd65c10 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -693,14 +693,14 @@ the directory. @kindex touchscreen-hold @r{(Dired)} @findex dired-click-to-select-mode @findex dired-enable-click-to-select-mode -Enter a ``click to select'' mode, where using the mouse button -@kbd{mouse-2} on a file name will cause its mark to be toggled. This -mode is useful when performing file management using a touch screen -device. +Enter a ``click to select'' mode (@code{dired-click-to-select-mode}), +where using the mouse button @kbd{mouse-2} on a file name will cause its +mark to be toggled. This mode is useful when performing file management +using a touch screen device. -It is enabled when a ``hold'' gesture (@pxref{Touchscreens}) is -detected over a file name, and is automatically disabled once a Dired -command operates on the marked files. +It is enabled when a ``hold'' gesture (@pxref{Touchscreens}) is detected +over a file name, and is automatically disabled once a Dired command +that operates on the marked files finishes. @end table @node Operating on Files diff --git a/lisp/dired.el b/lisp/dired.el index 0a07339e146..cca6fb2e6ea 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3982,7 +3982,10 @@ non-empty directories is allowed." (message "(No deletions requested)"))))) (defun dired-post-do-command () - "Disable `dired-click-to-select-mode' after an operation." + "Disable `dired-click-to-select-mode' if enabled.. +This is called after Dired finishes an operation on marked files, and it +disables `dired-click-to-select-mode' that is automatically enabled +by the \"hold\" touch-screen gestures." (when dired-click-to-select-mode (dired-click-to-select-mode -1))) @@ -5308,12 +5311,14 @@ When this minor mode is enabled, using `mouse-2' on a file name within a Dired buffer will toggle its mark instead of going to it within another window. -Disabling this minor mode will unmark all files within the Dired -buffer. - -`dired-click-to-select-mode' is automatically disabled after any -Dired operation (command whose name starts with `dired-do') -completes." +This minor mode is intended to be used when performing file management +using a touch-screen device. The mode is automatically enabled when a +\"hold\" gesture over a file name is received, and is therefore +automatically disabled after any Dired operation on the marked +files (any command whose name starts with \"dired-do-\" and which +performs some operation on the marked files) completes. When the mode +is automatically disabled, it unmarks all the marked files in the Dired +buffer." :group 'dired :lighter " Click-To-Select" (unless (derived-mode-p '(dired-mode wdired-mode)) From d3d93bc3825e7ee4319330f81c59ae249eba2e25 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Aug 2025 10:34:23 -0400 Subject: [PATCH 057/158] ; * lisp/ldefs-boot.el: Update. --- lisp/ldefs-boot.el | 220 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 190 insertions(+), 30 deletions(-) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 10328165450..e1f62222e9a 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -6,7 +6,8 @@ ;;; Commentary: ;; This file will be copied to ldefs-boot.el and checked in -;; periodically. +;; periodically. Note: When checking in ldefs-boot.el, don't include +;; changes to any other files in the commit. ;;; Code: @@ -1563,6 +1564,8 @@ disabled. ;;; Generated autoloads from autorevert.el +(defvar auto-revert-buffer-in-progress nil "\ +Non-nil if a `auto-revert-buffer' operation is in progress, nil otherwise.") (autoload 'auto-revert-mode "autorevert" "\ Toggle reverting buffer when the file changes (Auto-Revert Mode). @@ -2982,6 +2985,7 @@ This function attempts to use file contents to determine whether the code is C or C++, and based on that chooses whether to enable `c-ts-mode' or `c++-ts-mode'." t) (make-obsolete 'c-or-c++-ts-mode 'c-or-c++-mode "30.1") +(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(c-mode . c-ts-mode)) (add-to-list 'treesit-major-mode-remap-alist '(c++-mode . c++-ts-mode)) (add-to-list 'treesit-major-mode-remap-alist '(c-or-c++-mode . c-or-c++-ts-mode))) (register-definition-prefixes "c-ts-mode" '("c-ts-")) @@ -4699,6 +4703,11 @@ For use inside Lisp programs, see also `c-macro-expansion'. Major mode for editing CMake files, powered by tree-sitter. (fn)" t) +(autoload 'cmake-ts-mode-maybe "cmake-ts-mode" "\ +Enable `cmake-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name.") +(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(cmake-mode . cmake-ts-mode))) (register-definition-prefixes "cmake-ts-mode" '("cmake-ts-mode-")) @@ -5923,6 +5932,7 @@ Key bindings: Major mode for editing C# code. (fn)" t) +(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(csharp-mode . csharp-ts-mode))) (register-definition-prefixes "csharp-mode" '("codedoc-font-lock-" "csharp-")) @@ -5952,6 +5962,7 @@ can also be used to fill comments. \\{css-mode-map} (fn)" t) +(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(css-mode . css-ts-mode))) (autoload 'css-mode "css-mode" "\ Major mode to edit Cascading Style Sheets (CSS). \\ @@ -8385,6 +8396,11 @@ disabled. Major mode for editing Dockerfiles, powered by tree-sitter. (fn)" t) +(autoload 'dockerfile-ts-mode-maybe "dockerfile-ts-mode" "\ +Enable `dockerfile-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name.") +(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . dockerfile-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(dockerfile-mode . dockerfile-ts-mode))) (register-definition-prefixes "dockerfile-ts-mode" '("dockerfile-ts-mode--")) @@ -8534,6 +8550,7 @@ INIT-VALUE LIGHTER KEYMAP. (fn MODE DOC [KEYWORD VAL ... &rest BODY])" nil t) (function-put 'define-minor-mode 'doc-string-elt 2) (function-put 'define-minor-mode 'lisp-indent-function 'defun) +(function-put 'define-minor-mode 'autoload-macro 'expand) (autoload 'define-globalized-minor-mode "easy-mmode" "\ Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE. TURN-ON is a function that will be called with no args in every buffer @@ -8577,6 +8594,7 @@ on if the hook has explicitly disabled it. (fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)" nil t) (function-put 'define-globalized-minor-mode 'doc-string-elt 2) (function-put 'define-globalized-minor-mode 'lisp-indent-function 'defun) +(function-put 'define-globalized-minor-mode 'autoload-macro 'expand) (autoload 'easy-mmode-define-keymap "easy-mmode" "\ Return a keymap built from bindings BS. BS must be a list of (KEY . BINDING) where @@ -8925,7 +8943,7 @@ A second call of this function without changing point inserts the next match. A call with prefix PREFIX reads the symbol to insert from the minibuffer with completion. -(fn PREFIX)" '("P")) +(fn PREFIX)" t) (autoload 'ebrowse-tags-loop-continue "ebrowse" "\ Repeat last operation on files in tree. FIRST-TIME non-nil means this is not a repetition, but the first time. @@ -9953,6 +9971,11 @@ mode hooks. Major mode for editing Elixir, powered by tree-sitter. (fn)" t) +(autoload 'elixir-ts-mode-maybe "elixir-ts-mode" "\ +Enable `elixir-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name.") +(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\.elixir\\'" . elixir-ts-mode-maybe)) (add-to-list 'auto-mode-alist '("\\.ex\\'" . elixir-ts-mode-maybe)) (add-to-list 'auto-mode-alist '("\\.exs\\'" . elixir-ts-mode-maybe)) (add-to-list 'auto-mode-alist '("mix\\.lock" . elixir-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(elixir-mode . elixir-ts-mode))) (register-definition-prefixes "elixir-ts-mode" '("elixir-ts-")) @@ -10691,7 +10714,7 @@ ERC assigns SERVER and FULL-NAME the associated keyword values and defers to `erc-compute-port', `erc-compute-user', and `erc-compute-nick' for those respective parameters. -(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" '((let ((erc--display-context `((erc-interactive-display . erc) ,@erc--display-context))) (erc-select-read-args)))) +(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" t) (defalias 'erc-select #'erc) (autoload 'erc-tls "erc" "\ Connect to an IRC server over a TLS-encrypted connection. @@ -10714,7 +10737,7 @@ See the alternative entry-point command `erc' as well as Info node `(erc) Connecting' for a fuller description of the various parameters, like ID. -(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" '((let ((erc-default-port erc-default-port-tls) (erc--display-context `((erc-interactive-display . erc-tls) ,@erc--display-context))) (erc-select-read-args)))) +(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" t) (autoload 'erc-handle-irc-url "erc" "\ Use ERC to IRC on HOST:PORT in CHANNEL. If ERC is already connected to HOST:PORT, simply /join CHANNEL. @@ -15112,15 +15135,29 @@ Major mode for editing Go, powered by tree-sitter. \\{go-ts-mode-map} (fn)" t) +(autoload 'go-ts-mode-maybe "go-ts-mode" "\ +Enable `go-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name.") +(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(go-mode . go-ts-mode))) (autoload 'go-mod-ts-mode "go-ts-mode" "\ Major mode for editing go.mod files, powered by tree-sitter. (fn)" t) +(autoload 'go-mod-ts-mode-maybe "go-ts-mode" "\ +Enable `go-mod-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name.") +(when (treesit-available-p) (add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(go-mod-mode . go-mod-ts-mode))) (autoload 'go-work-ts-mode "go-ts-mode" "\ Major mode for editing go.work files, powered by tree-sitter. (fn)" t) -(add-to-list 'auto-mode-alist '("/go\\.work\\'" . go-work-ts-mode)) +(autoload 'go-work-ts-mode-maybe "go-ts-mode" "\ +Enable `go-work-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name.") +(when (treesit-available-p) (add-to-list 'auto-mode-alist '("/go\\.work\\'" . go-work-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(go-work-mode . go-work-ts-mode))) (register-definition-prefixes "go-ts-mode" '("go-")) @@ -15793,6 +15830,11 @@ Like `hanoi-unix', but with a 64-bit clock." t) Major mode for editing HEEx, powered by tree-sitter. (fn)" t) +(autoload 'heex-ts-mode-maybe "heex-ts-mode" "\ +Enable `heex-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name.") +(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\.[hl]?eex\\'" . heex-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(heex-mode . heex-ts-mode))) (register-definition-prefixes "heex-ts-mode" '("heex-ts-")) @@ -18851,6 +18893,7 @@ See Info node `(elisp)Defining Functions' for more details. (fn NAME ARGS &rest BODY)" nil t) (function-put 'define-inline 'lisp-indent-function 'defun) (function-put 'define-inline 'doc-string-elt 3) +(function-put 'define-inline 'autoload-macro 'expand) (register-definition-prefixes "inline" '("inline-")) @@ -19295,6 +19338,7 @@ Return the string read from the minibuffer. Major mode for editing Java, powered by tree-sitter. (fn)" t) +(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(java-mode . java-ts-mode))) (register-definition-prefixes "java-ts-mode" '("java-ts-mode-")) @@ -19341,6 +19385,7 @@ Major mode for editing JavaScript. \\ (fn)" t) +(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(javascript-mode . js-ts-mode))) (autoload 'js-json-mode "js" "\ @@ -19376,6 +19421,7 @@ one of the aforementioned options instead of using this mode. Major mode for editing JSON, powered by tree-sitter. (fn)" t) +(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(js-json-mode . json-ts-mode))) (register-definition-prefixes "json-ts-mode" '("json-ts-")) @@ -19874,7 +19920,7 @@ The first element on the command line should be the (main) loaddefs.el output file, and the rest are the directories to use.") (load "theme-loaddefs.el" t) -(register-definition-prefixes "loaddefs-gen" '("autoload-" "generated-autoload-" "loaddefs-generate--" "no-update-autoloads")) +(register-definition-prefixes "loaddefs-gen" '("autoload-" "generated-autoload-" "loaddefs-" "no-update-autoloads")) ;;; Generated autoloads from loadhist.el @@ -20105,6 +20151,11 @@ Major mode for editing Lua files, powered by tree-sitter. \\{lua-ts-mode-map} (fn)" t) +(autoload 'lua-ts-mode-maybe "lua-ts-mode" "\ +Enable `lua-ts-mode' when its grammar is available. +Also propose to install the grammar when `treesit-enabled-modes' +is t or contains the mode name.") +(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-ts-mode-maybe)) (add-to-list 'interpreter-mode-alist '("\\ Date: Fri, 22 Aug 2025 03:56:04 +0300 Subject: [PATCH 058/158] Add NEWS entry for project-switch-buffer change from bug#77312 --- etc/NEWS | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index f88f7b9e23e..e0ea673ed4a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -525,6 +525,12 @@ shell sessions. For example, 'C-2 C-x p s' switches to or creates a buffer named "*name-of-project-shell<2>*". By comparison, a plain universal argument as in 'C-u C-x p s' always creates a new session. +--- +*** 'project-switch-buffer' re-uniquifies buffer names while prompting. +When 'uniquify-buffer-name-style' is non-nil, 'project-switch-buffer' +changes the buffer names to only make them unique within the given +project, during completion. That makes some items shorter. + ** Registers *** New functions 'buffer-to-register' and 'file-to-register'. From 0e379775461f78636afc32ce75e96009b6d0960d Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 24 Aug 2025 03:18:16 +0300 Subject: [PATCH 059/158] Follow-up to previous changes in project--read-project-buffer * lisp/progmodes/project.el (project--buffers-completion-table): New function, use it to implement the no-internal/internal fallback logic from 'internal-complete-buffer', apply the category and cycle-sort-function (bug#77312). (project--read-project-buffer): Use it. Skip 'read-buffer' in favor of 'completing-read'. But make sure to honor read-buffer-completion-ignore-case and use format-prompt when the function is available. Unify two execution paths. --- lisp/progmodes/project.el | 71 ++++++++++++++++++++++++--------------- 1 file changed, 43 insertions(+), 28 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 8438060afa3..b5e534519b2 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1680,11 +1680,26 @@ non-nil if the project must be removed." Return non-nil if PROJECT is not a remote project." (not (file-remote-p project))) +(defun project--buffers-completion-table (buffers) + (lambda (string pred action) + (cond + ((eq action 'metadata) + '(metadata . ((category . buffer) + (cycle-sort-function . identity)))) + ((and (eq action t) + (equal string "")) ;Pcm completion or empty prefix. + (let* ((all (complete-with-action action buffers string pred)) + (non-internal (cl-remove-if (lambda (b) (= (aref b 0) ?\s)) all))) + (if (null non-internal) + all + non-internal))) + (t + (complete-with-action action buffers string pred))))) + (defun project--read-project-buffer () (let* ((pr (project-current t)) (current-buffer (current-buffer)) (other-buffer (other-buffer current-buffer)) - (other-name (buffer-name other-buffer)) (buffers (project-buffers pr)) (predicate (lambda (buffer) @@ -1693,35 +1708,35 @@ Return non-nil if PROJECT is not a remote project." (not (project--buffer-check buffer project-ignore-buffer-conditions))))) - (buffer + (completion-ignore-case read-buffer-completion-ignore-case) + (buffers-alist (if (and (fboundp 'uniquify-get-unique-names) uniquify-buffer-name-style) - ;; Forgo the use of `buffer-read-function' (often nil) in - ;; favor of uniquifying the buffers better. - (let* ((unique-names - (mapcar - (lambda (name) - (cons name - (get-text-property 0 'uniquify-orig-buffer - (or name "")))) - (uniquify-get-unique-names buffers))) - (other-name (when (funcall predicate (cons other-name other-buffer)) - (car (rassoc other-buffer unique-names)))) - (result (completing-read - "Switch to buffer: " - (project--completion-table-with-category - unique-names - 'buffer) - predicate - nil nil nil - other-name))) - (assoc-default result unique-names #'equal result)) - (read-buffer - "Switch to buffer: " - (when (funcall predicate (cons other-name other-buffer)) - other-name) - nil - predicate)))) + (mapcar + (lambda (name) + (cons name + (get-text-property 0 'uniquify-orig-buffer + (or name "")))) + (uniquify-get-unique-names buffers)) + (mapcar + (lambda (buf) (cons (buffer-name buf) buf)) + buffers))) + (other-name + (when (funcall predicate (cons nil other-buffer)) + (car (rassoc other-buffer buffers-alist)))) + (prompt + (if (fboundp 'format-prompt) + (format-prompt "Switch to buffer" other-name) + "Switch to buffer: ")) + ;; Forgo the use of `buffer-read-function' (often nil) in + ;; favor of showing shorter buffer names with uniquify. + (result + (completing-read + prompt + (project--buffers-completion-table buffers-alist) + predicate nil nil nil + other-name)) + (buffer (assoc-default result buffers-alist #'equal result))) ;; XXX: This check hardcodes the default buffer-belonging relation ;; which `project-buffers' is allowed to override. Straighten ;; this up sometime later. Or not. Since we can add a method From bb0ede711eb630e3cc4b02316bf76079ce760de6 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 24 Aug 2025 03:22:21 +0300 Subject: [PATCH 060/158] Have project-switch-to-buffer use a distinct completion category * etc/NEWS: Mention the change. * lisp/minibuffer.el (completion-category-defaults): Add an entry for it. * lisp/progmodes/project.el (project--buffers-completion-table): Return category 'project-buffer'. --- etc/NEWS | 4 ++++ lisp/minibuffer.el | 1 + lisp/progmodes/project.el | 2 +- 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index e0ea673ed4a..25304922e57 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -531,6 +531,10 @@ When 'uniquify-buffer-name-style' is non-nil, 'project-switch-buffer' changes the buffer names to only make them unique within the given project, during completion. That makes some items shorter. +*** 'project-switch-buffer' uses 'project-buffer' as completion category. +The category defaults are the same as for 'buffer' but any user +customizations would need to be re-added. + ** Registers *** New functions 'buffer-to-register' and 'file-to-register'. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 3c80d606cfc..3558b14bf78 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1215,6 +1215,7 @@ styles for specific categories, such as files, buffers, etc." ;; A new style that combines substring and pcm might be better, ;; e.g. one that does not anchor to bos. (project-file (styles . (substring))) + (project-buffer (styles . (basic substring))) (xref-location (styles . (substring))) (info-menu (styles . (basic substring))) (symbol-help (styles . (basic shorthand substring)))) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index b5e534519b2..05f3a9991be 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1684,7 +1684,7 @@ Return non-nil if PROJECT is not a remote project." (lambda (string pred action) (cond ((eq action 'metadata) - '(metadata . ((category . buffer) + '(metadata . ((category . project-buffer) (cycle-sort-function . identity)))) ((and (eq action t) (equal string "")) ;Pcm completion or empty prefix. From d70e2aac6cdf36361b16f3be56eb735ac44e162a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Aug 2025 07:32:45 +0300 Subject: [PATCH 061/158] ; * etc/NEWS: Fix punctuation in last change. --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 25304922e57..bd2ce33b851 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -529,7 +529,7 @@ universal argument as in 'C-u C-x p s' always creates a new session. *** 'project-switch-buffer' re-uniquifies buffer names while prompting. When 'uniquify-buffer-name-style' is non-nil, 'project-switch-buffer' changes the buffer names to only make them unique within the given -project, during completion. That makes some items shorter. +project, during completion. That makes some items shorter. *** 'project-switch-buffer' uses 'project-buffer' as completion category. The category defaults are the same as for 'buffer' but any user From 230ed1f9b6da42515735970c370424c37bda5d59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 23 Aug 2025 16:11:27 +0200 Subject: [PATCH 062/158] * lisp/emacs-lisp/bytecomp.el (mutating-fns): cl-fill and cl-replace --- lisp/emacs-lisp/bytecomp.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index cbfca753b30..f48be896ca5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3591,6 +3591,7 @@ This assumes the function has the `important-return-value' property." (cl-nset-exclusive-or 1 2) (cl-nreconc 1) (cl-sort 1) (cl-stable-sort 1) (cl-merge 2 3) + (cl-fill 1) (cl-replace 1) ))) (dolist (entry mutating-fns) (put (car entry) 'mutates-arguments (cdr entry)))) From 308e3ab1dbd9633b843541af55d77c82b725df02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 2 May 2024 18:05:21 +0200 Subject: [PATCH 063/158] Disallow string data resizing (bug#79784) Only allow string mutation that is certain not to require string data to be resized and reallocated: writing bytes into a unibyte string, and changing ASCII to ASCII in a multibyte string. This ensures that mutation will never transform a unibyte string to multibyte, that the size of a string in bytes never changes, and that the byte offsets of characters remain the same. Most importantly, it removes a long-standing obstacle to reform of string representation and allow for future performance improvements. * src/data.c (Faset): Disallow resizing string mutation. * src/fns.c (clear_string_char_byte_cache): * src/alloc.c (resize_string_data): Remove. * test/src/data-tests.el (data-aset-string): New test. * test/lisp/subr-tests.el (subr--subst-char-in-string): Skip error cases. * test/src/alloc-tests.el (aset-nbytes-change): Remove test that is no longer relevant. * doc/lispref/strings.texi (Modifying Strings): * doc/lispref/sequences.texi (Array Functions): * doc/lispref/text.texi (Substitution): Update manual. * etc/NEWS: Announce. --- doc/lispref/sequences.texi | 4 +-- doc/lispref/strings.texi | 10 +++----- doc/lispref/text.texi | 2 ++ etc/NEWS | 15 ++++++++++++ src/alloc.c | 50 -------------------------------------- src/data.c | 43 +++++++++++--------------------- src/fns.c | 6 ----- src/lisp.h | 2 -- test/lisp/subr-tests.el | 13 +++++++--- test/src/alloc-tests.el | 7 ------ test/src/data-tests.el | 20 +++++++++++++++ 11 files changed, 67 insertions(+), 105 deletions(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 5588d32c5e9..2f7c6876a8f 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1441,8 +1441,8 @@ x The @var{array} should be mutable. @xref{Mutability}. If @var{array} is a string and @var{object} is not a character, a -@code{wrong-type-argument} error results. The function converts a -unibyte string to multibyte if necessary to insert a character. +@code{wrong-type-argument} error results. For more information about +string mutation, @pxref{Modifying Strings}. @end defun @defun fillarray array object diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 93025574893..a3b335b426e 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -467,12 +467,10 @@ described in this section. @xref{Mutability}. The most basic way to alter the contents of an existing string is with @code{aset} (@pxref{Array Functions}). @w{@code{(aset @var{string} @var{idx} @var{char})}} stores @var{char} into @var{string} at character -index @var{idx}. It will automatically convert a pure-@acronym{ASCII} -@var{string} to a multibyte string (@pxref{Text Representations}) if -needed, but we recommend to always make sure @var{string} is multibyte -(e.g., by using @code{string-to-multibyte}, @pxref{Converting -Representations}), if @var{char} is a non-@acronym{ASCII} character, not -a raw byte. +index @var{idx}. When @var{string} is a unibyte string (@pxref{Text +Representations}), @var{char} must be a single byte (0--255); when +@var{string} is multibyte, both @var{char} and the previous character at +@var{idx} must be ASCII (0--127). To clear out a string that contained a password, use @code{clear-string}: diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 60bf8ecc37b..943d08579ed 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4641,6 +4641,8 @@ with @var{tochar} in @var{string}. By default, substitution occurs in a copy of @var{string}, but if the optional argument @var{inplace} is non-@code{nil}, the function modifies the @var{string} itself. In any case, the function returns the resulting string. + +For restrictions when altering an existing string, @pxref{Modifying Strings}. @end defun @deffn Command translate-region start end table diff --git a/etc/NEWS b/etc/NEWS index bd2ce33b851..aee83c2f604 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2680,6 +2680,21 @@ enabled for files named "go.work". * Incompatible Lisp Changes in Emacs 31.1 ++++ +** String mutation has been restricted further. +'aset' on unibyte strings now requires the new character to be a single +byte (0-255). On multibyte strings the new character and the character +being replaced must both be ASCII (0-127). + +These rules ensure that mutation will never transform a unibyte string +to multibyte, and that the size of a string in bytes (as reported by +'string-bytes') never changes. They also allow strings to be +represented more efficiently in the future. + +Other functions that use 'aset' to modify string data, such as +'subst-char-in-string' with a non-nil INPLACE argument, will signal an +error if called with arguments that would violate these rules. + ** Nested backquotes are not supported any more in Pcase patterns. --- diff --git a/src/alloc.c b/src/alloc.c index 07ca8474bf3..9ace6f01856 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1815,56 +1815,6 @@ allocate_string_data (struct Lisp_String *s, tally_consing (needed); } -/* Reallocate multibyte STRING data when a single character is replaced. - The character is at byte offset CIDX_BYTE in the string. - The character being replaced is CLEN bytes long, - and the character that will replace it is NEW_CLEN bytes long. - Return the address where the caller should store the new character. */ - -unsigned char * -resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte, - int clen, int new_clen) -{ - eassume (STRING_MULTIBYTE (string)); - sdata *old_sdata = SDATA_OF_STRING (XSTRING (string)); - ptrdiff_t nchars = SCHARS (string); - ptrdiff_t nbytes = SBYTES (string); - ptrdiff_t new_nbytes = nbytes + (new_clen - clen); - unsigned char *data = SDATA (string); - unsigned char *new_charaddr; - - if (sdata_size (nbytes) == sdata_size (new_nbytes)) - { - /* No need to reallocate, as the size change falls within the - alignment slop. */ - XSTRING (string)->u.s.size_byte = new_nbytes; -#ifdef GC_CHECK_STRING_BYTES - SDATA_NBYTES (old_sdata) = new_nbytes; -#endif - new_charaddr = data + cidx_byte; - memmove (new_charaddr + new_clen, new_charaddr + clen, - nbytes - (cidx_byte + (clen - 1))); - } - else - { - allocate_string_data (XSTRING (string), nchars, new_nbytes, false, false); - unsigned char *new_data = SDATA (string); - new_charaddr = new_data + cidx_byte; - memcpy (new_charaddr + new_clen, data + cidx_byte + clen, - nbytes - (cidx_byte + clen)); - memcpy (new_data, data, cidx_byte); - - /* Mark old string data as free by setting its string back-pointer - to null, and record the size of the data in it. */ - SDATA_NBYTES (old_sdata) = nbytes; - old_sdata->string = NULL; - } - - clear_string_char_byte_cache (); - - return new_charaddr; -} - /* Sweep and compact strings. */ diff --git a/src/data.c b/src/data.c index 493a8dd63fc..b8a48203bcf 100644 --- a/src/data.c +++ b/src/data.c @@ -2574,7 +2574,10 @@ or a byte-code object. IDX starts at 0. */) DEFUN ("aset", Faset, Saset, 3, 3, 0, doc: /* Store into the element of ARRAY at index IDX the value NEWELT. Return NEWELT. ARRAY may be a vector, a string, a char-table or a -bool-vector. IDX starts at 0. */) +bool-vector. IDX starts at 0. +If ARRAY is a unibyte string, NEWELT must be a single byte (0-255). +If ARRAY is a multibyte string, NEWELT and the previous character at +index IDX must both be ASCII (0-127). */) (register Lisp_Object array, Lisp_Object idx, Lisp_Object newelt) { register EMACS_INT idxval; @@ -2613,42 +2616,24 @@ bool-vector. IDX starts at 0. */) args_out_of_range (array, idx); CHECK_CHARACTER (newelt); int c = XFIXNAT (newelt); - ptrdiff_t idxval_byte; - int prev_bytes; - unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; if (STRING_MULTIBYTE (array)) { - idxval_byte = string_char_to_byte (array, idxval); - p1 = SDATA (array) + idxval_byte; - prev_bytes = BYTES_BY_CHAR_HEAD (*p1); - } - else if (SINGLE_BYTE_CHAR_P (c)) - { - SSET (array, idxval, c); - return newelt; + if (c > 0x7f) + error ("Attempt to store non-ASCII char into multibyte string"); + ptrdiff_t idxval_byte = string_char_to_byte (array, idxval); + unsigned char *p = SDATA (array) + idxval_byte; + if (*p > 0x7f) + error ("Attempt to replace non-ASCII char in multibyte string"); + *p = c; } else { - for (ptrdiff_t i = SBYTES (array) - 1; i >= 0; i--) - if (!ASCII_CHAR_P (SREF (array, i))) - args_out_of_range (array, newelt); - /* ARRAY is an ASCII string. Convert it to a multibyte string. */ - STRING_SET_MULTIBYTE (array); - idxval_byte = idxval; - p1 = SDATA (array) + idxval_byte; - prev_bytes = 1; + if (c > 0xff) + error ("Attempt to store non-byte value into unibyte string"); + SSET (array, idxval, c); } - - int new_bytes = CHAR_STRING (c, p0); - if (prev_bytes != new_bytes) - p1 = resize_string_data (array, idxval_byte, prev_bytes, new_bytes); - - do - *p1++ = *p0++; - while (--new_bytes != 0); } - return newelt; } diff --git a/src/fns.c b/src/fns.c index 1cf63384218..5334c9f94a8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1189,12 +1189,6 @@ static Lisp_Object string_char_byte_cache_string; static ptrdiff_t string_char_byte_cache_charpos; static ptrdiff_t string_char_byte_cache_bytepos; -void -clear_string_char_byte_cache (void) -{ - string_char_byte_cache_string = Qnil; -} - /* Return the byte index corresponding to CHAR_INDEX in STRING. */ ptrdiff_t diff --git a/src/lisp.h b/src/lisp.h index 64b5c227583..fe942c917f0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4289,7 +4289,6 @@ extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object); extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object); extern Lisp_Object assq_no_signal (Lisp_Object, Lisp_Object); extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object); -extern void clear_string_char_byte_cache (void); extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t); extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t); extern Lisp_Object string_to_multibyte (Lisp_Object); @@ -4444,7 +4443,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ extern intptr_t garbage_collection_inhibited; -unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int); extern void malloc_warning (const char *); extern AVOID memory_full (size_t); extern AVOID buffer_memory_full (ptrdiff_t); diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index de2c59b9c25..a4059a7d290 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1454,9 +1454,16 @@ final or penultimate step during initialization.")) (dolist (inplace '(nil t)) (dolist (from '(?a ?é ?Ω #x80 #x3fff80)) (dolist (to '(?o ?á ?ƒ ?☃ #x1313f #xff #x3fffc9)) - ;; Can't put a non-byte value in a non-ASCII unibyte string. - (unless (and (not mb) (> to #xff) - (not (string-match-p (rx bos (* ascii) eos) str))) + (unless (or + ;; Can't put non-byte in a non-ASCII unibyte string. + (and (not mb) (> to #xff) + (not (string-match-p + (rx bos (* ascii) eos) str))) + ;; Skip illegal mutation. + (and inplace (not (if mb + (and (<= 0 from 127) + (<= 0 to 127)) + (<= 0 to 255))))) (let* ((in (copy-sequence str)) (ref (if (and (not mb) (> from #xff)) in ; nothing to replace diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el index cba69023044..cf7d1ca1cd3 100644 --- a/test/src/alloc-tests.el +++ b/test/src/alloc-tests.el @@ -52,11 +52,4 @@ (dotimes (i 4) (should (eql (aref x i) (aref y i)))))) -;; Bug#39207 -(ert-deftest aset-nbytes-change () - (let ((s (make-string 1 ?a))) - (dolist (c (list 10003 ?b 128 ?c ?d (max-char) ?e)) - (aset s 0 c) - (should (equal s (make-string 1 c)))))) - ;;; alloc-tests.el ends here diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 1eaf1759c17..e93cc3831f9 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -929,4 +929,24 @@ comparing the subr with a much slower Lisp implementation." ((eq subtype 'function) (cl-functionp val)) (t (should-not (cl-typep val subtype)))))))))) +(ert-deftest data-aset-string () + ;; unibyte + (let ((s (copy-sequence "abcdef"))) + (cl-assert (not (multibyte-string-p s))) + (aset s 4 ?E) + (should (equal s "abcdEf")) + (aset s 2 255) + (should (equal s "ab\377dEf")) + (should-error (aset s 3 256)) ; not a byte value + (should-error (aset s 3 #x3fff80))) ; not a byte value + ;; multibyte + (let ((s (copy-sequence "abçdef"))) + (cl-assert (multibyte-string-p s)) + (aset s 4 ?E) + (should (equal s "abçdEf")) + (should-error (aset s 2 ?c)) ; previous char not ASCII + (should-error (aset s 2 #xe9)) ; new char not ASCII + (should-error (aset s 3 #x3fff80))) ; new char not ASCII + ) + ;;; data-tests.el ends here From 9f33fb2258866620257e71e6594cc47cd0e5ee28 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sun, 24 Aug 2025 10:38:59 -0700 Subject: [PATCH 064/158] ; * doc/misc/eshell.texi (Globbing): Fix typo and clarify (bug#79175). --- doc/misc/eshell.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 465d3dede13..75a459580a9 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -2042,8 +2042,8 @@ Matches zero or more copies of the glob pattern @var{x}. For example, @item @var{x}## Matches one or more copies of the glob pattern @var{x}. Thus, -@samp{fo#.el} matches @file{fo.el}, @file{foo.el}, @file{fooo.el}, -etc. +@samp{fo##.el} matches @file{fo.el}, @file{foo.el}, @file{fooo.el}, +etc, but not @file{f.el}. @item @var{x}~@var{y} Matches anything that matches the pattern @var{x} but not @var{y}. For From 5ac0b39bc973979ae8c3258f2d2a8b6566631687 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 24 Aug 2025 20:45:21 +0300 Subject: [PATCH 065/158] * lisp/treesit.el (treesit-enabled-modes): Use 'add-to-list'. Using 'add-to-list' instead of 'cons' in :set avoids adding duplicate entries to 'major-mode-remap-alist'. --- lisp/treesit.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index ecdcf0b5551..218f4c7b36e 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -5419,9 +5419,9 @@ or t to enable all ts-modes." (set-default sym val) (when (treesit-available-p) (dolist (m treesit-major-mode-remap-alist) - (setq major-mode-remap-alist - (if (or (eq val t) (memq (cdr m) val)) - (cons m major-mode-remap-alist) + (if (or (eq val t) (memq (cdr m) val)) + (add-to-list 'major-mode-remap-alist m) + (setq major-mode-remap-alist (delete m major-mode-remap-alist)))))) :version "31.1") From 40219c39a14e9fd7004d84fdc7b5a587490fb367 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 15 Aug 2025 00:10:31 -0700 Subject: [PATCH 066/158] Use existing X-Debbugs-CC header in erc-bug * lisp/erc/erc.el (erc-bug): On Emacs 30 and later, search for and ideally use an existing "X-Debbugs-CC" header instead of inserting a new one at the top. Section 4.5 Obsolete Header Fields of RFC 5322 says, "except for destination address fields (described in section 4.5.3), the interpretation of multiple occurrences of fields is unspecified." Anecdotal fiddling suggests the Savannah servers aren't confused by the second "empty" header field, so this change is probably just cosmetic. --- lisp/erc/erc.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index af7dc428e3f..6ebb137311b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -9372,8 +9372,13 @@ If BUFFER is nil, update the mode line in all ERC buffers." (report-emacs-bug (format "ERC %s: %s" erc-version subject)) (save-excursion - (goto-char (point-min)) - (insert "X-Debbugs-CC: emacs-erc@gnu.org\n"))) + (if (and (>= emacs-major-version 30) + (search-backward "X-Debbugs-CC: " nil t) + (goto-char (pos-eol)) + (eq (char-before) ?\s)) + (insert "emacs-erc@gnu.org") + (goto-char (point-min)) + (insert "X-Debbugs-CC: emacs-erc@gnu.org\n")))) (defconst erc--news-url "https://git.savannah.gnu.org/cgit/emacs.git/plain/etc/ERC-NEWS") From 45ffc0e102582654b6483ba5a3fdf473f6999889 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 23 Aug 2025 19:11:55 -0700 Subject: [PATCH 067/158] Don't set bufbar cursor-type in erc-mode buffers * lisp/erc/erc-status-sidebar.el (erc-status-sidebar-get-window): Set `cursor-type' in `erc-status-sidebar-mode' buffer instead. This bug was introduced along with the bufbar module for bug#63595 in ERC 5.6. It's a regression because it also affects the status-sidebar module. --- lisp/erc/erc-status-sidebar.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el index b12cd395d24..1e69b3d4be7 100644 --- a/lisp/erc/erc-status-sidebar.el +++ b/lisp/erc/erc-status-sidebar.el @@ -186,13 +186,13 @@ If NO-CREATION is non-nil, the window is not created." erc-status-sidebar--singular-p))) (unless (or sidebar-window no-creation) (with-current-buffer (erc-status-sidebar-get-buffer) - (setq-local vertical-scroll-bar nil)) + (setq vertical-scroll-bar nil + cursor-type nil)) (setq sidebar-window (erc-status-sidebar-display-window)) (set-window-dedicated-p sidebar-window t) (set-window-parameter sidebar-window 'no-delete-other-windows t) ;; Don't cycle to this window with `other-window'. (set-window-parameter sidebar-window 'no-other-window t) - (setq cursor-type nil) (set-window-fringes sidebar-window 0 0) ;; Set a custom display table so the window doesn't show a ;; truncation symbol when a channel name is too big. From 0d3504227a67b56a8d1edc4758c66a05718dbd5a Mon Sep 17 00:00:00 2001 From: Juergen Hoetzel Date: Wed, 10 May 2006 17:21:54 +0000 Subject: [PATCH 068/158] * lisp/progmodes/lua-mode.el: Import lua-mode. --- lisp/progmodes/lua-mode.el | 2291 ++++++++++++++++++++++++++++++++++++ 1 file changed, 2291 insertions(+) create mode 100644 lisp/progmodes/lua-mode.el diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el new file mode 100644 index 00000000000..6c524f57d93 --- /dev/null +++ b/lisp/progmodes/lua-mode.el @@ -0,0 +1,2291 @@ +;;; lua-mode.el --- a major-mode for editing Lua scripts -*- lexical-binding: t -*- + +;; Author: 2011-2013 immerrr +;; 2010-2011 Reuben Thomas +;; 2006 Juergen Hoetzel +;; 2004 various (support for Lua 5 and byte compilation) +;; 2001 Christian Vogler +;; 1997 Bret Mogilefsky starting from +;; tcl-mode by Gregor Schmid +;; with tons of assistance from +;; Paul Du Bois and +;; Aaron Smith . +;; +;; URL: https://immerrr.github.io/lua-mode +;; Version: 20221027 +;; Package-Requires: ((emacs "24.3")) +;; +;; This file is NOT part of Emacs. +;; +;; This program 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. +;; +;; This program 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 this program. If not, see . + +;; Keywords: languages, processes, tools + +;; This field is expanded to commit SHA and commit date during the +;; archive creation. +;; Revision: $Format:%h (%cD)$ +;; + +;;; Commentary: + +;; lua-mode provides support for editing Lua, including automatic +;; indentation, syntactical font-locking, running interactive shell, +;; Flymake checks with luacheck, interacting with `hs-minor-mode' and +;; online documentation lookup. + +;; The following variables are available for customization (see more via +;; `M-x customize-group lua`): + +;; - Var `lua-indent-level': +;; indentation offset in spaces +;; - Var `lua-indent-string-contents': +;; set to `t` if you like to have contents of multiline strings to be +;; indented like comments +;; - Var `lua-indent-nested-block-content-align': +;; set to `nil' to stop aligning the content of nested blocks with the +;; open parenthesis +;; - Var `lua-indent-close-paren-align': +;; set to `t' to align close parenthesis with the open parenthesis, +;; rather than with the beginning of the line +;; - Var `lua-mode-hook': +;; list of functions to execute when lua-mode is initialized +;; - Var `lua-documentation-url': +;; base URL for documentation lookup +;; - Var `lua-documentation-function': function used to +;; show documentation (`eww` is a viable alternative for Emacs 25) + +;; These are variables/commands that operate on the Lua process: + +;; - Var `lua-default-application': +;; command to start the Lua process (REPL) +;; - Var `lua-default-command-switches': +;; arguments to pass to the Lua process on startup (make sure `-i` is there +;; if you expect working with Lua shell interactively) +;; - Cmd `lua-start-process': start new REPL process, usually happens automatically +;; - Cmd `lua-kill-process': kill current REPL process + +;; These are variables/commands for interaction with the Lua process: + +;; - Cmd `lua-show-process-buffer': switch to REPL buffer +;; - Cmd `lua-hide-process-buffer': hide window showing REPL buffer +;; - Var `lua-always-show': show REPL buffer after sending something +;; - Cmd `lua-send-buffer': send whole buffer +;; - Cmd `lua-send-current-line': send current line +;; - Cmd `lua-send-defun': send current top-level function +;; - Cmd `lua-send-region': send active region +;; - Cmd `lua-restart-with-whole-file': restart REPL and send whole buffer + +;; To enable on-the-fly linting, make sure you have the luacheck +;; program installed (available from luarocks) and activate +;; `flymake-mode'. + +;; See "M-x apropos-command ^lua-" for a list of commands. +;; See "M-x customize-group lua" for a list of customizable variables. + + +;;; Code: +(eval-when-compile + (require 'cl-lib)) + +(require 'comint) +(require 'newcomment) +(require 'rx) + + +;; rx-wrappers for Lua + +(eval-when-compile + ;; Silence compilation warning about `compilation-error-regexp-alist' defined + ;; in compile.el. + (require 'compile)) + +(eval-and-compile + (if (fboundp #'rx-let) + (progn + ;; Emacs 27+ way of customizing rx + (defvar lua--rx-bindings) + + (setq + lua--rx-bindings + '((symbol (&rest x) (seq symbol-start (or x) symbol-end)) + (ws (* (any " \t"))) + (ws+ (+ (any " \t"))) + + (lua-name (symbol (seq (+ (any alpha "_")) (* (any alnum "_"))))) + (lua-funcname (seq lua-name (* ws "." ws lua-name) + (opt ws ":" ws lua-name))) + (lua-funcheader + ;; Outer (seq ...) is here to shy-group the definition + (seq (or (seq (symbol "function") ws (group-n 1 lua-funcname)) + (seq (group-n 1 lua-funcname) ws "=" ws + (symbol "function"))))) + (lua-number + (seq (or (seq (+ digit) (opt ".") (* digit)) + (seq (* digit) (opt ".") (+ digit))) + (opt (regexp "[eE][+-]?[0-9]+")))) + (lua-assignment-op (seq "=" (or buffer-end (not (any "="))))) + (lua-operator (or "+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">=" "<" + ">" "=" ";" ":" "," "." ".." "...")) + (lua-keyword-operator (symbol "and" "not" "or")) + (lua-keyword + (symbol "break" "do" "else" "elseif" "end" "for" "function" + "goto" "if" "in" "local" "repeat" "return" + "then" "until" "while")) + (lua-up-to-9-variables + (seq (group-n 1 lua-name) ws + (? "," ws (group-n 2 lua-name) ws + (? "," ws (group-n 3 lua-name) ws + (? "," ws (group-n 4 lua-name) ws + (? "," ws (group-n 5 lua-name) ws + (? "," ws (group-n 6 lua-name) ws + (? "," ws (group-n 7 lua-name) ws + (? "," ws (group-n 8 lua-name) ws + (? "," ws (group-n 9 lua-name) ws)))))))))))) + + (defmacro lua-rx (&rest regexps) + (eval `(rx-let ,lua--rx-bindings + (rx ,@regexps)))) + + (defun lua-rx-to-string (form &optional no-group) + (rx-let-eval lua--rx-bindings + (rx-to-string form no-group)))) + (progn + ;; Pre-Emacs 27 way of customizing rx + (defvar lua-rx-constituents) + (defvar rx-parent) + + (defun lua-rx-to-string (form &optional no-group) + "Lua-specific replacement for `rx-to-string'. + +See `rx-to-string' documentation for more information FORM and +NO-GROUP arguments." + (let ((rx-constituents lua-rx-constituents)) + (rx-to-string form no-group))) + + (defmacro lua-rx (&rest regexps) + "Lua-specific replacement for `rx'. + +See `rx' documentation for more information about REGEXPS param." + (cond ((null regexps) + (error "No regexp")) + ((cdr regexps) + (lua-rx-to-string `(and ,@regexps) t)) + (t + (lua-rx-to-string (car regexps) t)))) + + (defun lua--new-rx-form (form) + "Add FORM definition to `lua-rx' macro. + +FORM is a cons (NAME . DEFN), see more in `rx-constituents' doc. +This function enables specifying new definitions using old ones: +if DEFN is a list that starts with `:rx' symbol its second +element is itself expanded with `lua-rx-to-string'. " + (let ((form-definition (cdr form))) + (when (and (listp form-definition) (eq ':rx (car form-definition))) + (setcdr form (lua-rx-to-string (cadr form-definition) 'nogroup))) + (push form lua-rx-constituents))) + + (defun lua--rx-symbol (form) + ;; form is a list (symbol XXX ...) + ;; Skip initial 'symbol + (setq form (cdr form)) + ;; If there's only one element, take it from the list, otherwise wrap the + ;; whole list into `(or XXX ...)' form. + (setq form (if (eq 1 (length form)) + (car form) + (append '(or) form))) + (and (fboundp 'rx-form) ; Silence Emacs 27's byte-compiler. + (rx-form `(seq symbol-start ,form symbol-end) rx-parent))) + + (setq lua-rx-constituents (copy-sequence rx-constituents)) + + (mapc 'lua--new-rx-form + `((symbol lua--rx-symbol 1 nil) + (ws . "[ \t]*") (ws+ . "[ \t]+") + (lua-name :rx (symbol (regexp "[[:alpha:]_]+[[:alnum:]_]*"))) + (lua-funcname + :rx (seq lua-name (* ws "." ws lua-name) + (opt ws ":" ws lua-name))) + (lua-funcheader + ;; Outer (seq ...) is here to shy-group the definition + :rx (seq (or (seq (symbol "function") ws (group-n 1 lua-funcname)) + (seq (group-n 1 lua-funcname) ws "=" ws + (symbol "function"))))) + (lua-number + :rx (seq (or (seq (+ digit) (opt ".") (* digit)) + (seq (* digit) (opt ".") (+ digit))) + (opt (regexp "[eE][+-]?[0-9]+")))) + (lua-assignment-op + :rx (seq "=" (or buffer-end (not (any "="))))) + (lua-operator + :rx (or "+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">=" "<" + ">" "=" ";" ":" "," "." ".." "...")) + (lua-keyword-operator + :rx (symbol "and" "not" "or")) + (lua-keyword + :rx (symbol "break" "do" "else" "elseif" "end" "for" "function" + "goto" "if" "in" "local" "repeat" "return" + "then" "until" "while")) + (lua-up-to-9-variables + :rx (seq (group-n 1 lua-name) ws + (? "," ws (group-n 2 lua-name) ws + (? "," ws (group-n 3 lua-name) ws + (? "," ws (group-n 4 lua-name) ws + (? "," ws (group-n 5 lua-name) ws + (? "," ws (group-n 6 lua-name) ws + (? "," ws (group-n 7 lua-name) ws + (? "," ws (group-n 8 lua-name) ws + (? "," ws (group-n 9 lua-name) ws))))))))))))))) + + +;; Local variables +(defgroup lua nil + "Major mode for editing Lua code." + :prefix "lua-" + :group 'languages) + +(defcustom lua-indent-level 3 + "Amount by which Lua subexpressions are indented." + :type 'integer + :group 'lua + :safe #'integerp) + +(defcustom lua-comment-start "-- " + "Default value of `comment-start'." + :type 'string + :group 'lua) + +(defcustom lua-comment-start-skip "---*[ \t]*" + "Default value of `comment-start-skip'." + :type 'string + :group 'lua) + +(defcustom lua-default-application "lua" + "Default application to run in Lua process. + +Can be a string, where it denotes a command to be executed to +start Lua process, or a (HOST . PORT) cons, that can be used to +connect to Lua process running remotely." + :type '(choice (string) + (cons string integer)) + :group 'lua) + +(defcustom lua-default-command-switches (list "-i") + "Command switches for `lua-default-application'. +Should be a list of strings." + :type '(repeat string) + :group 'lua) +(make-variable-buffer-local 'lua-default-command-switches) + +(defcustom lua-always-show t + "*Non-nil means display lua-process-buffer after sending a command." + :type 'boolean + :group 'lua) + +(defcustom lua-documentation-function 'browse-url + "Function used to fetch the Lua reference manual." + :type `(radio (function-item browse-url) + ,@(when (fboundp 'eww) '((function-item eww))) + ,@(when (fboundp 'w3m-browse-url) '((function-item w3m-browse-url))) + (function :tag "Other function")) + :group 'lua) + +(defcustom lua-documentation-url + (or (and (file-readable-p "/usr/share/doc/lua/manual.html") + "file:///usr/share/doc/lua/manual.html") + "http://www.lua.org/manual/5.1/manual.html") + "URL pointing to the Lua reference manual." + :type 'string + :group 'lua) + + +(defvar lua-process nil + "The active Lua process") + +(defvar lua-process-buffer nil + "Buffer used for communication with the Lua process.") + +(defun lua--customize-set-prefix-key (prefix-key-sym prefix-key-val) + (cl-assert (eq prefix-key-sym 'lua-prefix-key)) + (set prefix-key-sym (if (and prefix-key-val (> (length prefix-key-val) 0)) + ;; read-kbd-macro returns a string or a vector + ;; in both cases (elt x 0) is ok + (elt (read-kbd-macro prefix-key-val) 0))) + (if (fboundp 'lua-prefix-key-update-bindings) + (lua-prefix-key-update-bindings))) + +(defcustom lua-prefix-key "\C-c" + "Prefix for all lua-mode commands." + :type 'string + :group 'lua + :set 'lua--customize-set-prefix-key + :get (lambda (sym) + (let ((val (eval sym))) + (if val (single-key-description (eval sym)) "")))) + +(defvar lua-mode-menu (make-sparse-keymap "Lua") + "Keymap for lua-mode's menu.") + +(defvar lua-prefix-mode-map + (eval-when-compile + (let ((result-map (make-sparse-keymap))) + (mapc (lambda (key_defn) + (define-key result-map (read-kbd-macro (car key_defn)) (cdr key_defn))) + '(("C-l" . lua-send-buffer) + ("C-f" . lua-search-documentation))) + result-map)) + "Keymap that is used to define keys accessible by `lua-prefix-key'. + +If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") + +(defvar lua--electric-indent-chars + (mapcar #'string-to-char '("}" "]" ")"))) + + +(defvar lua-mode-map + (let ((result-map (make-sparse-keymap))) + (unless (boundp 'electric-indent-chars) + (mapc (lambda (electric-char) + (define-key result-map + (read-kbd-macro + (char-to-string electric-char)) + #'lua-electric-match)) + lua--electric-indent-chars)) + (define-key result-map [menu-bar lua-mode] (cons "Lua" lua-mode-menu)) + (define-key result-map [remap backward-up-list] 'lua-backward-up-list) + + ;; handle prefix-keyed bindings: + ;; * if no prefix, set prefix-map as parent, i.e. + ;; if key is not defined look it up in prefix-map + ;; * if prefix is set, bind the prefix-map to that key + (if lua-prefix-key + (define-key result-map (vector lua-prefix-key) lua-prefix-mode-map) + (set-keymap-parent result-map lua-prefix-mode-map)) + result-map) + "Keymap used in lua-mode buffers.") + +(defvar lua-electric-flag t + "If t, electric actions (like automatic reindentation) will happen when an electric + key like `{' is pressed") +(make-variable-buffer-local 'lua-electric-flag) + +(defcustom lua-prompt-regexp "[^\n]*\\(>[\t ]+\\)+$" + "Regexp which matches the Lua program's prompt." + :type 'regexp + :group 'lua) + +(defcustom lua-traceback-line-re + ;; This regexp skips prompt and meaningless "stdin:N:" prefix when looking + ;; for actual file-line locations. + "^\\(?:[\t ]*\\|.*>[\t ]+\\)\\(?:[^\n\t ]+:[0-9]+:[\t ]*\\)*\\(?:\\([^\n\t ]+\\):\\([0-9]+\\):\\)" + "Regular expression that describes tracebacks and errors." + :type 'regexp + :group 'lua) + +(defvar lua--repl-buffer-p nil + "Buffer-local flag saying if this is a Lua REPL buffer.") +(make-variable-buffer-local 'lua--repl-buffer-p) + +(defun lua--compilation-find-file (fn marker filename directory &rest formats) + "Return Lua REPL buffer when looking for \"stdin\" file in it." + (if (and + lua--repl-buffer-p + (string-equal filename "stdin") + ;; NOTE: this doesn't traverse `compilation-search-path' when + ;; looking for filename. + (not (file-exists-p (expand-file-name + filename + (when directory (expand-file-name directory)))))) + (current-buffer) + (apply fn marker filename directory formats))) + +(advice-add 'compilation-find-file :around #'lua--compilation-find-file) + +(defun lua--compilation-goto-locus (fn msg mk end-mk) + "When message points to Lua REPL buffer, go to the message itself. +Usually, stdin:XX line number points to nowhere." + (let ((errmsg-buf (marker-buffer msg)) + (error-buf (marker-buffer mk))) + (if (and (with-current-buffer errmsg-buf lua--repl-buffer-p) + (eq error-buf errmsg-buf)) + (progn + (compilation-set-window (display-buffer (marker-buffer msg)) msg) + (goto-char msg)) + (funcall fn msg mk end-mk)))) + +(advice-add 'compilation-goto-locus :around #'lua--compilation-goto-locus) + +(defcustom lua-indent-string-contents nil + "If non-nil, contents of multiline string will be indented. +Otherwise leading amount of whitespace on each line is preserved." + :group 'lua + :type 'boolean + :safe #'booleanp) + +(defcustom lua-indent-nested-block-content-align t + "If non-nil, the contents of nested blocks are indented to +align with the column of the opening parenthesis, rather than +just forward by `lua-indent-level'." + :group 'lua + :type 'boolean + :safe #'booleanp) + +(defcustom lua-indent-close-paren-align t + "If non-nil, close parenthesis are aligned with their open +parenthesis. If nil, close parenthesis are aligned to the +beginning of the line." + :group 'lua + :type 'boolean + :safe #'booleanp) + +(defcustom lua-jump-on-traceback t + "*Jump to innermost traceback location in *lua* buffer. When this +variable is non-nil and a traceback occurs when running Lua code in a +process, jump immediately to the source code of the innermost +traceback location." + :type 'boolean + :group 'lua) + +(defcustom lua-mode-hook nil + "Hooks called when Lua mode fires up." + :type 'hook + :group 'lua) + +(defvar lua-region-start (make-marker) + "Start of special region for Lua communication.") + +(defvar lua-region-end (make-marker) + "End of special region for Lua communication.") + +(defvar lua-emacs-menu + '(["Restart With Whole File" lua-restart-with-whole-file t] + ["Kill Process" lua-kill-process t] + ["Hide Process Buffer" lua-hide-process-buffer t] + ["Show Process Buffer" lua-show-process-buffer t] + ["Beginning Of Proc" lua-beginning-of-proc t] + ["End Of Proc" lua-end-of-proc t] + ["Set Lua-Region Start" lua-set-lua-region-start t] + ["Set Lua-Region End" lua-set-lua-region-end t] + ["Send Lua-Region" lua-send-lua-region t] + ["Send Current Line" lua-send-current-line t] + ["Send Region" lua-send-region t] + ["Send Proc" lua-send-proc t] + ["Send Buffer" lua-send-buffer t] + ["Search Documentation" lua-search-documentation t]) + "Emacs menu for Lua mode.") + +;; the whole defconst is inside eval-when-compile, because it's later referenced +;; inside another eval-and-compile block +(eval-and-compile + (defconst + lua--builtins + (let* + ((modules + '("_G" "_VERSION" "assert" "collectgarbage" "dofile" "error" "getfenv" + "getmetatable" "ipairs" "load" "loadfile" "loadstring" "module" + "next" "pairs" "pcall" "print" "rawequal" "rawget" "rawlen" "rawset" + "require" "select" "setfenv" "setmetatable" "tonumber" "tostring" + "type" "unpack" "xpcall" "self" + ("bit32" . ("arshift" "band" "bnot" "bor" "btest" "bxor" "extract" + "lrotate" "lshift" "replace" "rrotate" "rshift")) + ("coroutine" . ("create" "isyieldable" "resume" "running" "status" + "wrap" "yield")) + ("debug" . ("debug" "getfenv" "gethook" "getinfo" "getlocal" + "getmetatable" "getregistry" "getupvalue" "getuservalue" + "setfenv" "sethook" "setlocal" "setmetatable" + "setupvalue" "setuservalue" "traceback" "upvalueid" + "upvaluejoin")) + ("io" . ("close" "flush" "input" "lines" "open" "output" "popen" + "read" "stderr" "stdin" "stdout" "tmpfile" "type" "write")) + ("math" . ("abs" "acos" "asin" "atan" "atan2" "ceil" "cos" "cosh" + "deg" "exp" "floor" "fmod" "frexp" "huge" "ldexp" "log" + "log10" "max" "maxinteger" "min" "mininteger" "modf" "pi" + "pow" "rad" "random" "randomseed" "sin" "sinh" "sqrt" + "tan" "tanh" "tointeger" "type" "ult")) + ("os" . ("clock" "date" "difftime" "execute" "exit" "getenv" + "remove" "rename" "setlocale" "time" "tmpname")) + ("package" . ("config" "cpath" "loaded" "loaders" "loadlib" "path" + "preload" "searchers" "searchpath" "seeall")) + ("string" . ("byte" "char" "dump" "find" "format" "gmatch" "gsub" + "len" "lower" "match" "pack" "packsize" "rep" "reverse" + "sub" "unpack" "upper")) + ("table" . ("concat" "insert" "maxn" "move" "pack" "remove" "sort" + "unpack")) + ("utf8" . ("char" "charpattern" "codepoint" "codes" "len" + "offset"))))) + + (cl-labels + ((module-name-re (x) + (concat "\\(?1:\\_<" + (if (listp x) (car x) x) + "\\_>\\)")) + (module-members-re (x) (if (listp x) + (concat "\\(?:[ \t]*\\.[ \t]*" + "\\_<\\(?2:" + (regexp-opt (cdr x)) + "\\)\\_>\\)?") + ""))) + + (concat + ;; common prefix: + ;; - beginning-of-line + ;; - or neither of [ '.', ':' ] to exclude "foo.string.rep" + ;; - or concatenation operator ".." + "\\(?:^\\|[^:. \t]\\|[.][.]\\)" + ;; optional whitespace + "[ \t]*" + "\\(?:" + ;; any of modules/functions + (mapconcat (lambda (x) (concat (module-name-re x) + (module-members-re x))) + modules + "\\|") + "\\)")))) + + "A regexp that matches Lua builtin functions & variables. + +This is a compilation of 5.1, 5.2 and 5.3 builtins taken from the +index of respective Lua reference manuals.") + + +(defvar lua-font-lock-keywords + `(;; highlight the hash-bang line "#!/foo/bar/lua" as comment + ("^#!.*$" . font-lock-comment-face) + + ;; Builtin constants + (,(lua-rx (symbol "true" "false" "nil")) + . font-lock-constant-face) + + ;; Keywords + (,(lua-rx (or lua-keyword lua-keyword-operator)) + . font-lock-keyword-face) + + ;; Labels used by the "goto" statement + ;; Highlights the following syntax: ::label:: + (,(lua-rx "::" ws lua-name ws "::") + . font-lock-constant-face) + + ;; Highlights the name of the label in the "goto" statement like + ;; "goto label" + (,(lua-rx (symbol (seq "goto" ws+ (group-n 1 lua-name)))) + (1 font-lock-constant-face)) + + ;; Highlight Lua builtin functions and variables + (,lua--builtins + (1 font-lock-builtin-face) (2 font-lock-builtin-face nil noerror)) + + (,(lua-rx (symbol "for") ws+ lua-up-to-9-variables) + (1 font-lock-variable-name-face) + (2 font-lock-variable-name-face nil noerror) + (3 font-lock-variable-name-face nil noerror) + (4 font-lock-variable-name-face nil noerror) + (5 font-lock-variable-name-face nil noerror) + (6 font-lock-variable-name-face nil noerror) + (7 font-lock-variable-name-face nil noerror) + (8 font-lock-variable-name-face nil noerror) + (9 font-lock-variable-name-face nil noerror)) + + (,(lua-rx (symbol "function") (? ws+ lua-funcname) ws "(" ws lua-up-to-9-variables) + (1 font-lock-variable-name-face) + (2 font-lock-variable-name-face nil noerror) + (3 font-lock-variable-name-face nil noerror) + (4 font-lock-variable-name-face nil noerror) + (5 font-lock-variable-name-face nil noerror) + (6 font-lock-variable-name-face nil noerror) + (7 font-lock-variable-name-face nil noerror) + (8 font-lock-variable-name-face nil noerror) + (9 font-lock-variable-name-face nil noerror)) + + (,(lua-rx lua-funcheader) + (1 font-lock-function-name-face)) + + ;; local x, y, z + ;; local x = ..... + ;; + ;; NOTE: this is intentionally below funcheader matcher, so that in + ;; + ;; local foo = function() ... + ;; + ;; "foo" is fontified as function-name-face, and variable-name-face is not applied. + (,(lua-rx (symbol "local") ws+ lua-up-to-9-variables) + (1 font-lock-variable-name-face) + (2 font-lock-variable-name-face nil noerror) + (3 font-lock-variable-name-face nil noerror) + (4 font-lock-variable-name-face nil noerror) + (5 font-lock-variable-name-face nil noerror) + (6 font-lock-variable-name-face nil noerror) + (7 font-lock-variable-name-face nil noerror) + (8 font-lock-variable-name-face nil noerror) + (9 font-lock-variable-name-face nil noerror)) + + (,(lua-rx (or (group-n 1 + "@" (symbol "author" "copyright" "field" "release" + "return" "see" "usage" "description")) + (seq (group-n 1 "@" (symbol "param" "class" "name")) ws+ + (group-n 2 lua-name)))) + (1 font-lock-keyword-face t) + (2 font-lock-variable-name-face t noerror))) + + "Default expressions to highlight in Lua mode.") + +(defvar lua-imenu-generic-expression + `(("Requires" ,(lua-rx (or bol ";") ws (opt (seq (symbol "local") ws)) (group-n 1 lua-name) ws "=" ws (symbol "require")) 1) + (nil ,(lua-rx (or bol ";") ws (opt (seq (symbol "local") ws)) lua-funcheader) 1)) + "Imenu generic expression for lua-mode. See `imenu-generic-expression'.") + +(defvar lua-sexp-alist '(("then" . "end") + ("function" . "end") + ("do" . "end") + ("repeat" . "until"))) + +(defvar lua-mode-abbrev-table nil + "Abbreviation table used in lua-mode buffers.") + +(define-abbrev-table 'lua-mode-abbrev-table + '(("end" "end" lua-indent-line :system t) + ("else" "else" lua-indent-line :system t) + ("elseif" "elseif" lua-indent-line :system t))) + +(defvar lua-mode-syntax-table + (with-syntax-table (copy-syntax-table) + ;; main comment syntax: begins with "--", ends with "\n" + (modify-syntax-entry ?- ". 12") + (modify-syntax-entry ?\n ">") + + ;; main string syntax: bounded by ' or " + (modify-syntax-entry ?\' "\"") + (modify-syntax-entry ?\" "\"") + + ;; single-character binary operators: punctuation + (modify-syntax-entry ?+ ".") + (modify-syntax-entry ?* ".") + (modify-syntax-entry ?/ ".") + (modify-syntax-entry ?^ ".") + (modify-syntax-entry ?% ".") + (modify-syntax-entry ?> ".") + (modify-syntax-entry ?< ".") + (modify-syntax-entry ?= ".") + (modify-syntax-entry ?~ ".") + + (syntax-table)) + "`lua-mode' syntax table.") + +;;;###autoload +(define-derived-mode lua-mode prog-mode "Lua" + "Major mode for editing Lua code." + :abbrev-table lua-mode-abbrev-table + :syntax-table lua-mode-syntax-table + :group 'lua + (setq-local font-lock-defaults '(lua-font-lock-keywords ;; keywords + nil ;; keywords-only + nil ;; case-fold + nil ;; syntax-alist + nil ;; syntax-begin + )) + + (setq-local syntax-propertize-function + 'lua--propertize-multiline-bounds) + + (setq-local parse-sexp-lookup-properties t) + (setq-local indent-line-function 'lua-indent-line) + (setq-local beginning-of-defun-function 'lua-beginning-of-proc) + (setq-local end-of-defun-function 'lua-end-of-proc) + (setq-local comment-start lua-comment-start) + (setq-local comment-start-skip lua-comment-start-skip) + (setq-local comment-use-syntax t) + (setq-local fill-paragraph-function #'lua--fill-paragraph) + (with-no-warnings + (setq-local comment-use-global-state t)) + (setq-local imenu-generic-expression lua-imenu-generic-expression) + (when (boundp 'electric-indent-chars) + ;; If electric-indent-chars is not defined, electric indentation is done + ;; via `lua-mode-map'. + (setq-local electric-indent-chars + (append electric-indent-chars lua--electric-indent-chars))) + (add-hook 'flymake-diagnostic-functions #'lua-flymake nil t) + + ;; setup menu bar entry (XEmacs style) + (if (and (featurep 'menubar) + (boundp 'current-menubar) + (fboundp 'set-buffer-menubar) + (fboundp 'add-menu) + (not (assoc "Lua" current-menubar))) + (progn + (set-buffer-menubar (copy-sequence current-menubar)) + (add-menu nil "Lua" lua-emacs-menu))) + ;; Append Lua menu to popup menu for Emacs. + (if (boundp 'mode-popup-menu) + (setq mode-popup-menu + (cons (concat mode-name " Mode Commands") lua-emacs-menu))) + + ;; hideshow setup + (unless (assq 'lua-mode hs-special-modes-alist) + (add-to-list 'hs-special-modes-alist + `(lua-mode + ,(regexp-opt (mapcar 'car lua-sexp-alist) 'words) ;start + ,(regexp-opt (mapcar 'cdr lua-sexp-alist) 'words) ;end + nil lua-forward-sexp)))) + + + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-mode)) + +;;;###autoload +(add-to-list 'interpreter-mode-alist '("lua" . lua-mode)) + +(defun lua-electric-match (arg) + "Insert character and adjust indentation." + (interactive "P") + (let (blink-paren-function) + (self-insert-command (prefix-numeric-value arg))) + (if lua-electric-flag + (lua-indent-line)) + (blink-matching-open)) + +;; private functions + +(defun lua--fill-paragraph (&optional justify region) + ;; Implementation of forward-paragraph for filling. + ;; + ;; This function works around a corner case in the following situations: + ;; + ;; <> + ;; -- some very long comment .... + ;; some_code_right_after_the_comment + ;; + ;; If point is at the beginning of the comment line, fill paragraph code + ;; would have gone for comment-based filling and done the right thing, but it + ;; does not find a comment at the beginning of the empty line before the + ;; comment and falls back to text-based filling ignoring comment-start and + ;; spilling the comment into the code. + (save-excursion + (while (and (not (eobp)) + (progn (move-to-left-margin) + (looking-at paragraph-separate))) + (forward-line 1)) + (let ((fill-paragraph-handle-comment t)) + (fill-paragraph justify region)))) + + +(defun lua-prefix-key-update-bindings () + (let (old-cons) + (if (eq lua-prefix-mode-map (keymap-parent lua-mode-map)) + ;; if prefix-map is a parent, delete the parent + (set-keymap-parent lua-mode-map nil) + ;; otherwise, look for it among children + (if (setq old-cons (rassoc lua-prefix-mode-map lua-mode-map)) + (delq old-cons lua-mode-map))) + + (if (null lua-prefix-key) + (set-keymap-parent lua-mode-map lua-prefix-mode-map) + (define-key lua-mode-map (vector lua-prefix-key) lua-prefix-mode-map)))) + +(defun lua-set-prefix-key (new-key-str) + "Changes `lua-prefix-key' properly and updates keymaps + +This function replaces previous prefix-key binding with a new one." + (interactive "sNew prefix key (empty string means no key): ") + (lua--customize-set-prefix-key 'lua-prefix-key new-key-str) + (message "Prefix key set to %S" (single-key-description lua-prefix-key)) + (lua-prefix-key-update-bindings)) + +(defun lua-string-p (&optional pos) + "Returns true if the point is in a string." + (save-excursion (elt (syntax-ppss pos) 3))) + +(defun lua--containing-double-hyphen-start-pos () + "Return position of the beginning comment delimiter (--). + +Emacs syntax framework does not consider comment delimiters as +part of the comment itself, but for this package it is useful to +consider point as inside comment when it is between the two hyphens" + (and (eql (char-before) ?-) + (eql (char-after) ?-) + (1- (point)))) + +(defun lua-comment-start-pos (&optional parsing-state) + "Return position of comment containing current point. + +If point is not inside a comment, return nil." + (unless parsing-state (setq parsing-state (syntax-ppss))) + (and + ;; Not a string + (not (nth 3 parsing-state)) + ;; Syntax-based comment + (or (and (nth 4 parsing-state) (nth 8 parsing-state)) + (lua--containing-double-hyphen-start-pos)))) + +(defun lua-comment-or-string-p (&optional pos) + "Returns true if the point is in a comment or string." + (save-excursion (let ((parse-result (syntax-ppss pos))) + (or (elt parse-result 3) (lua-comment-start-pos parse-result))))) + +(defun lua-comment-or-string-start-pos (&optional pos) + "Returns start position of string or comment which contains point. + +If point is not inside string or comment, return nil." + (save-excursion + (when pos (goto-char pos)) + (or (elt (syntax-ppss pos) 8) + (lua--containing-double-hyphen-start-pos)))) + +;; They're propertized as follows: +;; 1. generic-comment +;; 2. generic-string +;; 3. equals signs +(defconst lua-ml-begin-regexp + "\\(?:\\(?1:-\\)-\\[\\|\\(?2:\\[\\)\\)\\(?3:=*\\)\\[") + + +(defun lua-try-match-multiline-end (end) + "Try to match close-bracket for multiline literal around point. + +Basically, detect form of close bracket from syntactic +information provided at point and re-search-forward to it." + (let ((comment-or-string-start-pos (lua-comment-or-string-start-pos))) + ;; Is there a literal around point? + (and comment-or-string-start-pos + ;; It is, check if the literal is a multiline open-bracket + (save-excursion + (goto-char comment-or-string-start-pos) + (looking-at lua-ml-begin-regexp)) + + ;; Yes it is, look for it matching close-bracket. Close-bracket's + ;; match group is determined by match-group of open-bracket. + (re-search-forward + (format "]%s\\(?%s:]\\)" + (match-string-no-properties 3) + (if (match-beginning 1) 1 2)) + end 'noerror)))) + + +(defun lua-try-match-multiline-begin (limit) + "Try to match multiline open-brackets. + +Find next opening long bracket outside of any string/comment. +If none can be found before reaching LIMIT, return nil." + + (let (last-search-matched) + (while + ;; This loop will iterate skipping all multiline-begin tokens that are + ;; inside strings or comments ending either at EOL or at valid token. + (and (setq last-search-matched + (re-search-forward lua-ml-begin-regexp limit 'noerror)) + ;; Ensure --[[ is not inside a comment or string. + ;; + ;; This includes "---[[" sequence, in which "--" at the beginning + ;; creates a single-line comment, and thus "-[[" is no longer a + ;; multi-line opener. + ;; + ;; XXX: need to ensure syntax-ppss beyond (match-beginning 0) is + ;; not calculated, or otherwise we'll need to flush the cache. + (lua-comment-or-string-start-pos (match-beginning 0)))) + + last-search-matched)) + +(defun lua-match-multiline-literal-bounds (limit) + ;; First, close any multiline literal spanning from previous block. This will + ;; move the point accordingly so as to avoid double traversal. + (or (lua-try-match-multiline-end limit) + (lua-try-match-multiline-begin limit))) + +(defun lua--propertize-multiline-bounds (start end) + "Put text properties on beginnings and ends of multiline literals. + +Intended to be used as a `syntax-propertize-function'." + (save-excursion + (goto-char start) + (while (lua-match-multiline-literal-bounds end) + (when (match-beginning 1) + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "!"))) + (when (match-beginning 2) + (put-text-property (match-beginning 2) (match-end 2) + 'syntax-table (string-to-syntax "|")))))) + + +(defun lua-indent-line () + "Indent current line for Lua mode. +Return the amount the indentation changed by." + (let (indent + (case-fold-search nil) + ;; save point as a distance to eob - it's invariant w.r.t indentation + (pos (- (point-max) (point)))) + (back-to-indentation) + (if (lua-comment-or-string-p) + (setq indent (lua-calculate-string-or-comment-indentation)) ;; just restore point position + (setq indent (max 0 (lua-calculate-indentation)))) + + (when (not (equal indent (current-column))) + (delete-region (line-beginning-position) (point)) + (indent-to indent)) + + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + + indent)) + +(defun lua-calculate-string-or-comment-indentation () + "This function should be run when point at (current-indentation) is inside string" + (if (and (lua-string-p) (not lua-indent-string-contents)) + ;; if inside string and strings aren't to be indented, return current indentation + (current-indentation) + + ;; At this point, we know that we're inside comment, so make sure + ;; close-bracket is unindented like a block that starts after + ;; left-shifter. + (let ((left-shifter-p (looking-at "\\s *\\(?:--\\)?\\]\\(?1:=*\\)\\]"))) + (save-excursion + (goto-char (lua-comment-or-string-start-pos)) + (+ (current-indentation) + (if (and left-shifter-p + (looking-at (format "--\\[%s\\[" + (match-string-no-properties 1)))) + 0 + lua-indent-level)))))) + + +(defun lua--signum (x) + "Return 1 if X is positive, -1 if negative, 0 if zero." + ;; XXX: backport from cl-extras for Emacs24 + (cond ((> x 0) 1) ((< x 0) -1) (t 0))) + +(defun lua--ensure-point-within-limit (limit backward) + "Return non-nil if point is within LIMIT going forward. + +With BACKWARD non-nil, return non-nil if point is within LIMIT +going backward. + +If point is beyond limit, move it onto limit." + (if (= (lua--signum (- (point) limit)) + (if backward 1 -1)) + t + (goto-char limit) + nil)) + + +(defun lua--escape-from-string (&optional backward) + "Move point outside of string if it is inside one. + +By default, point is placed after the string, with BACKWARD it is +placed before the string." + (interactive) + (let ((parse-state (syntax-ppss))) + (when (nth 3 parse-state) + (if backward + (goto-char (nth 8 parse-state)) + (parse-partial-sexp (point) (line-end-position) nil nil (syntax-ppss) 'syntax-table)) + t))) + + +(defun lua-find-regexp (direction regexp &optional limit) + "Searches for a regular expression in the direction specified. + +Direction is one of \\='forward and \\='backward. + +Matches in comments and strings are ignored. If the regexp is +found, returns point position, nil otherwise." + (let ((search-func (if (eq direction 'forward) + 're-search-forward 're-search-backward)) + (case-fold-search nil)) + (cl-loop + always (or (null limit) + (lua--ensure-point-within-limit limit (not (eq direction 'forward)))) + always (funcall search-func regexp limit 'noerror) + for match-beg = (match-beginning 0) + for match-end = (match-end 0) + while (or (lua-comment-or-string-p match-beg) + (lua-comment-or-string-p match-end)) + do (let ((parse-state (syntax-ppss))) + (cond + ;; Inside a string + ((nth 3 parse-state) + (lua--escape-from-string (not (eq direction 'forward)))) + ;; Inside a comment + ((nth 4 parse-state) + (goto-char (nth 8 parse-state)) + (when (eq direction 'forward) + (forward-comment 1))))) + finally return (point)))) + + +(defconst lua-block-regexp + (eval-when-compile + (concat + "\\(\\_<" + (regexp-opt '("do" "function" "repeat" "then" + "else" "elseif" "end" "until") t) + "\\_>\\)\\|" + (regexp-opt '("{" "(" "[" "]" ")" "}") t)))) + +(defconst lua-block-token-alist + '(("do" "\\_" "\\_" middle-or-open) + ("function" "\\_" nil open) + ("repeat" "\\_" nil open) + ("then" "\\_<\\(e\\(lse\\(if\\)?\\|nd\\)\\)\\_>" "\\_<\\(else\\)?if\\_>" middle) + ("{" "}" nil open) + ("[" "]" nil open) + ("(" ")" nil open) + ("if" "\\_" nil open) + ("for" "\\_" nil open) + ("while" "\\_" nil open) + ("else" "\\_" "\\_" middle) + ("elseif" "\\_" "\\_" middle) + ("end" nil "\\_<\\(do\\|function\\|then\\|else\\)\\_>" close) + ("until" nil "\\_" close) + ("}" nil "{" close) + ("]" nil "\\[" close) + (")" nil "(" close)) + "This is a list of block token information blocks. +Each token information entry is of the form: + KEYWORD FORWARD-MATCH-REGEXP BACKWARDS-MATCH-REGEXP TOKEN-TYPE +KEYWORD is the token. +FORWARD-MATCH-REGEXP is a regexp that matches all possible tokens when going forward. +BACKWARDS-MATCH-REGEXP is a regexp that matches all possible tokens when going backwards. +TOKEN-TYPE determines where the token occurs on a statement. open indicates that the token appears at start, close indicates that it appears at end, middle indicates that it is a middle type token, and middle-or-open indicates that it can appear both as a middle or an open type.") + +(defconst lua-indentation-modifier-regexp + ;; The absence of else is deliberate, since it does not modify the + ;; indentation level per se. It only may cause the line, in which the + ;; else is, to be shifted to the left. + (concat + "\\(\\_<" + (regexp-opt '("do" "function" "repeat" "then" "if" "else" "elseif" "for" "while") t) + "\\_>\\|" + (regexp-opt '("{" "(" "[")) + "\\)\\|\\(\\_<" + (regexp-opt '("end" "until") t) + "\\_>\\|" + (regexp-opt '("]" ")" "}")) + "\\)") + ) + +(defun lua-get-block-token-info (token) + "Returns the block token info entry for TOKEN from lua-block-token-alist" + (assoc token lua-block-token-alist)) + +(defun lua-get-token-match-re (token-info direction) + "Returns the relevant match regexp from token info" + (cond + ((eq direction 'forward) (cadr token-info)) + ((eq direction 'backward) (nth 2 token-info)) + (t nil))) + +(defun lua-get-token-type (token-info) + "Returns the relevant match regexp from token info" + (nth 3 token-info)) + +(defun lua-backwards-to-block-begin-or-end () + "Move backwards to nearest block begin or end. Returns nil if not successful." + (interactive) + (lua-find-regexp 'backward lua-block-regexp)) + +(defun lua-find-matching-token-word (token &optional direction) + "Find matching open- or close-token for TOKEN in DIRECTION. +Point has to be exactly at the beginning of TOKEN, e.g. with | being point + + {{ }|} -- (lua-find-matching-token-word \"}\" \\='backward) will return + -- the first { + {{ |}} -- (lua-find-matching-token-word \"}\" \\='backward) will find + -- the second {. + +DIRECTION has to be either \\='forward or \\='backward." + (let* ((token-info (lua-get-block-token-info token)) + (match-type (lua-get-token-type token-info)) + ;; If we are on a middle token, go backwards. If it is a middle or open, + ;; go forwards + (search-direction (or direction + (if (or (eq match-type 'open) + (eq match-type 'middle-or-open)) + 'forward + 'backward) + 'backward)) + (match (lua-get-token-match-re token-info search-direction)) + maybe-found-pos) + ;; if we are searching forward from the token at the current point + ;; (i.e. for a closing token), need to step one character forward + ;; first, or the regexp will match the opening token. + (if (eq search-direction 'forward) (forward-char 1)) + (catch 'found + ;; If we are attempting to find a matching token for a terminating token + ;; (i.e. a token that starts a statement when searching back, or a token + ;; that ends a statement when searching forward), then we don't need to look + ;; any further. + (if (or (and (eq search-direction 'forward) + (eq match-type 'close)) + (and (eq search-direction 'backward) + (eq match-type 'open))) + (throw 'found nil)) + (while (lua-find-regexp search-direction lua-indentation-modifier-regexp) + ;; have we found a valid matching token? + (let ((found-token (match-string 0)) + (found-pos (match-beginning 0))) + (let ((found-type (lua-get-token-type + (lua-get-block-token-info found-token)))) + (if (not (and match (string-match match found-token))) + ;; no - then there is a nested block. If we were looking for + ;; a block begin token, found-token must be a block end + ;; token; likewise, if we were looking for a block end token, + ;; found-token must be a block begin token, otherwise there + ;; is a grammatical error in the code. + (if (not (and + (or (eq match-type 'middle) + (eq found-type 'middle) + (eq match-type 'middle-or-open) + (eq found-type 'middle-or-open) + (eq match-type found-type)) + (goto-char found-pos) + (lua-find-matching-token-word found-token + search-direction))) + (when maybe-found-pos + (goto-char maybe-found-pos) + (throw 'found maybe-found-pos))) + ;; yes. + ;; if it is a not a middle kind, report the location + (when (not (or (eq found-type 'middle) + (eq found-type 'middle-or-open))) + (throw 'found found-pos)) + ;; if it is a middle-or-open type, record location, but keep searching. + ;; If we fail to complete the search, we'll report the location + (when (eq found-type 'middle-or-open) + (setq maybe-found-pos found-pos)) + ;; Cannot use tail recursion. too much nesting on long chains of + ;; if/elseif. Will reset variables instead. + (setq token found-token) + (setq token-info (lua-get-block-token-info token)) + (setq match (lua-get-token-match-re token-info search-direction)) + (setq match-type (lua-get-token-type token-info)))))) + maybe-found-pos))) + +(defun lua-goto-matching-block-token (&optional parse-start direction) + "Find block begion/end token matching the one at the point. +This function moves the point to the token that matches the one +at the current point. Returns the point position of the first character of +the matching token if successful, nil otherwise. + +Optional PARSE-START is a position to which the point should be moved first. +DIRECTION has to be \\='forward or \\='backward (\\='forward by default)." + (if parse-start (goto-char parse-start)) + (let ((case-fold-search nil)) + (if (looking-at lua-indentation-modifier-regexp) + (let ((position (lua-find-matching-token-word (match-string 0) + direction))) + (and position + (goto-char position)))))) + +(defun lua-goto-matching-block (&optional noreport) + "Go to the keyword balancing the one under the point. +If the point is on a keyword/brace that starts a block, go to the +matching keyword that ends the block, and vice versa. + +If optional NOREPORT is non-nil, it won't flag an error if there +is no block open/close open." + (interactive) + ;; search backward to the beginning of the keyword if necessary + (when (and (eq (char-syntax (following-char)) ?w) + (not (looking-at "\\_<"))) + (re-search-backward "\\_<" nil t)) + (let ((position (lua-goto-matching-block-token))) + (if (and (not position) + (not noreport)) + (error "Not on a block control keyword or brace") + position))) + +(defun lua-skip-ws-and-comments-backward (&optional limit) + "Move point back skipping all whitespace and comments. + +If LIMIT is given, stop at it or before. + +Return non-nil if moved point." + (interactive) + (unless (lua-string-p) + (let ((start-pos (point)) + (comment-start-pos (lua-comment-start-pos))) + (setq limit (min (point) (or limit (point-min)))) + (when comment-start-pos + (goto-char (max limit comment-start-pos))) + (when (< limit (point)) (forward-comment (- limit (point)))) + (when (< (point) limit) (goto-char limit)) + (when (/= start-pos (point)) + (point))))) + +(defun lua-skip-ws-and-comments-forward (&optional limit) + "Move point forward skipping all whitespace and comments. + +If LIMIT is given, stop at it or before. + +Return non-nil if moved point." + (interactive) + (unless (lua-string-p) + (let ((start-pos (point)) + (comment-start-pos (lua-comment-start-pos))) + (setq limit (max (point) (or limit (point-max)))) + ;; Escape from current comment. It is necessary to use "while" because + ;; luadoc parameters have non-comment face, and parse-partial-sexp with + ;; 'syntax-table flag will stop on them. + (when comment-start-pos + (goto-char comment-start-pos) + (forward-comment 1)) + (when (< (point) limit) (forward-comment (- limit (point)))) + (when (< limit (point)) (goto-char limit)) + (when (/= start-pos (point)) + (point))))) + + +(defun lua-forward-line-skip-blanks (&optional back) + "Move 1 line forward/backward and skip all insignificant ws/comment lines. + +Moves point 1 line forward (or backward) skipping lines that contain +no Lua code besides comments. The point is put to the beginning of +the line. + +Returns final value of point as integer or nil if operation failed." + (let ((start-pos (point))) + (if back + (progn + (beginning-of-line) + (lua-skip-ws-and-comments-backward)) + (forward-line) + (lua-skip-ws-and-comments-forward)) + (beginning-of-line) + (when (> (count-lines start-pos (point)) 0) + (point)))) + +(eval-when-compile + (defconst lua-operator-class + "-+*/^.=<>~:&|")) + +(defconst lua-cont-eol-regexp + (eval-when-compile + (concat + "\\(?:\\(?1:\\_<" + (regexp-opt '("and" "or" "not" "in" "for" "while" + "local" "function" "if" "until" "elseif" "return") + t) + "\\_>\\)\\|" + "\\(?:^\\|[^" lua-operator-class "]\\)\\(?2:" + (regexp-opt '("+" "-" "*" "/" "%" "^" ".." "==" + "=" "<" ">" "<=" ">=" "~=" "." ":" + "&" "|" "~" ">>" "<<" "~" ",") + t) + "\\)\\)" + "\\s *\\=")) + "Regexp that matches the ending of a line that needs continuation. + +This regexp starts from eol and looks for a binary operator or an unclosed +block intro (i.e. `for' without `do' or `if' without `then') followed by +an optional whitespace till the end of the line.") + +(defconst lua-cont-bol-regexp + (eval-when-compile + (concat + "\\=\\s *" + "\\(?:\\(?1:\\_<" + (regexp-opt '("and" "or" "not" "in") t) + "\\_>\\)\\|\\(?2:" + (regexp-opt '("," "+" "-" "*" "/" "%" "^" ".." "==" + "=" "<" ">" "<=" ">=" "~=" "." ":" + "&" "|" "~" ">>" "<<" "~") + t) + "\\)\\(?:$\\|[^" lua-operator-class "]\\)" + "\\)")) + "Regexp that matches a line that continues previous one. + +This regexp means, starting from point there is an optional whitespace followed +by Lua binary operator. Lua is very liberal when it comes to continuation line, +so we're safe to assume that every line that starts with a binop continues +previous one even though it looked like an end-of-statement.") + +(defun lua-last-token-continues-p () + "Return non-nil if the last token on this line is a continuation token." + (let ((line-begin (line-beginning-position)) + return-value) + (save-excursion + (end-of-line) + (lua-skip-ws-and-comments-backward line-begin) + (setq return-value (and (re-search-backward lua-cont-eol-regexp line-begin t) + (or (match-beginning 1) + (match-beginning 2)))) + (if (and return-value + (string-equal (match-string-no-properties 0) "return")) + ;; "return" keyword is ambiguous and depends on next token + (unless (save-excursion + (goto-char (match-end 0)) + (forward-comment (point-max)) + (and + ;; Not continuing: at end of file + (not (eobp)) + (or + ;; "function" keyword: it is a continuation, e.g. + ;; + ;; return + ;; function() return 123 end + ;; + (looking-at (lua-rx (symbol "function"))) + ;; Looking at semicolon or any other keyword: not continuation + (not (looking-at (lua-rx (or ";" lua-keyword))))))) + (setq return-value nil))) + return-value))) + + +(defun lua-first-token-continues-p () + "Return non-nil if the first token on this line is a continuation token." + (let ((line-end (line-end-position))) + (save-excursion + (beginning-of-line) + (lua-skip-ws-and-comments-forward line-end) + ;; if first character of the line is inside string, it's a continuation + ;; if strings aren't supposed to be indented, `lua-calculate-indentation' won't even let + ;; the control inside this function + (and + (re-search-forward lua-cont-bol-regexp line-end t) + (or (match-beginning 1) + (match-beginning 2)))))) + + +(defun lua--backward-up-list-noerror () + "Safe version of lua-backward-up-list that does not signal an error." + (condition-case nil + (lua-backward-up-list) + (scan-error nil))) + + +(defun lua-backward-up-list () + "Goto starter/opener of the block that contains point." + (interactive) + (let ((start-pos (point)) + end-pos) + (or + ;; Return parent block opener token if it exists. + (cl-loop + ;; Search indentation modifier backward, return nil on failure. + always (lua-find-regexp 'backward lua-indentation-modifier-regexp) + ;; Fetch info about the found token + for token = (match-string-no-properties 0) + for token-info = (lua-get-block-token-info token) + for token-type = (lua-get-token-type token-info) + ;; If the token is a close token, continue to skip its opener. If not + ;; close, stop and return found token. + while (eq token-type 'close) + ;; Find matching opener to skip it and continue from beginning. + ;; + ;; Return nil on failure. + always (let ((position (lua-find-matching-token-word token 'backward))) + (and position (goto-char position))) + finally return token-info) + (progn + (setq end-pos (point)) + (goto-char start-pos) + (signal 'scan-error + (list "Block open token not found" + ;; If start-pos == end-pos, the "obstacle" is current + (if (eql start-pos end-pos) start-pos (match-beginning 0)) + (if (eql start-pos end-pos) start-pos (match-end 0)))))))) + +(defun lua--continuation-breaking-line-p () + "Return non-nil if looking at token(-s) that forbid continued line." + (save-excursion + (lua-skip-ws-and-comments-forward (line-end-position)) + (looking-at (lua-rx (or (symbol "do" "while" "repeat" "until" + "if" "then" "elseif" "else" + "for" "local") + lua-funcheader))))) + + +(defun lua-is-continuing-statement-p-1 () + "Return non-nil if current lined continues a statement. + +More specifically, return the point in the line that is continued. +The criteria for a continuing statement are: + +* the last token of the previous line is a continuing op, + OR the first token of the current line is a continuing op + +* the expression is not enclosed by a parentheses/braces/brackets" + (let (prev-line continuation-pos parent-block-opener) + (save-excursion (setq prev-line (lua-forward-line-skip-blanks 'back))) + (and prev-line + (not (lua--continuation-breaking-line-p)) + (save-excursion + (or + ;; Binary operator or keyword that implies continuation. + (and (setq continuation-pos + (or (lua-first-token-continues-p) + (save-excursion (and (goto-char prev-line) + ;; check last token of previous nonblank line + (lua-last-token-continues-p))))) + (not + ;; Operators/keywords does not create continuation inside some blocks: + (and + (setq parent-block-opener (car-safe (lua--backward-up-list-noerror))) + (or + ;; - inside parens/brackets + (member parent-block-opener '("(" "[")) + ;; - inside braces if it is a comma + (and (eq (char-after continuation-pos) ?,) + (equal parent-block-opener "{"))))) + continuation-pos)))))) + + +(defun lua-is-continuing-statement-p (&optional parse-start) + "Returns non-nil if the line at PARSE-START should be indented as continuation line. + +This true is when the line : + +* is continuing a statement itself + +* starts with a 1+ block-closer tokens, an top-most block opener is on a continuation line +" + (save-excursion + (if parse-start (goto-char parse-start)) + + ;; If line starts with a series of closer tokens, whether or not the line + ;; is a continuation line is decided by the opener line, e.g. + ;; + ;; x = foo + + ;; long_function_name( + ;; long_parameter_1, + ;; long_parameter_2, + ;; long_parameter_3, + ;; ) + long_function_name2({ + ;; long_parameter_1, + ;; long_parameter_2, + ;; long_parameter_3, + ;; }) + ;; + ;; Final line, "})" is a continuation line, but it is decided by the + ;; opener line, ") + long_function_name2({", which in its turn is decided + ;; by the "long_function_name(" line, which is a continuation line + ;; because the line before it ends with a binary operator. + (cl-loop + ;; Go to opener line + while (and (lua--goto-line-beginning-rightmost-closer) + (lua--backward-up-list-noerror)) + ;; If opener line is continuing, repeat. If opener line is not + ;; continuing, return nil. + always (lua-is-continuing-statement-p-1) + ;; We get here if there was no opener to go to: check current line. + finally return (lua-is-continuing-statement-p-1)))) + +(defun lua-make-indentation-info-pair (found-token found-pos) + "Create a pair from FOUND-TOKEN and FOUND-POS for indentation calculation. + +This is a helper function to lua-calculate-indentation-info. +Don't use standalone." + (cond + ;; function is a bit tricky to indent right. They can appear in a lot ot + ;; different contexts. Until I find a shortcut, I'll leave it with a simple + ;; relative indentation. + ;; The special cases are for indenting according to the location of the + ;; function. i.e.: + ;; (cons 'absolute (+ (current-column) lua-indent-level)) + ;; TODO: Fix this. It causes really ugly indentations for in-line functions. + ((string-equal found-token "function") + (cons 'relative lua-indent-level)) + + ;; block openers + ((and lua-indent-nested-block-content-align + (member found-token (list "{" "(" "["))) + (save-excursion + (let ((found-bol (line-beginning-position))) + (forward-comment (point-max)) + ;; If the next token is on this line and it's not a block opener, + ;; the next line should align to that token. + (if (and (zerop (count-lines found-bol (line-beginning-position))) + (not (looking-at lua-indentation-modifier-regexp))) + (cons 'absolute (current-column)) + (cons 'relative lua-indent-level))))) + + ;; These are not really block starters. They should not add to indentation. + ;; The corresponding "then" and "do" handle the indentation. + ((member found-token (list "if" "for" "while")) + (cons 'relative 0)) + ;; closing tokens follow: These are usually taken care of by + ;; lua-calculate-indentation-override. + ;; elseif is a bit of a hack. It is not handled separately, but it needs to + ;; nullify a previous then if on the same line. + ((member found-token (list "until" "elseif")) + (save-excursion + (let* ((line-beginning (line-beginning-position)) + (same-line (and (lua-goto-matching-block-token found-pos 'backward) + (<= line-beginning (point))))) + (if same-line + (cons 'remove-matching 0) + (cons 'relative 0))))) + + ;; else is a special case; if its matching block token is on the same line, + ;; instead of removing the matching token, it has to replace it, so that + ;; either the next line will be indented correctly, or the end on the same + ;; line will remove the effect of the else. + ((string-equal found-token "else") + (save-excursion + (let* ((line-beginning (line-beginning-position)) + (same-line (and (lua-goto-matching-block-token found-pos 'backward) + (<= line-beginning (point))))) + (if same-line + (cons 'replace-matching (cons 'relative lua-indent-level)) + (cons 'relative lua-indent-level))))) + + ;; Block closers. If they are on the same line as their openers, they simply + ;; eat up the matching indentation modifier. Otherwise, they pull + ;; indentation back to the matching block opener. + ((member found-token (list ")" "}" "]" "end")) + (save-excursion + (let* ((line-beginning (line-beginning-position)) + (same-line (and (lua-goto-matching-block-token found-pos 'backward) + (<= line-beginning (point)))) + (opener-pos (point)) + opener-continuation-offset) + (if same-line + (cons 'remove-matching 0) + (back-to-indentation) + (setq opener-continuation-offset + (if (lua-is-continuing-statement-p-1) lua-indent-level 0)) + + ;; Accumulate indentation up to opener, including indentation. If + ;; there were no other indentation modifiers until said opener, + ;; ensure there is no continuation after the closer. + `(multiple . ((absolute . ,(- (current-indentation) opener-continuation-offset)) + ,@(when (/= opener-continuation-offset 0) + (list (cons 'continued-line opener-continuation-offset))) + ,@(delete nil (list (lua-calculate-indentation-info-1 nil opener-pos))) + (cancel-continued-line . nil))))))) + + ((member found-token '("do" "then")) + `(multiple . ((cancel-continued-line . nil) (relative . ,lua-indent-level)))) + + ;; Everything else. This is from the original code: If opening a block + ;; (match-data 1 exists), then push indentation one level up, if it is + ;; closing a block, pull it one level down. + ('other-indentation-modifier + (cons 'relative (if (nth 2 (match-data)) + ;; beginning of a block matched + lua-indent-level + ;; end of a block matched + (- lua-indent-level)))))) + +(defun lua-add-indentation-info-pair (pair info-list) + "Add the given indentation info PAIR to the list of indentation INFO-LIST. +This function has special case handling for two tokens: remove-matching, +and replace-matching. These two tokens are cleanup tokens that remove or +alter the effect of a previously recorded indentation info. + +When a remove-matching token is encountered, the last recorded info, i.e. +the car of the list is removed. This is used to roll-back an indentation of a +block opening statement when it is closed. + +When a replace-matching token is seen, the last recorded info is removed, +and the cdr of the replace-matching info is added in its place. This is used +when a middle-of the block (the only case is `else') is seen on the same line +the block is opened." + (cond + ( (eq 'multiple (car pair)) + (let ((info-pair-elts (cdr pair))) + (while info-pair-elts + (setq info-list (lua-add-indentation-info-pair (car info-pair-elts) info-list) + info-pair-elts (cdr info-pair-elts))) + info-list)) + ( (eq 'cancel-continued-line (car pair)) + (if (eq (caar info-list) 'continued-line) + (cdr info-list) + info-list)) + ( (eq 'remove-matching (car pair)) + ;; Remove head of list + (cdr info-list)) + ( (eq 'replace-matching (car pair)) + ;; remove head of list, and add the cdr of pair instead + (cons (cdr pair) (cdr info-list))) + ( (listp (cdr-safe pair)) + (nconc pair info-list)) + ( t + ;; Just add the pair + (cons pair info-list)))) + +(defun lua-calculate-indentation-info-1 (indentation-info bound) + "Helper function for `lua-calculate-indentation-info'. + +Return list of indentation modifiers from point to BOUND." + (while (lua-find-regexp 'forward lua-indentation-modifier-regexp + bound) + (let ((found-token (match-string 0)) + (found-pos (match-beginning 0))) + (setq indentation-info + (lua-add-indentation-info-pair + (lua-make-indentation-info-pair found-token found-pos) + indentation-info)))) + indentation-info) + + +(defun lua-calculate-indentation-info (&optional parse-end) + "For each block token on the line, computes how it affects the indentation. +The effect of each token can be either a shift relative to the current +indentation level, or indentation to some absolute column. This information +is collected in a list of indentation info pairs, which denote absolute +and relative each, and the shift/column to indent to." + (let (indentation-info cont-stmt-pos) + (while (setq cont-stmt-pos (lua-is-continuing-statement-p)) + (lua-forward-line-skip-blanks 'back) + (when (< cont-stmt-pos (point)) + (goto-char cont-stmt-pos))) + + ;; calculate indentation modifiers for the line itself + (setq indentation-info (list (cons 'absolute (current-indentation)))) + + (back-to-indentation) + (setq indentation-info + (lua-calculate-indentation-info-1 + indentation-info (min parse-end (line-end-position)))) + + ;; and do the following for each continuation line before PARSE-END + (while (and (eql (forward-line 1) 0) + (<= (point) parse-end)) + + ;; handle continuation lines: + (if (lua-is-continuing-statement-p) + ;; if it's the first continuation line, add one level + (unless (eq (car (car indentation-info)) 'continued-line) + (push (cons 'continued-line lua-indent-level) indentation-info)) + + ;; if it's the first non-continued line, subtract one level + (when (eq (car (car indentation-info)) 'continued-line) + (push (cons 'stop-continued-line (- lua-indent-level)) indentation-info))) + + ;; add modifiers found in this continuation line + (setq indentation-info + (lua-calculate-indentation-info-1 + indentation-info (min parse-end (line-end-position))))) + + indentation-info)) + + +(defun lua-accumulate-indentation-info (reversed-indentation-info) + "Accumulates the indentation information previously calculated by +lua-calculate-indentation-info. Returns either the relative indentation +shift, or the absolute column to indent to." + (let (indentation-info + (type 'relative) + (accu 0)) + ;; Aggregate all neighbouring relative offsets, reversing the INFO list. + (cl-dolist (elt reversed-indentation-info) + (if (and (eq (car elt) 'relative) + (eq (caar indentation-info) 'relative)) + (setcdr (car indentation-info) (+ (cdar indentation-info) (cdr elt))) + (push elt indentation-info))) + + ;; Aggregate indentation info, taking 'absolute modifiers into account. + (mapc (lambda (x) + (let ((new-val (cdr x))) + (if (eq 'absolute (car x)) + (progn (setq type 'absolute + accu new-val)) + (setq accu (+ accu new-val))))) + indentation-info) + + (cons type accu))) + +(defun lua-calculate-indentation-block-modifier (&optional parse-end) + "Return amount by which this line modifies the indentation. +Beginnings of blocks add lua-indent-level once each, and endings +of blocks subtract lua-indent-level once each. This function is used +to determine how the indentation of the following line relates to this +one." + (let (indentation-info) + (save-excursion + ;; First go back to the line that starts it all + ;; lua-calculate-indentation-info will scan through the whole thing + (let ((case-fold-search nil)) + (setq indentation-info + (lua-accumulate-indentation-info + (lua-calculate-indentation-info parse-end))))) + + (if (eq (car indentation-info) 'absolute) + (- (cdr indentation-info) (current-indentation)) + (cdr indentation-info)))) + + +(eval-when-compile + (defconst lua--function-name-rx + '(seq symbol-start + (+ (any alnum "_")) + (* "." (+ (any alnum "_"))) + (? ":" (+ (any alnum "_"))) + symbol-end) + "Lua function name regexp in `rx'-SEXP format.")) + + +(defconst lua--left-shifter-regexp + (eval-when-compile + (rx + ;; This regexp should answer the following questions: + ;; 1. is there a left shifter regexp on that line? + ;; 2. where does block-open token of that left shifter reside? + (or (seq (group-n 1 symbol-start "local" (+ blank)) "function" symbol-end) + + (seq (group-n 1 (eval lua--function-name-rx) (* blank)) (any "{(")) + (seq (group-n 1 (or + ;; assignment statement prefix + (seq (* nonl) (not (any "<=>~")) "=" (* blank)) + ;; return statement prefix + (seq word-start "return" word-end (* blank)))) + ;; right hand side + (or "{" + "function" + "(" + (seq (group-n 1 (eval lua--function-name-rx) (* blank)) + (any "({"))))))) + + "Regular expression that matches left-shifter expression. + +Left-shifter expression is defined as follows. If a block +follows a left-shifter expression, its contents & block-close +token should be indented relative to left-shifter expression +indentation rather then to block-open token. + +For example: + -- `local a = ' is a left-shifter expression + -- `function' is a block-open token + local a = function() + -- block contents is indented relative to left-shifter + foobarbaz() + -- block-end token is unindented to left-shifter indentation + end + +The following left-shifter expressions are currently handled: +1. local function definition with function block, begin-end +2. function call with arguments block, () or {} +3. assignment/return statement with + - table constructor block, {} + - function call arguments block, () or {} block + - function expression a.k.a. lambda, begin-end block.") + + +(defun lua-point-is-after-left-shifter-p () + "Check if point is right after a left-shifter expression. + +See `lua--left-shifter-regexp' for description & example of +left-shifter expression. " + (save-excursion + (let ((old-point (point))) + (back-to-indentation) + (and + (/= (point) old-point) + (looking-at lua--left-shifter-regexp) + (= old-point (match-end 1)))))) + +(defun lua--goto-line-beginning-rightmost-closer (&optional parse-start) + (let (case-fold-search pos line-end-pos return-val) + (save-excursion + (if parse-start (goto-char parse-start)) + (setq line-end-pos (line-end-position)) + (back-to-indentation) + (unless (lua-comment-or-string-p) + (cl-loop while (and (<= (point) line-end-pos) + (looking-at lua-indentation-modifier-regexp)) + for token-info = (lua-get-block-token-info (match-string 0)) + for token-type = (lua-get-token-type token-info) + while (not (eq token-type 'open)) + do (progn + (setq pos (match-beginning 0) + return-val token-info) + (goto-char (match-end 0)) + (forward-comment (line-end-position)))))) + (when pos + (progn + (goto-char pos) + return-val)))) + + +(defun lua-calculate-indentation-override (&optional parse-start) + "Return overriding indentation amount for special cases. + +If there's a sequence of block-close tokens starting at the +beginning of the line, calculate indentation according to the +line containing block-open token for the last block-close token +in the sequence. + +If not, return nil." + (let (case-fold-search rightmost-closer-info opener-info opener-pos) + (save-excursion + (when (and (setq rightmost-closer-info (lua--goto-line-beginning-rightmost-closer parse-start)) + (setq opener-info (lua--backward-up-list-noerror)) + ;; Ensure opener matches closer. + (string-match (lua-get-token-match-re rightmost-closer-info 'backward) + (car opener-info))) + + ;; Special case: "middle" tokens like for/do, while/do, if/then, + ;; elseif/then: corresponding "end" or corresponding "else" must be + ;; unindented to the beginning of the statement, which is not + ;; necessarily the same as beginning of string that contains "do", e.g. + ;; + ;; while ( + ;; foo and + ;; bar) do + ;; hello_world() + ;; end + (setq opener-pos (point)) + (when (/= (- opener-pos (line-beginning-position)) (current-indentation)) + (unless (or + (and (string-equal (car opener-info) "do") + (member (car (lua--backward-up-list-noerror)) '("while" "for"))) + (and (string-equal (car opener-info) "then") + (member (car (lua--backward-up-list-noerror)) '("if" "elseif")))) + (goto-char opener-pos))) + + ;; (let (cont-stmt-pos) + ;; (while (setq cont-stmt-pos (lua-is-continuing-statement-p)) + ;; (goto-char cont-stmt-pos))) + ;; Exception cases: when the start of the line is an assignment, + ;; go to the start of the assignment instead of the matching item + (if (and lua-indent-close-paren-align + (member (car opener-info) '("{" "(" "[")) + (not (lua-point-is-after-left-shifter-p))) + (current-column) + (current-indentation)))))) + + +(defun lua-calculate-indentation () + "Return appropriate indentation for current line as Lua code." + (save-excursion + (let ((cur-line-begin-pos (line-beginning-position))) + (or + ;; when calculating indentation, do the following: + ;; 1. check, if the line starts with indentation-modifier (open/close brace) + ;; and if it should be indented/unindented in special way + (lua-calculate-indentation-override) + + (when (lua-forward-line-skip-blanks 'back) + ;; the order of function calls here is important. block modifier + ;; call may change the point to another line + (let* ((modifier + (lua-calculate-indentation-block-modifier cur-line-begin-pos))) + (+ (current-indentation) modifier))) + + ;; 4. if there's no previous line, indentation is 0 + 0)))) + +(defvar lua--beginning-of-defun-re + (lua-rx-to-string '(: bol (? (symbol "local") ws+) lua-funcheader)) + "Lua top level (matches only at the beginning of line) function header regex.") + + +(defun lua-beginning-of-proc (&optional arg) + "Move backward to the beginning of a Lua proc (or similar). + +With argument, do it that many times. Negative arg -N +means move forward to Nth following beginning of proc. + +Returns t unless search stops due to beginning or end of buffer." + (interactive "P") + (or arg (setq arg 1)) + + (while (and (> arg 0) + (re-search-backward lua--beginning-of-defun-re nil t)) + (setq arg (1- arg))) + + (while (and (< arg 0) + (re-search-forward lua--beginning-of-defun-re nil t)) + (beginning-of-line) + (setq arg (1+ arg))) + + (zerop arg)) + +(defun lua-end-of-proc (&optional arg) + "Move forward to next end of Lua proc (or similar). +With argument, do it that many times. Negative argument -N means move +back to Nth preceding end of proc. + +This function just searches for a `end' at the beginning of a line." + (interactive "P") + (or arg + (setq arg 1)) + (let ((found nil) + (ret t)) + (if (and (< arg 0) + (not (bolp)) + (save-excursion + (beginning-of-line) + (eq (following-char) ?}))) + (forward-char -1)) + (while (> arg 0) + (if (re-search-forward "^end" nil t) + (setq arg (1- arg) + found t) + (setq ret nil + arg 0))) + (while (< arg 0) + (if (re-search-backward "^end" nil t) + (setq arg (1+ arg) + found t) + (setq ret nil + arg 0))) + (if found + (progn + (beginning-of-line) + (forward-line))) + ret)) + +(defvar lua-process-init-code + (mapconcat + 'identity + '("local loadstring = loadstring or load" + "function luamode_loadstring(str, displayname, lineoffset)" + " if lineoffset > 1 then" + " str = string.rep('\\n', lineoffset - 1) .. str" + " end" + "" + " local x, e = loadstring(str, '@'..displayname)" + " if e then" + " error(e)" + " end" + " return x()" + "end") + " ")) + +(defun lua-make-lua-string (str) + "Convert string to Lua literal." + (save-match-data + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (while (re-search-forward "[\"'\\\t\\\n]" nil t) + (cond + ((string= (match-string 0) "\n") + (replace-match "\\\\n")) + ((string= (match-string 0) "\t") + (replace-match "\\\\t")) + (t + (replace-match "\\\\\\&" t)))) + (concat "'" (buffer-string) "'")))) + +;;;###autoload +(defalias 'run-lua #'lua-start-process) + +;;;###autoload +(defun lua-start-process (&optional name program startfile &rest switches) + "Start a Lua process named NAME, running PROGRAM. +PROGRAM defaults to NAME, which defaults to `lua-default-application'. +When called interactively, switch to the process buffer." + (interactive) + (setq name (or name (if (consp lua-default-application) + (car lua-default-application) + lua-default-application))) + (setq program (or program lua-default-application)) + ;; don't re-initialize if there already is a lua process + (unless (comint-check-proc (format "*%s*" name)) + (setq lua-process-buffer (apply #'make-comint name program startfile + (or switches lua-default-command-switches))) + (setq lua-process (get-buffer-process lua-process-buffer)) + (set-process-query-on-exit-flag lua-process nil) + (with-current-buffer lua-process-buffer + ;; enable error highlighting in stack traces + (require 'compile) + (setq lua--repl-buffer-p t) + (make-local-variable 'compilation-error-regexp-alist) + (setq compilation-error-regexp-alist + (cons (list lua-traceback-line-re 1 2) + compilation-error-regexp-alist)) + (compilation-shell-minor-mode 1) + (setq-local comint-prompt-regexp lua-prompt-regexp) + + ;; Don't send initialization code until seeing the prompt to ensure that + ;; the interpreter is ready. + (while (not (lua-prompt-line)) + (accept-process-output (get-buffer-process (current-buffer))) + (goto-char (point-max))) + (lua-send-string lua-process-init-code))) + + ;; when called interactively, switch to process buffer + (if (called-interactively-p 'any) + (switch-to-buffer lua-process-buffer))) + +(defun lua-get-create-process () + "Return active Lua process creating one if necessary." + (lua-start-process) + lua-process) + +(defun lua-kill-process () + "Kill Lua process and its buffer." + (interactive) + (when (buffer-live-p lua-process-buffer) + (kill-buffer lua-process-buffer) + (setq lua-process-buffer nil))) + +(defun lua-set-lua-region-start (&optional arg) + "Set start of region for use with `lua-send-lua-region'." + (interactive) + (set-marker lua-region-start (or arg (point)))) + +(defun lua-set-lua-region-end (&optional arg) + "Set end of region for use with `lua-send-lua-region'." + (interactive) + (set-marker lua-region-end (or arg (point)))) + +(defun lua-send-string (str) + "Send STR plus a newline to the Lua process. + +If `lua-process' is nil or dead, start a new process first." + (unless (string-equal (substring str -1) "\n") + (setq str (concat str "\n"))) + (process-send-string (lua-get-create-process) str)) + +(defun lua-send-current-line () + "Send current line to the Lua process, found in `lua-process'. +If `lua-process' is nil or dead, start a new process first." + (interactive) + (lua-send-region (line-beginning-position) (line-end-position))) + +(defun lua-send-defun (pos) + "Send the function definition around point to the Lua process." + (interactive "d") + (save-excursion + (let ((start (if (save-match-data (looking-at "^function[ \t]")) + ;; point already at the start of "function". + ;; We need to handle this case explicitly since + ;; lua-beginning-of-proc will move to the + ;; beginning of the _previous_ function. + (point) + ;; point is not at the beginning of function, move + ;; there and bind start to that position + (lua-beginning-of-proc) + (point))) + (end (progn (lua-end-of-proc) (point)))) + + ;; make sure point is in a function definition before sending to + ;; the process + (if (and (>= pos start) (< pos end)) + (lua-send-region start end) + (error "Not on a function definition"))))) + +(defun lua-maybe-skip-shebang-line (start) + "Skip shebang (#!/path/to/interpreter/) line at beginning of buffer. + +Return a position that is after Lua-recognized shebang line (1st +character in file must be ?#) if START is at its beginning. +Otherwise, return START." + (save-restriction + (widen) + (if (and (eq start (point-min)) + (eq (char-after start) ?#)) + (save-excursion + (goto-char start) + (forward-line) + (point)) + start))) + +(defun lua-send-region (start end) + (interactive "r") + (setq start (lua-maybe-skip-shebang-line start)) + (let* ((lineno (line-number-at-pos start)) + (lua-file (or (buffer-file-name) (buffer-name))) + (region-str (buffer-substring-no-properties start end)) + (command + ;; Print empty line before executing the code so that the first line + ;; of output doesn't end up on the same line as current prompt. + (format "print(''); luamode_loadstring(%s, %s, %s);\n" + (lua-make-lua-string region-str) + (lua-make-lua-string lua-file) + lineno))) + (lua-send-string command) + (when lua-always-show (lua-show-process-buffer)))) + +(defun lua-prompt-line () + (save-excursion + (save-match-data + (forward-line 0) + (if (looking-at comint-prompt-regexp) + (match-end 0))))) + +(defun lua-send-lua-region () + "Send preset Lua region to Lua process." + (interactive) + (unless (and lua-region-start lua-region-end) + (error "lua-region not set")) + (lua-send-region lua-region-start lua-region-end)) + +(defalias 'lua-send-proc 'lua-send-defun) + +(defun lua-send-buffer () + "Send whole buffer to Lua process." + (interactive) + (lua-send-region (point-min) (point-max))) + +(defun lua-restart-with-whole-file () + "Restart Lua process and send whole file as input." + (interactive) + (lua-kill-process) + (lua-send-buffer)) + +(defun lua-show-process-buffer () + "Make sure `lua-process-buffer' is being displayed. +Create a Lua process if one doesn't already exist." + (interactive) + (display-buffer (process-buffer (lua-get-create-process)))) + + +(defun lua-hide-process-buffer () + "Delete all windows that display `lua-process-buffer'." + (interactive) + (when (buffer-live-p lua-process-buffer) + (delete-windows-on lua-process-buffer))) + +(defun lua--funcname-char-p (c) + "Check if character C is part of a function name. +Return nil if C is nil. See `lua-funcname-at-point'." + (and c (string-match-p "\\`[A-Za-z_.]\\'" (string c)))) + +(defun lua-funcname-at-point () + "Get current Name { '.' Name } sequence." + (when (or (lua--funcname-char-p (char-before)) + (lua--funcname-char-p (char-after))) + (save-excursion + (save-match-data + (re-search-backward "\\`\\|[^A-Za-z_.]") + ;; NOTE: `point' will be either at the start of the buffer or on a + ;; non-symbol character. + (re-search-forward "\\([A-Za-z_]+\\(?:\\.[A-Za-z_]+\\)*\\)") + (match-string-no-properties 1))))) + +(defun lua-search-documentation () + "Search Lua documentation for the word at the point." + (interactive) + (let ((url (concat lua-documentation-url "#pdf-" (lua-funcname-at-point)))) + (funcall lua-documentation-function url))) + +(defun lua-toggle-electric-state (&optional arg) + "Toggle the electric indentation feature. +Optional numeric ARG, if supplied, turns on electric indentation when +positive, turns it off when negative, and just toggles it when zero or +left out." + (interactive "P") + (let ((num_arg (prefix-numeric-value arg))) + (setq lua-electric-flag (cond ((or (null arg) + (zerop num_arg)) (not lua-electric-flag)) + ((< num_arg 0) nil) + ((> num_arg 0) t)))) + (message "%S" lua-electric-flag)) + +(defun lua-forward-sexp (&optional count) + "Forward to block end" + (interactive "p") + ;; negative offsets not supported + (cl-assert (or (not count) (>= count 0))) + (save-match-data + (let ((count (or count 1)) + (block-start (mapcar 'car lua-sexp-alist))) + (while (> count 0) + ;; skip whitespace + (skip-chars-forward " \t\n") + (if (looking-at (regexp-opt block-start 'words)) + (let ((keyword (match-string 1))) + (lua-find-matching-token-word keyword 'forward)) + ;; If the current keyword is not a "begin" keyword, then just + ;; perform the normal forward-sexp. + (forward-sexp 1)) + (setq count (1- count)))))) + +;; Flymake integration + +(defcustom lua-luacheck-program "luacheck" + "Name of the luacheck executable." + :type 'string + :group 'lua) + +(defvar-local lua--flymake-process nil) + +(defun lua-flymake (report-fn &rest _args) + "Flymake backend using the luacheck program. +Takes a Flymake callback REPORT-FN as argument, as expected of a +member of `flymake-diagnostic-functions'." + (when (process-live-p lua--flymake-process) + (kill-process lua--flymake-process)) + (let ((source (current-buffer))) + (save-restriction + (widen) + (setq lua--flymake-process + (make-process + :name "luacheck" :noquery t :connection-type 'pipe + :buffer (generate-new-buffer " *flymake-luacheck*") + :command `(,lua-luacheck-program + "--codes" "--ranges" "--formatter" "plain" "-") + :sentinel + (lambda (proc _event) + (when (eq 'exit (process-status proc)) + (unwind-protect + (if (with-current-buffer source + (eq proc lua--flymake-process)) + (with-current-buffer (process-buffer proc) + (goto-char (point-min)) + (cl-loop + while (search-forward-regexp + "^\\([^:]*\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\): \\(.*\\)$" + nil t) + for line = (string-to-number (match-string 2)) + for col1 = (string-to-number (match-string 3)) + for col2 = (1+ (string-to-number (match-string 4))) + for msg = (match-string 5) + for type = (if (string-match-p "\\`(E" msg) :error :warning) + collect (flymake-make-diagnostic source + (cons line col1) + (cons line col2) + type + msg) + into diags + finally (funcall report-fn diags))) + (flymake-log :warning "Canceling obsolete check %s" proc)) + (kill-buffer (process-buffer proc))))))) + (process-send-region lua--flymake-process (point-min) (point-max)) + (process-send-eof lua--flymake-process)))) + +;; menu bar + +(define-key lua-mode-menu [restart-with-whole-file] + '("Restart With Whole File" . lua-restart-with-whole-file)) +(define-key lua-mode-menu [kill-process] + '("Kill Process" . lua-kill-process)) + +(define-key lua-mode-menu [hide-process-buffer] + '("Hide Process Buffer" . lua-hide-process-buffer)) +(define-key lua-mode-menu [show-process-buffer] + '("Show Process Buffer" . lua-show-process-buffer)) + +(define-key lua-mode-menu [end-of-proc] + '("End Of Proc" . lua-end-of-proc)) +(define-key lua-mode-menu [beginning-of-proc] + '("Beginning Of Proc" . lua-beginning-of-proc)) + +(define-key lua-mode-menu [send-lua-region] + '("Send Lua-Region" . lua-send-lua-region)) +(define-key lua-mode-menu [set-lua-region-end] + '("Set Lua-Region End" . lua-set-lua-region-end)) +(define-key lua-mode-menu [set-lua-region-start] + '("Set Lua-Region Start" . lua-set-lua-region-start)) + +(define-key lua-mode-menu [send-current-line] + '("Send Current Line" . lua-send-current-line)) +(define-key lua-mode-menu [send-region] + '("Send Region" . lua-send-region)) +(define-key lua-mode-menu [send-proc] + '("Send Proc" . lua-send-proc)) +(define-key lua-mode-menu [send-buffer] + '("Send Buffer" . lua-send-buffer)) +(define-key lua-mode-menu [search-documentation] + '("Search Documentation" . lua-search-documentation)) + + +(provide 'lua-mode) + +;;; lua-mode.el ends here From 0b1b96778171e5753ce8906caae3611e554d00d4 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 09:22:12 -0500 Subject: [PATCH 069/158] Remove obsolete code from 'lua-mode' * lisp/progmodes/lua-mode.el: Remove Emacs<27 compatibility code. (lua-emacs-menu): Remove XEmacs compatibility code. --- lisp/progmodes/lua-mode.el | 204 ++++++++----------------------------- 1 file changed, 41 insertions(+), 163 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 6c524f57d93..f74ebd823bb 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -111,143 +111,52 @@ (require 'compile)) (eval-and-compile - (if (fboundp #'rx-let) - (progn - ;; Emacs 27+ way of customizing rx - (defvar lua--rx-bindings) + (defvar lua--rx-bindings) - (setq - lua--rx-bindings - '((symbol (&rest x) (seq symbol-start (or x) symbol-end)) - (ws (* (any " \t"))) - (ws+ (+ (any " \t"))) + (setq + lua--rx-bindings + '((symbol (&rest x) (seq symbol-start (or x) symbol-end)) + (ws (* (any " \t"))) + (ws+ (+ (any " \t"))) - (lua-name (symbol (seq (+ (any alpha "_")) (* (any alnum "_"))))) - (lua-funcname (seq lua-name (* ws "." ws lua-name) - (opt ws ":" ws lua-name))) - (lua-funcheader - ;; Outer (seq ...) is here to shy-group the definition - (seq (or (seq (symbol "function") ws (group-n 1 lua-funcname)) - (seq (group-n 1 lua-funcname) ws "=" ws - (symbol "function"))))) - (lua-number - (seq (or (seq (+ digit) (opt ".") (* digit)) - (seq (* digit) (opt ".") (+ digit))) - (opt (regexp "[eE][+-]?[0-9]+")))) - (lua-assignment-op (seq "=" (or buffer-end (not (any "="))))) - (lua-operator (or "+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">=" "<" - ">" "=" ";" ":" "," "." ".." "...")) - (lua-keyword-operator (symbol "and" "not" "or")) - (lua-keyword - (symbol "break" "do" "else" "elseif" "end" "for" "function" - "goto" "if" "in" "local" "repeat" "return" - "then" "until" "while")) - (lua-up-to-9-variables - (seq (group-n 1 lua-name) ws - (? "," ws (group-n 2 lua-name) ws - (? "," ws (group-n 3 lua-name) ws - (? "," ws (group-n 4 lua-name) ws - (? "," ws (group-n 5 lua-name) ws - (? "," ws (group-n 6 lua-name) ws - (? "," ws (group-n 7 lua-name) ws - (? "," ws (group-n 8 lua-name) ws - (? "," ws (group-n 9 lua-name) ws)))))))))))) - - (defmacro lua-rx (&rest regexps) - (eval `(rx-let ,lua--rx-bindings - (rx ,@regexps)))) - - (defun lua-rx-to-string (form &optional no-group) - (rx-let-eval lua--rx-bindings - (rx-to-string form no-group)))) - (progn - ;; Pre-Emacs 27 way of customizing rx - (defvar lua-rx-constituents) - (defvar rx-parent) - - (defun lua-rx-to-string (form &optional no-group) - "Lua-specific replacement for `rx-to-string'. - -See `rx-to-string' documentation for more information FORM and -NO-GROUP arguments." - (let ((rx-constituents lua-rx-constituents)) - (rx-to-string form no-group))) - - (defmacro lua-rx (&rest regexps) - "Lua-specific replacement for `rx'. - -See `rx' documentation for more information about REGEXPS param." - (cond ((null regexps) - (error "No regexp")) - ((cdr regexps) - (lua-rx-to-string `(and ,@regexps) t)) - (t - (lua-rx-to-string (car regexps) t)))) - - (defun lua--new-rx-form (form) - "Add FORM definition to `lua-rx' macro. - -FORM is a cons (NAME . DEFN), see more in `rx-constituents' doc. -This function enables specifying new definitions using old ones: -if DEFN is a list that starts with `:rx' symbol its second -element is itself expanded with `lua-rx-to-string'. " - (let ((form-definition (cdr form))) - (when (and (listp form-definition) (eq ':rx (car form-definition))) - (setcdr form (lua-rx-to-string (cadr form-definition) 'nogroup))) - (push form lua-rx-constituents))) - - (defun lua--rx-symbol (form) - ;; form is a list (symbol XXX ...) - ;; Skip initial 'symbol - (setq form (cdr form)) - ;; If there's only one element, take it from the list, otherwise wrap the - ;; whole list into `(or XXX ...)' form. - (setq form (if (eq 1 (length form)) - (car form) - (append '(or) form))) - (and (fboundp 'rx-form) ; Silence Emacs 27's byte-compiler. - (rx-form `(seq symbol-start ,form symbol-end) rx-parent))) - - (setq lua-rx-constituents (copy-sequence rx-constituents)) - - (mapc 'lua--new-rx-form - `((symbol lua--rx-symbol 1 nil) - (ws . "[ \t]*") (ws+ . "[ \t]+") - (lua-name :rx (symbol (regexp "[[:alpha:]_]+[[:alnum:]_]*"))) - (lua-funcname - :rx (seq lua-name (* ws "." ws lua-name) + (lua-name (symbol (seq (+ (any alpha "_")) (* (any alnum "_"))))) + (lua-funcname (seq lua-name (* ws "." ws lua-name) (opt ws ":" ws lua-name))) - (lua-funcheader - ;; Outer (seq ...) is here to shy-group the definition - :rx (seq (or (seq (symbol "function") ws (group-n 1 lua-funcname)) - (seq (group-n 1 lua-funcname) ws "=" ws - (symbol "function"))))) - (lua-number - :rx (seq (or (seq (+ digit) (opt ".") (* digit)) - (seq (* digit) (opt ".") (+ digit))) - (opt (regexp "[eE][+-]?[0-9]+")))) - (lua-assignment-op - :rx (seq "=" (or buffer-end (not (any "="))))) - (lua-operator - :rx (or "+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">=" "<" + (lua-funcheader + ;; Outer (seq ...) is here to shy-group the definition + (seq (or (seq (symbol "function") ws (group-n 1 lua-funcname)) + (seq (group-n 1 lua-funcname) ws "=" ws + (symbol "function"))))) + (lua-number + (seq (or (seq (+ digit) (opt ".") (* digit)) + (seq (* digit) (opt ".") (+ digit))) + (opt (regexp "[eE][+-]?[0-9]+")))) + (lua-assignment-op (seq "=" (or buffer-end (not (any "="))))) + (lua-operator (or "+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">=" "<" ">" "=" ";" ":" "," "." ".." "...")) - (lua-keyword-operator - :rx (symbol "and" "not" "or")) - (lua-keyword - :rx (symbol "break" "do" "else" "elseif" "end" "for" "function" - "goto" "if" "in" "local" "repeat" "return" - "then" "until" "while")) - (lua-up-to-9-variables - :rx (seq (group-n 1 lua-name) ws - (? "," ws (group-n 2 lua-name) ws - (? "," ws (group-n 3 lua-name) ws - (? "," ws (group-n 4 lua-name) ws - (? "," ws (group-n 5 lua-name) ws - (? "," ws (group-n 6 lua-name) ws - (? "," ws (group-n 7 lua-name) ws - (? "," ws (group-n 8 lua-name) ws - (? "," ws (group-n 9 lua-name) ws))))))))))))))) + (lua-keyword-operator (symbol "and" "not" "or")) + (lua-keyword + (symbol "break" "do" "else" "elseif" "end" "for" "function" + "goto" "if" "in" "local" "repeat" "return" + "then" "until" "while")) + (lua-up-to-9-variables + (seq (group-n 1 lua-name) ws + (? "," ws (group-n 2 lua-name) ws + (? "," ws (group-n 3 lua-name) ws + (? "," ws (group-n 4 lua-name) ws + (? "," ws (group-n 5 lua-name) ws + (? "," ws (group-n 6 lua-name) ws + (? "," ws (group-n 7 lua-name) ws + (? "," ws (group-n 8 lua-name) ws + (? "," ws (group-n 9 lua-name) ws)))))))))))) + (defmacro lua-rx (&rest regexps) + (eval `(rx-let ,lua--rx-bindings + (rx ,@regexps)))) + + (defun lua-rx-to-string (form &optional no-group) + (rx-let-eval lua--rx-bindings + (rx-to-string form no-group)))) ;; Local variables (defgroup lua nil @@ -468,23 +377,6 @@ traceback location." (defvar lua-region-end (make-marker) "End of special region for Lua communication.") -(defvar lua-emacs-menu - '(["Restart With Whole File" lua-restart-with-whole-file t] - ["Kill Process" lua-kill-process t] - ["Hide Process Buffer" lua-hide-process-buffer t] - ["Show Process Buffer" lua-show-process-buffer t] - ["Beginning Of Proc" lua-beginning-of-proc t] - ["End Of Proc" lua-end-of-proc t] - ["Set Lua-Region Start" lua-set-lua-region-start t] - ["Set Lua-Region End" lua-set-lua-region-end t] - ["Send Lua-Region" lua-send-lua-region t] - ["Send Current Line" lua-send-current-line t] - ["Send Region" lua-send-region t] - ["Send Proc" lua-send-proc t] - ["Send Buffer" lua-send-buffer t] - ["Search Documentation" lua-search-documentation t]) - "Emacs menu for Lua mode.") - ;; the whole defconst is inside eval-when-compile, because it's later referenced ;; inside another eval-and-compile block (eval-and-compile @@ -715,20 +607,6 @@ index of respective Lua reference manuals.") (append electric-indent-chars lua--electric-indent-chars))) (add-hook 'flymake-diagnostic-functions #'lua-flymake nil t) - ;; setup menu bar entry (XEmacs style) - (if (and (featurep 'menubar) - (boundp 'current-menubar) - (fboundp 'set-buffer-menubar) - (fboundp 'add-menu) - (not (assoc "Lua" current-menubar))) - (progn - (set-buffer-menubar (copy-sequence current-menubar)) - (add-menu nil "Lua" lua-emacs-menu))) - ;; Append Lua menu to popup menu for Emacs. - (if (boundp 'mode-popup-menu) - (setq mode-popup-menu - (cons (concat mode-name " Mode Commands") lua-emacs-menu))) - ;; hideshow setup (unless (assq 'lua-mode hs-special-modes-alist) (add-to-list 'hs-special-modes-alist From 3fa5aa47bef85fef2a10c756bbad129863ca4990 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 09:31:04 -0500 Subject: [PATCH 070/158] Use easy-menu in 'lua-mode' * lisp/progmodes/lua-mode.el (lua-mode-menu): Delete. (lua-mode-map): Use 'easy-menu-define'. --- lisp/progmodes/lua-mode.el | 54 ++++++++++++-------------------------- 1 file changed, 17 insertions(+), 37 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index f74ebd823bb..dd1243a93b0 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -243,9 +243,6 @@ Should be a list of strings." (let ((val (eval sym))) (if val (single-key-description (eval sym)) "")))) -(defvar lua-mode-menu (make-sparse-keymap "Lua") - "Keymap for lua-mode's menu.") - (defvar lua-prefix-mode-map (eval-when-compile (let ((result-map (make-sparse-keymap))) @@ -271,7 +268,6 @@ If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") (char-to-string electric-char)) #'lua-electric-match)) lua--electric-indent-chars)) - (define-key result-map [menu-bar lua-mode] (cons "Lua" lua-mode-menu)) (define-key result-map [remap backward-up-list] 'lua-backward-up-list) ;; handle prefix-keyed bindings: @@ -2130,39 +2126,23 @@ member of `flymake-diagnostic-functions'." ;; menu bar -(define-key lua-mode-menu [restart-with-whole-file] - '("Restart With Whole File" . lua-restart-with-whole-file)) -(define-key lua-mode-menu [kill-process] - '("Kill Process" . lua-kill-process)) - -(define-key lua-mode-menu [hide-process-buffer] - '("Hide Process Buffer" . lua-hide-process-buffer)) -(define-key lua-mode-menu [show-process-buffer] - '("Show Process Buffer" . lua-show-process-buffer)) - -(define-key lua-mode-menu [end-of-proc] - '("End Of Proc" . lua-end-of-proc)) -(define-key lua-mode-menu [beginning-of-proc] - '("Beginning Of Proc" . lua-beginning-of-proc)) - -(define-key lua-mode-menu [send-lua-region] - '("Send Lua-Region" . lua-send-lua-region)) -(define-key lua-mode-menu [set-lua-region-end] - '("Set Lua-Region End" . lua-set-lua-region-end)) -(define-key lua-mode-menu [set-lua-region-start] - '("Set Lua-Region Start" . lua-set-lua-region-start)) - -(define-key lua-mode-menu [send-current-line] - '("Send Current Line" . lua-send-current-line)) -(define-key lua-mode-menu [send-region] - '("Send Region" . lua-send-region)) -(define-key lua-mode-menu [send-proc] - '("Send Proc" . lua-send-proc)) -(define-key lua-mode-menu [send-buffer] - '("Send Buffer" . lua-send-buffer)) -(define-key lua-mode-menu [search-documentation] - '("Search Documentation" . lua-search-documentation)) - +(easy-menu-define lua-mode-menu lua-mode-map + "Menu bar entry for `lua-mode'." + `("Lua" + ["Search Documentation" lua-search-documentation] + ["Send Buffer" lua-send-buffer] + ["Send Proc" lua-send-proc] + ["Send Region" lua-send-region] + ["Send Current Line" lua-send-current-line] + ["Set Lua-Region Start" lua-set-lua-region-start] + ["Set Lua-Region End" lua-set-lua-region-end] + ["Send Lua-Region" lua-send-lua-region] + ["Beginning Of Proc" lua-beginning-of-proc] + ["End Of Proc" lua-end-of-proc] + ["Show Process Buffer" lua-show-process-buffer] + ["Hide Process Buffer" lua-hide-process-buffer] + ["Kill Process" lua-kill-process] + ["Restart With Whole File" lua-restart-with-whole-file])) (provide 'lua-mode) From 509c1af9fceb7c1a31244265a1a6e2569452d9f8 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 09:34:40 -0500 Subject: [PATCH 071/158] Remove advice from 'lua-mode' * lisp/progmodes/lua-mode.el (lua--compilation-find-file) (compilation-find-file, lua--compilation-goto-locus) (compilation-goto-locus): Delete. --- lisp/progmodes/lua-mode.el | 29 ----------------------------- 1 file changed, 29 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index dd1243a93b0..59662f0cf71 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -302,35 +302,6 @@ If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") "Buffer-local flag saying if this is a Lua REPL buffer.") (make-variable-buffer-local 'lua--repl-buffer-p) -(defun lua--compilation-find-file (fn marker filename directory &rest formats) - "Return Lua REPL buffer when looking for \"stdin\" file in it." - (if (and - lua--repl-buffer-p - (string-equal filename "stdin") - ;; NOTE: this doesn't traverse `compilation-search-path' when - ;; looking for filename. - (not (file-exists-p (expand-file-name - filename - (when directory (expand-file-name directory)))))) - (current-buffer) - (apply fn marker filename directory formats))) - -(advice-add 'compilation-find-file :around #'lua--compilation-find-file) - -(defun lua--compilation-goto-locus (fn msg mk end-mk) - "When message points to Lua REPL buffer, go to the message itself. -Usually, stdin:XX line number points to nowhere." - (let ((errmsg-buf (marker-buffer msg)) - (error-buf (marker-buffer mk))) - (if (and (with-current-buffer errmsg-buf lua--repl-buffer-p) - (eq error-buf errmsg-buf)) - (progn - (compilation-set-window (display-buffer (marker-buffer msg)) msg) - (goto-char msg)) - (funcall fn msg mk end-mk)))) - -(advice-add 'compilation-goto-locus :around #'lua--compilation-goto-locus) - (defcustom lua-indent-string-contents nil "If non-nil, contents of multiline string will be indented. Otherwise leading amount of whitespace on each line is preserved." From b7d13f0de0473f5e6b681996bf96fc506fb13275 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 09:36:51 -0500 Subject: [PATCH 072/158] Remove unnecessary code from 'lua-mode' * lisp/progmodes/lua-mode.el (lua-traceback-line-re) (lua-start-process): compile.el has Lua support now. --- lisp/progmodes/lua-mode.el | 22 ++-------------------- 1 file changed, 2 insertions(+), 20 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 59662f0cf71..59521a3a714 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -96,7 +96,8 @@ ;;; Code: (eval-when-compile - (require 'cl-lib)) + (require 'cl-lib) + (require 'compile)) (require 'comint) (require 'newcomment) @@ -105,11 +106,6 @@ ;; rx-wrappers for Lua -(eval-when-compile - ;; Silence compilation warning about `compilation-error-regexp-alist' defined - ;; in compile.el. - (require 'compile)) - (eval-and-compile (defvar lua--rx-bindings) @@ -290,14 +286,6 @@ If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") :type 'regexp :group 'lua) -(defcustom lua-traceback-line-re - ;; This regexp skips prompt and meaningless "stdin:N:" prefix when looking - ;; for actual file-line locations. - "^\\(?:[\t ]*\\|.*>[\t ]+\\)\\(?:[^\n\t ]+:[0-9]+:[\t ]*\\)*\\(?:\\([^\n\t ]+\\):\\([0-9]+\\):\\)" - "Regular expression that describes tracebacks and errors." - :type 'regexp - :group 'lua) - (defvar lua--repl-buffer-p nil "Buffer-local flag saying if this is a Lua REPL buffer.") (make-variable-buffer-local 'lua--repl-buffer-p) @@ -1836,13 +1824,7 @@ When called interactively, switch to the process buffer." (setq lua-process (get-buffer-process lua-process-buffer)) (set-process-query-on-exit-flag lua-process nil) (with-current-buffer lua-process-buffer - ;; enable error highlighting in stack traces - (require 'compile) (setq lua--repl-buffer-p t) - (make-local-variable 'compilation-error-regexp-alist) - (setq compilation-error-regexp-alist - (cons (list lua-traceback-line-re 1 2) - compilation-error-regexp-alist)) (compilation-shell-minor-mode 1) (setq-local comint-prompt-regexp lua-prompt-regexp) From 6465b3cbec50d5ab6e4c2822073f0826bc46d5f7 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 09:51:58 -0500 Subject: [PATCH 073/158] Cleanup defcustoms in 'lua-mode' * lisp/progmodes/lua-mode.el (lua-mode-hook): Add options. (lua-indent-level, lua-comment-start, lua-comment-start-skip) (lua-default-application, lua-default-command-switches) (lua-always-show, lua-documentation-function) (lua-documentation-url, lua-prefix-key, lua-prompt-regexp) (lua-indent-string-contents) (lua-indent-nested-block-content-align) (lua-indent-close-paren-align, lua-jump-on-traceback) (lua-mode-hook, lua-mode, lua-luacheck-program): Delete group, add version. --- lisp/progmodes/lua-mode.el | 41 ++++++++++++++++++++------------------ 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 59521a3a714..c3dbc9560e6 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -163,18 +163,18 @@ (defcustom lua-indent-level 3 "Amount by which Lua subexpressions are indented." :type 'integer - :group 'lua - :safe #'integerp) + :safe #'integerp + :version "31.1") (defcustom lua-comment-start "-- " "Default value of `comment-start'." :type 'string - :group 'lua) + :version "31.1") (defcustom lua-comment-start-skip "---*[ \t]*" "Default value of `comment-start-skip'." :type 'string - :group 'lua) + :version "31.1") (defcustom lua-default-application "lua" "Default application to run in Lua process. @@ -184,7 +184,7 @@ start Lua process, or a (HOST . PORT) cons, that can be used to connect to Lua process running remotely." :type '(choice (string) (cons string integer)) - :group 'lua) + :version "31.1") (defcustom lua-default-command-switches (list "-i") "Command switches for `lua-default-application'. @@ -204,7 +204,7 @@ Should be a list of strings." ,@(when (fboundp 'eww) '((function-item eww))) ,@(when (fboundp 'w3m-browse-url) '((function-item w3m-browse-url))) (function :tag "Other function")) - :group 'lua) + :version "31.1") (defcustom lua-documentation-url (or (and (file-readable-p "/usr/share/doc/lua/manual.html") @@ -233,11 +233,11 @@ Should be a list of strings." (defcustom lua-prefix-key "\C-c" "Prefix for all lua-mode commands." :type 'string - :group 'lua :set 'lua--customize-set-prefix-key :get (lambda (sym) (let ((val (eval sym))) - (if val (single-key-description (eval sym)) "")))) + (if val (single-key-description (eval sym)) ""))) + :version "31.1") (defvar lua-prefix-mode-map (eval-when-compile @@ -284,7 +284,7 @@ If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") (defcustom lua-prompt-regexp "[^\n]*\\(>[\t ]+\\)+$" "Regexp which matches the Lua program's prompt." :type 'regexp - :group 'lua) + :version "31.1") (defvar lua--repl-buffer-p nil "Buffer-local flag saying if this is a Lua REPL buffer.") @@ -293,25 +293,25 @@ If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") (defcustom lua-indent-string-contents nil "If non-nil, contents of multiline string will be indented. Otherwise leading amount of whitespace on each line is preserved." - :group 'lua :type 'boolean - :safe #'booleanp) + :safe #'booleanp + :version "31.1") (defcustom lua-indent-nested-block-content-align t "If non-nil, the contents of nested blocks are indented to align with the column of the opening parenthesis, rather than just forward by `lua-indent-level'." - :group 'lua :type 'boolean - :safe #'booleanp) + :safe #'booleanp + :version "31.1") (defcustom lua-indent-close-paren-align t "If non-nil, close parenthesis are aligned with their open parenthesis. If nil, close parenthesis are aligned to the beginning of the line." - :group 'lua :type 'boolean - :safe #'booleanp) + :safe #'booleanp + :version "31.1") (defcustom lua-jump-on-traceback t "*Jump to innermost traceback location in *lua* buffer. When this @@ -319,12 +319,16 @@ variable is non-nil and a traceback occurs when running Lua code in a process, jump immediately to the source code of the innermost traceback location." :type 'boolean - :group 'lua) + :version "31.1") (defcustom lua-mode-hook nil "Hooks called when Lua mode fires up." :type 'hook - :group 'lua) + :options '(eglot-ensure + flymake-mode + hs-minor-mode + outline-minor-mode) + :version "31.1") (defvar lua-region-start (make-marker) "Start of special region for Lua communication.") @@ -533,7 +537,6 @@ index of respective Lua reference manuals.") "Major mode for editing Lua code." :abbrev-table lua-mode-abbrev-table :syntax-table lua-mode-syntax-table - :group 'lua (setq-local font-lock-defaults '(lua-font-lock-keywords ;; keywords nil ;; keywords-only nil ;; case-fold @@ -2029,7 +2032,7 @@ left out." (defcustom lua-luacheck-program "luacheck" "Name of the luacheck executable." :type 'string - :group 'lua) + :version "31.1") (defvar-local lua--flymake-process nil) From 2fe72d48d35c421c8d1bf237a25c393e7fd80134 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 14:20:24 -0500 Subject: [PATCH 074/158] Cleanup whitespace in 'lua-mode' --- lisp/progmodes/lua-mode.el | 29 ----------------------------- 1 file changed, 29 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index c3dbc9560e6..56a2cb1fa6c 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -93,7 +93,6 @@ ;; See "M-x apropos-command ^lua-" for a list of commands. ;; See "M-x customize-group lua" for a list of customizable variables. - ;;; Code: (eval-when-compile (require 'cl-lib) @@ -103,7 +102,6 @@ (require 'newcomment) (require 'rx) - ;; rx-wrappers for Lua (eval-and-compile @@ -254,7 +252,6 @@ If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") (defvar lua--electric-indent-chars (mapcar #'string-to-char '("}" "]" ")"))) - (defvar lua-mode-map (let ((result-map (make-sparse-keymap))) (unless (boundp 'electric-indent-chars) @@ -409,7 +406,6 @@ traceback location." This is a compilation of 5.1, 5.2 and 5.3 builtins taken from the index of respective Lua reference manuals.") - (defvar lua-font-lock-keywords `(;; highlight the hash-bang line "#!/foo/bar/lua" as comment ("^#!.*$" . font-lock-comment-face) @@ -573,8 +569,6 @@ index of respective Lua reference manuals.") ,(regexp-opt (mapcar 'cdr lua-sexp-alist) 'words) ;end nil lua-forward-sexp)))) - - ;;;###autoload (add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-mode)) @@ -614,7 +608,6 @@ index of respective Lua reference manuals.") (let ((fill-paragraph-handle-comment t)) (fill-paragraph justify region)))) - (defun lua-prefix-key-update-bindings () (let (old-cons) (if (eq lua-prefix-mode-map (keymap-parent lua-mode-map)) @@ -684,7 +677,6 @@ If point is not inside string or comment, return nil." (defconst lua-ml-begin-regexp "\\(?:\\(?1:-\\)-\\[\\|\\(?2:\\[\\)\\)\\(?3:=*\\)\\[") - (defun lua-try-match-multiline-end (end) "Try to match close-bracket for multiline literal around point. @@ -706,7 +698,6 @@ information provided at point and re-search-forward to it." (if (match-beginning 1) 1 2)) end 'noerror)))) - (defun lua-try-match-multiline-begin (limit) "Try to match multiline open-brackets. @@ -751,7 +742,6 @@ Intended to be used as a `syntax-propertize-function'." (put-text-property (match-beginning 2) (match-end 2) 'syntax-table (string-to-syntax "|")))))) - (defun lua-indent-line () "Indent current line for Lua mode. Return the amount the indentation changed by." @@ -794,7 +784,6 @@ Return the amount the indentation changed by." 0 lua-indent-level)))))) - (defun lua--signum (x) "Return 1 if X is positive, -1 if negative, 0 if zero." ;; XXX: backport from cl-extras for Emacs24 @@ -813,7 +802,6 @@ If point is beyond limit, move it onto limit." (goto-char limit) nil)) - (defun lua--escape-from-string (&optional backward) "Move point outside of string if it is inside one. @@ -827,7 +815,6 @@ placed before the string." (parse-partial-sexp (point) (line-end-position) nil nil (syntax-ppss) 'syntax-table)) t))) - (defun lua-find-regexp (direction regexp &optional limit) "Searches for a regular expression in the direction specified. @@ -858,7 +845,6 @@ found, returns point position, nil otherwise." (forward-comment 1))))) finally return (point)))) - (defconst lua-block-regexp (eval-when-compile (concat @@ -1081,7 +1067,6 @@ Return non-nil if moved point." (when (/= start-pos (point)) (point))))) - (defun lua-forward-line-skip-blanks (&optional back) "Move 1 line forward/backward and skip all insignificant ws/comment lines. @@ -1177,7 +1162,6 @@ previous one even though it looked like an end-of-statement.") (setq return-value nil))) return-value))) - (defun lua-first-token-continues-p () "Return non-nil if the first token on this line is a continuation token." (let ((line-end (line-end-position))) @@ -1192,14 +1176,12 @@ previous one even though it looked like an end-of-statement.") (or (match-beginning 1) (match-beginning 2)))))) - (defun lua--backward-up-list-noerror () "Safe version of lua-backward-up-list that does not signal an error." (condition-case nil (lua-backward-up-list) (scan-error nil))) - (defun lua-backward-up-list () "Goto starter/opener of the block that contains point." (interactive) @@ -1241,7 +1223,6 @@ previous one even though it looked like an end-of-statement.") "for" "local") lua-funcheader))))) - (defun lua-is-continuing-statement-p-1 () "Return non-nil if current lined continues a statement. @@ -1276,7 +1257,6 @@ The criteria for a continuing statement are: (equal parent-block-opener "{"))))) continuation-pos)))))) - (defun lua-is-continuing-statement-p (&optional parse-start) "Returns non-nil if the line at PARSE-START should be indented as continuation line. @@ -1465,7 +1445,6 @@ Return list of indentation modifiers from point to BOUND." indentation-info)))) indentation-info) - (defun lua-calculate-indentation-info (&optional parse-end) "For each block token on the line, computes how it affects the indentation. The effect of each token can be either a shift relative to the current @@ -1507,7 +1486,6 @@ and relative each, and the shift/column to indent to." indentation-info)) - (defun lua-accumulate-indentation-info (reversed-indentation-info) "Accumulates the indentation information previously calculated by lua-calculate-indentation-info. Returns either the relative indentation @@ -1552,7 +1530,6 @@ one." (- (cdr indentation-info) (current-indentation)) (cdr indentation-info)))) - (eval-when-compile (defconst lua--function-name-rx '(seq symbol-start @@ -1562,7 +1539,6 @@ one." symbol-end) "Lua function name regexp in `rx'-SEXP format.")) - (defconst lua--left-shifter-regexp (eval-when-compile (rx @@ -1608,7 +1584,6 @@ The following left-shifter expressions are currently handled: - function call arguments block, () or {} block - function expression a.k.a. lambda, begin-end block.") - (defun lua-point-is-after-left-shifter-p () "Check if point is right after a left-shifter expression. @@ -1644,7 +1619,6 @@ left-shifter expression. " (goto-char pos) return-val)))) - (defun lua-calculate-indentation-override (&optional parse-start) "Return overriding indentation amount for special cases. @@ -1692,7 +1666,6 @@ If not, return nil." (current-column) (current-indentation)))))) - (defun lua-calculate-indentation () "Return appropriate indentation for current line as Lua code." (save-excursion @@ -1717,7 +1690,6 @@ If not, return nil." (lua-rx-to-string '(: bol (? (symbol "local") ws+) lua-funcheader)) "Lua top level (matches only at the beginning of line) function header regex.") - (defun lua-beginning-of-proc (&optional arg) "Move backward to the beginning of a Lua proc (or similar). @@ -1965,7 +1937,6 @@ Create a Lua process if one doesn't already exist." (interactive) (display-buffer (process-buffer (lua-get-create-process)))) - (defun lua-hide-process-buffer () "Delete all windows that display `lua-process-buffer'." (interactive) From fd6d5b65b523c1a2ce1162e2b48ebd9c2f4268a7 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 14:23:52 -0500 Subject: [PATCH 075/158] Remove unnecessary 'setq' from 'lua-mode' * lisp/progmodes/lua-mode.el (lua--rx-bindings): Combine variable definition and assignment. --- lisp/progmodes/lua-mode.el | 71 ++++++++++++++++++-------------------- 1 file changed, 34 insertions(+), 37 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 56a2cb1fa6c..0e759e97707 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -105,44 +105,41 @@ ;; rx-wrappers for Lua (eval-and-compile - (defvar lua--rx-bindings) + (defvar lua--rx-bindings + '((symbol (&rest x) (seq symbol-start (or x) symbol-end)) + (ws (* (any " \t"))) + (ws+ (+ (any " \t"))) - (setq - lua--rx-bindings - '((symbol (&rest x) (seq symbol-start (or x) symbol-end)) - (ws (* (any " \t"))) - (ws+ (+ (any " \t"))) - - (lua-name (symbol (seq (+ (any alpha "_")) (* (any alnum "_"))))) - (lua-funcname (seq lua-name (* ws "." ws lua-name) - (opt ws ":" ws lua-name))) - (lua-funcheader - ;; Outer (seq ...) is here to shy-group the definition - (seq (or (seq (symbol "function") ws (group-n 1 lua-funcname)) - (seq (group-n 1 lua-funcname) ws "=" ws - (symbol "function"))))) - (lua-number - (seq (or (seq (+ digit) (opt ".") (* digit)) - (seq (* digit) (opt ".") (+ digit))) - (opt (regexp "[eE][+-]?[0-9]+")))) - (lua-assignment-op (seq "=" (or buffer-end (not (any "="))))) - (lua-operator (or "+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">=" "<" - ">" "=" ";" ":" "," "." ".." "...")) - (lua-keyword-operator (symbol "and" "not" "or")) - (lua-keyword - (symbol "break" "do" "else" "elseif" "end" "for" "function" - "goto" "if" "in" "local" "repeat" "return" - "then" "until" "while")) - (lua-up-to-9-variables - (seq (group-n 1 lua-name) ws - (? "," ws (group-n 2 lua-name) ws - (? "," ws (group-n 3 lua-name) ws - (? "," ws (group-n 4 lua-name) ws - (? "," ws (group-n 5 lua-name) ws - (? "," ws (group-n 6 lua-name) ws - (? "," ws (group-n 7 lua-name) ws - (? "," ws (group-n 8 lua-name) ws - (? "," ws (group-n 9 lua-name) ws)))))))))))) + (lua-name (symbol (seq (+ (any alpha "_")) (* (any alnum "_"))))) + (lua-funcname (seq lua-name (* ws "." ws lua-name) + (opt ws ":" ws lua-name))) + (lua-funcheader + ;; Outer (seq ...) is here to shy-group the definition + (seq (or (seq (symbol "function") ws (group-n 1 lua-funcname)) + (seq (group-n 1 lua-funcname) ws "=" ws + (symbol "function"))))) + (lua-number + (seq (or (seq (+ digit) (opt ".") (* digit)) + (seq (* digit) (opt ".") (+ digit))) + (opt (regexp "[eE][+-]?[0-9]+")))) + (lua-assignment-op (seq "=" (or buffer-end (not (any "="))))) + (lua-operator (or "+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">=" "<" + ">" "=" ";" ":" "," "." ".." "...")) + (lua-keyword-operator (symbol "and" "not" "or")) + (lua-keyword + (symbol "break" "do" "else" "elseif" "end" "for" "function" + "goto" "if" "in" "local" "repeat" "return" + "then" "until" "while")) + (lua-up-to-9-variables + (seq (group-n 1 lua-name) ws + (? "," ws (group-n 2 lua-name) ws + (? "," ws (group-n 3 lua-name) ws + (? "," ws (group-n 4 lua-name) ws + (? "," ws (group-n 5 lua-name) ws + (? "," ws (group-n 6 lua-name) ws + (? "," ws (group-n 7 lua-name) ws + (? "," ws (group-n 8 lua-name) ws + (? "," ws (group-n 9 lua-name) ws)))))))))))) (defmacro lua-rx (&rest regexps) (eval `(rx-let ,lua--rx-bindings From ee36cac7bab0e14011ecbc781ec04f08f0609ee1 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 14:29:16 -0500 Subject: [PATCH 076/158] Prefer 'defvar-local' in 'lua-mode' * lisp/progmodes/lua-mode.el (lua-default-command-switches) (lua-electric-flag, lua--repl-buffer-p): Replace 'make-variable-buffer-local' with 'defvar-local'. --- lisp/progmodes/lua-mode.el | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 0e759e97707..224fc4aa728 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -185,8 +185,7 @@ connect to Lua process running remotely." "Command switches for `lua-default-application'. Should be a list of strings." :type '(repeat string) - :group 'lua) -(make-variable-buffer-local 'lua-default-command-switches) + :version "31.1") (defcustom lua-always-show t "*Non-nil means display lua-process-buffer after sending a command." @@ -270,19 +269,17 @@ If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") result-map) "Keymap used in lua-mode buffers.") -(defvar lua-electric-flag t +(defvar-local lua-electric-flag t "If t, electric actions (like automatic reindentation) will happen when an electric key like `{' is pressed") -(make-variable-buffer-local 'lua-electric-flag) (defcustom lua-prompt-regexp "[^\n]*\\(>[\t ]+\\)+$" "Regexp which matches the Lua program's prompt." :type 'regexp :version "31.1") -(defvar lua--repl-buffer-p nil +(defvar-local lua--repl-buffer-p nil "Buffer-local flag saying if this is a Lua REPL buffer.") -(make-variable-buffer-local 'lua--repl-buffer-p) (defcustom lua-indent-string-contents nil "If non-nil, contents of multiline string will be indented. From 142f1b2a9bd2f3ef713d5da13c4166605f18c084 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 14:43:38 -0500 Subject: [PATCH 077/158] Replace 1-armed 'if' with 'when' in 'lua-mode' * lisp/progmodes/lua-mode.el (lua--customize-set-prefix-key) (lua-electric-match, lua-prefix-key-update-bindings) (lua-indent-line, lua-find-matching-token-word) (lua-goto-matching-block-token, lua-last-token-continues-p) (lua-is-continuing-statement-p) (lua--goto-line-beginning-rightmost-closer, lua-start-process) (lua-prompt-line): Replace. --- lisp/progmodes/lua-mode.el | 126 ++++++++++++++++++------------------- 1 file changed, 63 insertions(+), 63 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 224fc4aa728..d2d9dba7731 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -217,12 +217,12 @@ Should be a list of strings." (defun lua--customize-set-prefix-key (prefix-key-sym prefix-key-val) (cl-assert (eq prefix-key-sym 'lua-prefix-key)) - (set prefix-key-sym (if (and prefix-key-val (> (length prefix-key-val) 0)) - ;; read-kbd-macro returns a string or a vector - ;; in both cases (elt x 0) is ok - (elt (read-kbd-macro prefix-key-val) 0))) - (if (fboundp 'lua-prefix-key-update-bindings) - (lua-prefix-key-update-bindings))) + (set prefix-key-sym (when (and prefix-key-val (> (length prefix-key-val) 0)) + ;; read-kbd-macro returns a string or a vector + ;; in both cases (elt x 0) is ok + (elt (read-kbd-macro prefix-key-val) 0))) + (when (fboundp 'lua-prefix-key-update-bindings) + (lua-prefix-key-update-bindings))) (defcustom lua-prefix-key "\C-c" "Prefix for all lua-mode commands." @@ -574,8 +574,8 @@ index of respective Lua reference manuals.") (interactive "P") (let (blink-paren-function) (self-insert-command (prefix-numeric-value arg))) - (if lua-electric-flag - (lua-indent-line)) + (when lua-electric-flag + (lua-indent-line)) (blink-matching-open)) ;; private functions @@ -608,8 +608,8 @@ index of respective Lua reference manuals.") ;; if prefix-map is a parent, delete the parent (set-keymap-parent lua-mode-map nil) ;; otherwise, look for it among children - (if (setq old-cons (rassoc lua-prefix-mode-map lua-mode-map)) - (delq old-cons lua-mode-map))) + (when (setq old-cons (rassoc lua-prefix-mode-map lua-mode-map)) + (delq old-cons lua-mode-map))) (if (null lua-prefix-key) (set-keymap-parent lua-mode-map lua-prefix-mode-map) @@ -754,8 +754,8 @@ Return the amount the indentation changed by." ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. - (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos))) + (when (> (- (point-max) pos) (point)) ; 03e991 + (goto-char (- (point-max) pos))) ; 03e991 indent)) @@ -935,18 +935,18 @@ DIRECTION has to be either \\='forward or \\='backward." ;; if we are searching forward from the token at the current point ;; (i.e. for a closing token), need to step one character forward ;; first, or the regexp will match the opening token. - (if (eq search-direction 'forward) (forward-char 1)) - (catch 'found + (when (eq search-direction 'forward) (forward-char 1)) + (catch 'found ; 03e991 ;; If we are attempting to find a matching token for a terminating token ;; (i.e. a token that starts a statement when searching back, or a token ;; that ends a statement when searching forward), then we don't need to look ;; any further. - (if (or (and (eq search-direction 'forward) - (eq match-type 'close)) - (and (eq search-direction 'backward) - (eq match-type 'open))) - (throw 'found nil)) - (while (lua-find-regexp search-direction lua-indentation-modifier-regexp) + (when (or (and (eq search-direction 'forward) + (eq match-type 'close)) + (and (eq search-direction 'backward) + (eq match-type 'open))) + (throw 'found nil)) + (while (lua-find-regexp search-direction lua-indentation-modifier-regexp) ; 03e991 ;; have we found a valid matching token? (let ((found-token (match-string 0)) (found-pos (match-beginning 0))) @@ -958,18 +958,18 @@ DIRECTION has to be either \\='forward or \\='backward." ;; token; likewise, if we were looking for a block end token, ;; found-token must be a block begin token, otherwise there ;; is a grammatical error in the code. - (if (not (and - (or (eq match-type 'middle) - (eq found-type 'middle) - (eq match-type 'middle-or-open) - (eq found-type 'middle-or-open) - (eq match-type found-type)) - (goto-char found-pos) - (lua-find-matching-token-word found-token - search-direction))) - (when maybe-found-pos - (goto-char maybe-found-pos) - (throw 'found maybe-found-pos))) + (when (not (and ; 03e991 + (or (eq match-type 'middle) + (eq found-type 'middle) + (eq match-type 'middle-or-open) + (eq found-type 'middle-or-open) + (eq match-type found-type)) + (goto-char found-pos) + (lua-find-matching-token-word found-token + search-direction))) + (when maybe-found-pos + (goto-char maybe-found-pos) + (throw 'found maybe-found-pos))) ;; yes. ;; if it is a not a middle kind, report the location (when (not (or (eq found-type 'middle) @@ -995,13 +995,13 @@ the matching token if successful, nil otherwise. Optional PARSE-START is a position to which the point should be moved first. DIRECTION has to be \\='forward or \\='backward (\\='forward by default)." - (if parse-start (goto-char parse-start)) + (when parse-start (goto-char parse-start)) (let ((case-fold-search nil)) - (if (looking-at lua-indentation-modifier-regexp) - (let ((position (lua-find-matching-token-word (match-string 0) - direction))) - (and position - (goto-char position)))))) + (when (looking-at lua-indentation-modifier-regexp) ; 03e991 + (let ((position (lua-find-matching-token-word (match-string 0) ; 03e991 + direction))) + (and position ; 03e991 + (goto-char position)))))) ; 03e991 (defun lua-goto-matching-block (&optional noreport) "Go to the keyword balancing the one under the point. @@ -1135,25 +1135,25 @@ previous one even though it looked like an end-of-statement.") (setq return-value (and (re-search-backward lua-cont-eol-regexp line-begin t) (or (match-beginning 1) (match-beginning 2)))) - (if (and return-value - (string-equal (match-string-no-properties 0) "return")) - ;; "return" keyword is ambiguous and depends on next token - (unless (save-excursion - (goto-char (match-end 0)) - (forward-comment (point-max)) - (and - ;; Not continuing: at end of file - (not (eobp)) - (or - ;; "function" keyword: it is a continuation, e.g. - ;; - ;; return - ;; function() return 123 end - ;; - (looking-at (lua-rx (symbol "function"))) - ;; Looking at semicolon or any other keyword: not continuation - (not (looking-at (lua-rx (or ";" lua-keyword))))))) - (setq return-value nil))) + (when (and return-value + (string-equal (match-string-no-properties 0) "return")) + ;; "return" keyword is ambiguous and depends on next token + (unless (save-excursion + (goto-char (match-end 0)) + (forward-comment (point-max)) + (and + ;; Not continuing: at end of file + (not (eobp)) + (or + ;; "function" keyword: it is a continuation, e.g. + ;; + ;; return + ;; function() return 123 end + ;; + (looking-at (lua-rx (symbol "function"))) + ;; Looking at semicolon or any other keyword: not continuation + (not (looking-at (lua-rx (or ";" lua-keyword))))))) + (setq return-value nil))) return-value))) (defun lua-first-token-continues-p () @@ -1261,7 +1261,7 @@ This true is when the line : * starts with a 1+ block-closer tokens, an top-most block opener is on a continuation line " (save-excursion - (if parse-start (goto-char parse-start)) + (when parse-start (goto-char parse-start)) ; 03e991 ;; If line starts with a series of closer tokens, whether or not the line ;; is a continuation line is decided by the opener line, e.g. @@ -1594,7 +1594,7 @@ left-shifter expression. " (defun lua--goto-line-beginning-rightmost-closer (&optional parse-start) (let (case-fold-search pos line-end-pos return-val) (save-excursion - (if parse-start (goto-char parse-start)) + (when parse-start (goto-char parse-start)) (setq line-end-pos (line-end-position)) (back-to-indentation) (unless (lua-comment-or-string-p) @@ -1805,8 +1805,8 @@ When called interactively, switch to the process buffer." (lua-send-string lua-process-init-code))) ;; when called interactively, switch to process buffer - (if (called-interactively-p 'any) - (switch-to-buffer lua-process-buffer))) + (when (called-interactively-p 'any) + (switch-to-buffer lua-process-buffer))) (defun lua-get-create-process () "Return active Lua process creating one if necessary." @@ -1902,8 +1902,8 @@ Otherwise, return START." (save-excursion (save-match-data (forward-line 0) - (if (looking-at comint-prompt-regexp) - (match-end 0))))) + (when (looking-at comint-prompt-regexp) + (match-end 0))))) (defun lua-send-lua-region () "Send preset Lua region to Lua process." From bf9e502e706de5c6d8815254c857fe5cbd844d7f Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 14:51:58 -0500 Subject: [PATCH 078/158] Remove unnecessary 'progn' in 'lua-mode' * lisp/progmodes/lua-mode.el (lua-accumulate-indentation-info) (lua--goto-line-beginning-rightmost-closer): Delete. --- lisp/progmodes/lua-mode.el | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index d2d9dba7731..790b3feaac9 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -1496,11 +1496,11 @@ shift, or the absolute column to indent to." ;; Aggregate indentation info, taking 'absolute modifiers into account. (mapc (lambda (x) - (let ((new-val (cdr x))) - (if (eq 'absolute (car x)) - (progn (setq type 'absolute - accu new-val)) - (setq accu (+ accu new-val))))) + (if-let* ((new-val (cdr x)) + ((eq 'absolute (car x)))) + (setq type 'absolute + accu new-val) + (setq accu (+ accu new-val)))) indentation-info) (cons type accu))) @@ -1609,9 +1609,8 @@ left-shifter expression. " (goto-char (match-end 0)) (forward-comment (line-end-position)))))) (when pos - (progn - (goto-char pos) - return-val)))) + (goto-char pos) + return-val))) (defun lua-calculate-indentation-override (&optional parse-start) "Return overriding indentation amount for special cases. From 2e454bea03ed7186141e9e1d9b3eb4e888699149 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 15:48:05 -0500 Subject: [PATCH 079/158] ; Adjust code style in 'lua-mode' * lisp/progmodes/lua-mode.el (lua-prefix-key) (lua-goto-matching-block): Replace 'let...if' with 'if-let*'. (lua--fill-paragraph, lua-goto-matching-block-token): Replace 'let...when' with 'when-let*'. (lua-comment-start-pos): Replace 'unless..and' with 'if-let*'. (lua-skip-ws-and-comments-backward) (lua-skip-ws-and-comments-forward): Remove unnecessary 'setq'. (lua-indent-line): Replace 'when...not' with 'unless'. (lua-calculate-string-or-comment-indentation): Formatting. (lua-find-matching-token-word): Remove a level of 'let' nesting, replace 'when...not' with 'unless'. (lua-indent-line): Combine 'setq's. --- lisp/progmodes/lua-mode.el | 162 +++++++++++++++++-------------------- 1 file changed, 76 insertions(+), 86 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 790b3feaac9..dcb8a27da64 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -229,8 +229,7 @@ Should be a list of strings." :type 'string :set 'lua--customize-set-prefix-key :get (lambda (sym) - (let ((val (eval sym))) - (if val (single-key-description (eval sym)) ""))) + (if-let* ((val (eval sym))) (single-key-description val) "")) :version "31.1") (defvar lua-prefix-mode-map @@ -603,17 +602,15 @@ index of respective Lua reference manuals.") (fill-paragraph justify region)))) (defun lua-prefix-key-update-bindings () - (let (old-cons) - (if (eq lua-prefix-mode-map (keymap-parent lua-mode-map)) - ;; if prefix-map is a parent, delete the parent - (set-keymap-parent lua-mode-map nil) - ;; otherwise, look for it among children - (when (setq old-cons (rassoc lua-prefix-mode-map lua-mode-map)) - (delq old-cons lua-mode-map))) - - (if (null lua-prefix-key) - (set-keymap-parent lua-mode-map lua-prefix-mode-map) - (define-key lua-mode-map (vector lua-prefix-key) lua-prefix-mode-map)))) + (if (eq lua-prefix-mode-map (keymap-parent lua-mode-map)) + ;; if prefix-map is a parent, delete the parent + (set-keymap-parent lua-mode-map nil) + ;; otherwise, look for it among children + (when-let* ((old-cons (rassoc lua-prefix-mode-map lua-mode-map))) + (delq old-cons lua-mode-map))) + (if (null lua-prefix-key) + (set-keymap-parent lua-mode-map lua-prefix-mode-map) + (define-key lua-mode-map (vector lua-prefix-key) lua-prefix-mode-map))) (defun lua-set-prefix-key (new-key-str) "Changes `lua-prefix-key' properly and updates keymaps @@ -642,13 +639,11 @@ consider point as inside comment when it is between the two hyphens" "Return position of comment containing current point. If point is not inside a comment, return nil." - (unless parsing-state (setq parsing-state (syntax-ppss))) - (and - ;; Not a string - (not (nth 3 parsing-state)) - ;; Syntax-based comment - (or (and (nth 4 parsing-state) (nth 8 parsing-state)) - (lua--containing-double-hyphen-start-pos)))) + (if-let* ((parsing-state (or parsing-state (syntax-ppss))) + ((not (nth 3 parsing-state))) ; Not a string. + ((nth 4 parsing-state))) ; Syntax-based comment. + (nth 8 parsing-state) + (lua--containing-double-hyphen-start-pos))) (defun lua-comment-or-string-p (&optional pos) "Returns true if the point is in a comment or string." @@ -744,24 +739,26 @@ Return the amount the indentation changed by." ;; save point as a distance to eob - it's invariant w.r.t indentation (pos (- (point-max) (point)))) (back-to-indentation) - (if (lua-comment-or-string-p) - (setq indent (lua-calculate-string-or-comment-indentation)) ;; just restore point position - (setq indent (max 0 (lua-calculate-indentation)))) + (setq indent (if (lua-comment-or-string-p) + ;; Just restore point posistion. + (lua-calculate-string-or-comment-indentation) + (max 0 (lua-calculate-indentation)))) - (when (not (equal indent (current-column))) + (unless (equal indent (current-column)) (delete-region (line-beginning-position) (point)) (indent-to indent)) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. - (when (> (- (point-max) pos) (point)) ; 03e991 - (goto-char (- (point-max) pos))) ; 03e991 + (when (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) indent)) (defun lua-calculate-string-or-comment-indentation () "This function should be run when point at (current-indentation) is inside string" - (if (and (lua-string-p) (not lua-indent-string-contents)) + (if (and (lua-string-p) + (not lua-indent-string-contents)) ;; if inside string and strings aren't to be indented, return current indentation (current-indentation) @@ -936,7 +933,7 @@ DIRECTION has to be either \\='forward or \\='backward." ;; (i.e. for a closing token), need to step one character forward ;; first, or the regexp will match the opening token. (when (eq search-direction 'forward) (forward-char 1)) - (catch 'found ; 03e991 + (catch 'found ;; If we are attempting to find a matching token for a terminating token ;; (i.e. a token that starts a statement when searching back, or a token ;; that ends a statement when searching forward), then we don't need to look @@ -948,43 +945,42 @@ DIRECTION has to be either \\='forward or \\='backward." (throw 'found nil)) (while (lua-find-regexp search-direction lua-indentation-modifier-regexp) ; 03e991 ;; have we found a valid matching token? - (let ((found-token (match-string 0)) - (found-pos (match-beginning 0))) - (let ((found-type (lua-get-token-type - (lua-get-block-token-info found-token)))) - (if (not (and match (string-match match found-token))) - ;; no - then there is a nested block. If we were looking for - ;; a block begin token, found-token must be a block end - ;; token; likewise, if we were looking for a block end token, - ;; found-token must be a block begin token, otherwise there - ;; is a grammatical error in the code. - (when (not (and ; 03e991 - (or (eq match-type 'middle) - (eq found-type 'middle) - (eq match-type 'middle-or-open) - (eq found-type 'middle-or-open) - (eq match-type found-type)) - (goto-char found-pos) - (lua-find-matching-token-word found-token - search-direction))) - (when maybe-found-pos - (goto-char maybe-found-pos) - (throw 'found maybe-found-pos))) - ;; yes. - ;; if it is a not a middle kind, report the location - (when (not (or (eq found-type 'middle) - (eq found-type 'middle-or-open))) - (throw 'found found-pos)) - ;; if it is a middle-or-open type, record location, but keep searching. - ;; If we fail to complete the search, we'll report the location - (when (eq found-type 'middle-or-open) - (setq maybe-found-pos found-pos)) - ;; Cannot use tail recursion. too much nesting on long chains of - ;; if/elseif. Will reset variables instead. - (setq token found-token) - (setq token-info (lua-get-block-token-info token)) - (setq match (lua-get-token-match-re token-info search-direction)) - (setq match-type (lua-get-token-type token-info)))))) + (let* ((found-token (match-string 0)) + (found-pos (match-beginning 0)) + (found-type (lua-get-token-type + (lua-get-block-token-info found-token)))) + (if (not (and match (string-match match found-token))) + ;; no - then there is a nested block. If we were looking for + ;; a block begin token, found-token must be a block end + ;; token; likewise, if we were looking for a block end token, + ;; found-token must be a block begin token, otherwise there + ;; is a grammatical error in the code. + (unless (and (or (eq match-type 'middle) + (eq found-type 'middle) + (eq match-type 'middle-or-open) + (eq found-type 'middle-or-open) + (eq match-type found-type)) + (goto-char found-pos) + (lua-find-matching-token-word + found-token search-direction)) + (when maybe-found-pos + (goto-char maybe-found-pos) + (throw 'found maybe-found-pos))) + ;; yes. + ;; if it is a not a middle kind, report the location + (unless (or (eq found-type 'middle) + (eq found-type 'middle-or-open)) + (throw 'found found-pos)) + ;; if it is a middle-or-open type, record location, but keep searching. + ;; If we fail to complete the search, we'll report the location + (when (eq found-type 'middle-or-open) + (setq maybe-found-pos found-pos)) + ;; Cannot use tail recursion. too much nesting on long chains of + ;; if/elseif. Will reset variables instead. + (setq token found-token) + (setq token-info (lua-get-block-token-info token)) + (setq match (lua-get-token-match-re token-info search-direction)) + (setq match-type (lua-get-token-type token-info))))) maybe-found-pos))) (defun lua-goto-matching-block-token (&optional parse-start direction) @@ -997,11 +993,10 @@ Optional PARSE-START is a position to which the point should be moved first. DIRECTION has to be \\='forward or \\='backward (\\='forward by default)." (when parse-start (goto-char parse-start)) (let ((case-fold-search nil)) - (when (looking-at lua-indentation-modifier-regexp) ; 03e991 - (let ((position (lua-find-matching-token-word (match-string 0) ; 03e991 - direction))) - (and position ; 03e991 - (goto-char position)))))) ; 03e991 + (when-let* (((looking-at lua-indentation-modifier-regexp)) + (position (lua-find-matching-token-word + (match-string 0) direction))) + (goto-char position)))) (defun lua-goto-matching-block (&optional noreport) "Go to the keyword balancing the one under the point. @@ -1015,11 +1010,9 @@ is no block open/close open." (when (and (eq (char-syntax (following-char)) ?w) (not (looking-at "\\_<"))) (re-search-backward "\\_<" nil t)) - (let ((position (lua-goto-matching-block-token))) - (if (and (not position) - (not noreport)) - (error "Not on a block control keyword or brace") - position))) + (if-let* ((position (lua-goto-matching-block-token))) + position + (unless noreport (error "Not on a block control keyword or brace")))) (defun lua-skip-ws-and-comments-backward (&optional limit) "Move point back skipping all whitespace and comments. @@ -1030,14 +1023,12 @@ Return non-nil if moved point." (interactive) (unless (lua-string-p) (let ((start-pos (point)) - (comment-start-pos (lua-comment-start-pos))) - (setq limit (min (point) (or limit (point-min)))) - (when comment-start-pos - (goto-char (max limit comment-start-pos))) + (comment-start-pos (lua-comment-start-pos)) + (limit (min (point) (or limit (point-min))))) + (when comment-start-pos (goto-char (max limit comment-start-pos))) (when (< limit (point)) (forward-comment (- limit (point)))) (when (< (point) limit) (goto-char limit)) - (when (/= start-pos (point)) - (point))))) + (when (/= start-pos (point)) (point))))) (defun lua-skip-ws-and-comments-forward (&optional limit) "Move point forward skipping all whitespace and comments. @@ -1048,8 +1039,8 @@ Return non-nil if moved point." (interactive) (unless (lua-string-p) (let ((start-pos (point)) - (comment-start-pos (lua-comment-start-pos))) - (setq limit (max (point) (or limit (point-max)))) + (comment-start-pos (lua-comment-start-pos)) + (limit (max (point) (or limit (point-max))))) ;; Escape from current comment. It is necessary to use "while" because ;; luadoc parameters have non-comment face, and parse-partial-sexp with ;; 'syntax-table flag will stop on them. @@ -1058,8 +1049,7 @@ Return non-nil if moved point." (forward-comment 1)) (when (< (point) limit) (forward-comment (- limit (point)))) (when (< limit (point)) (goto-char limit)) - (when (/= start-pos (point)) - (point))))) + (when (/= start-pos (point)) (point))))) (defun lua-forward-line-skip-blanks (&optional back) "Move 1 line forward/backward and skip all insignificant ws/comment lines. @@ -1261,7 +1251,7 @@ This true is when the line : * starts with a 1+ block-closer tokens, an top-most block opener is on a continuation line " (save-excursion - (when parse-start (goto-char parse-start)) ; 03e991 + (when parse-start (goto-char parse-start)) ;; If line starts with a series of closer tokens, whether or not the line ;; is a continuation line is decided by the opener line, e.g. From 426167a8f307e3fb47fa97d333c08d76dec8f014 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 17:32:28 -0500 Subject: [PATCH 080/158] Replace big regexps w/ rx expressions in 'lua-mode' * lisp/progmodes/lua-mode.el (lua-block-regexp) (lua-indentation-modifier-regexp, lua-cont-eol-regexp) (lua-cont-bol-regexp): Use rx. --- lisp/progmodes/lua-mode.el | 79 ++++++++++++++++++-------------------- 1 file changed, 38 insertions(+), 41 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index dcb8a27da64..bc1217be82d 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -838,12 +838,11 @@ found, returns point position, nil otherwise." (defconst lua-block-regexp (eval-when-compile - (concat - "\\(\\_<" - (regexp-opt '("do" "function" "repeat" "then" - "else" "elseif" "end" "until") t) - "\\_>\\)\\|" - (regexp-opt '("{" "(" "[" "]" ")" "}") t)))) + (rx (or (group symbol-start + (group (or "do" "function" "repeat" "then" + "else" "elseif" "end" "until")) + symbol-end) + (group (any "()[]{}")))))) (defconst lua-block-token-alist '(("do" "\\_" "\\_" middle-or-open) @@ -875,17 +874,15 @@ TOKEN-TYPE determines where the token occurs on a statement. open indicates that ;; The absence of else is deliberate, since it does not modify the ;; indentation level per se. It only may cause the line, in which the ;; else is, to be shifted to the left. - (concat - "\\(\\_<" - (regexp-opt '("do" "function" "repeat" "then" "if" "else" "elseif" "for" "while") t) - "\\_>\\|" - (regexp-opt '("{" "(" "[")) - "\\)\\|\\(\\_<" - (regexp-opt '("end" "until") t) - "\\_>\\|" - (regexp-opt '("]" ")" "}")) - "\\)") - ) + (rx (or (group (or (seq symbol-start + (group (or "do" "function" "repeat" "then" "if" + "else" "elseif" "for" "while")) + symbol-end) + (any "([{"))) + (group (or (seq symbol-start + (group (or "end" "until")) + symbol-end) + (any ")]}")))))) (defun lua-get-block-token-info (token) "Returns the block token info entry for TOKEN from lua-block-token-alist" @@ -1076,19 +1073,19 @@ Returns final value of point as integer or nil if operation failed." (defconst lua-cont-eol-regexp (eval-when-compile - (concat - "\\(?:\\(?1:\\_<" - (regexp-opt '("and" "or" "not" "in" "for" "while" - "local" "function" "if" "until" "elseif" "return") - t) - "\\_>\\)\\|" - "\\(?:^\\|[^" lua-operator-class "]\\)\\(?2:" - (regexp-opt '("+" "-" "*" "/" "%" "^" ".." "==" - "=" "<" ">" "<=" ">=" "~=" "." ":" - "&" "|" "~" ">>" "<<" "~" ",") - t) - "\\)\\)" - "\\s *\\=")) + (rx-to-string + `(seq (or (group-n 1 + symbol-start + (group (or "and" "or" "not" "in" "for" "while" "local" + "function" "if" "until" "elseif" "return")) + symbol-end) + (seq (or bol (not (any ,lua-operator-class))) + (group-n 2 + (group (or "%" "&" "*" "+" "," "-" "." ".." "/" ":" + "<" "<<" "<=" "=" "==" ">" ">=" ">>" "^" + "|" "~" "~="))))) + (zero-or-more (syntax whitespace)) + point))) "Regexp that matches the ending of a line that needs continuation. This regexp starts from eol and looks for a binary operator or an unclosed @@ -1097,17 +1094,17 @@ an optional whitespace till the end of the line.") (defconst lua-cont-bol-regexp (eval-when-compile - (concat - "\\=\\s *" - "\\(?:\\(?1:\\_<" - (regexp-opt '("and" "or" "not" "in") t) - "\\_>\\)\\|\\(?2:" - (regexp-opt '("," "+" "-" "*" "/" "%" "^" ".." "==" - "=" "<" ">" "<=" ">=" "~=" "." ":" - "&" "|" "~" ">>" "<<" "~") - t) - "\\)\\(?:$\\|[^" lua-operator-class "]\\)" - "\\)")) + (rx-to-string + `(seq point (zero-or-more (syntax whitespace)) + (or (group-n 1 + symbol-start + (group (or "and" "in" "not" "or")) + symbol-end) + (seq (group-n 2 + (group (or "%" "&" "*" "+" "," "-" "." ".." "/" ":" + "<" "<<" "<=" "=" "==" ">" ">=" ">>" "^" + "|" "~" "~="))) + (or eol (not (any ,lua-operator-class)))))))) "Regexp that matches a line that continues previous one. This regexp means, starting from point there is an optional whitespace followed From 8af0064a747d6ed1c73f66138f3e611d123f0da4 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 18:59:43 -0500 Subject: [PATCH 081/158] Remove trivial cl-* stuff from 'lua-mode' * lisp/progmodes/lua-mode.el (lua-process-buffer, lua--signum): Replace 'cl-assert'. (lua-accumulate-indentation-info): Replace 'cl-dolist' with 'dolist'. --- lisp/progmodes/lua-mode.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index bc1217be82d..ecd8facd220 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -216,7 +216,8 @@ Should be a list of strings." "Buffer used for communication with the Lua process.") (defun lua--customize-set-prefix-key (prefix-key-sym prefix-key-val) - (cl-assert (eq prefix-key-sym 'lua-prefix-key)) + (unless (eq prefix-key-sym 'lua-prefix-key) + (error "Prefix doesn't match lua-prefix-key")) (set prefix-key-sym (when (and prefix-key-val (> (length prefix-key-val) 0)) ;; read-kbd-macro returns a string or a vector ;; in both cases (elt x 0) is ok @@ -777,7 +778,6 @@ Return the amount the indentation changed by." (defun lua--signum (x) "Return 1 if X is positive, -1 if negative, 0 if zero." - ;; XXX: backport from cl-extras for Emacs24 (cond ((> x 0) 1) ((< x 0) -1) (t 0))) (defun lua--ensure-point-within-limit (limit backward) @@ -1475,7 +1475,7 @@ shift, or the absolute column to indent to." (type 'relative) (accu 0)) ;; Aggregate all neighbouring relative offsets, reversing the INFO list. - (cl-dolist (elt reversed-indentation-info) + (dolist (elt reversed-indentation-info) (if (and (eq (car elt) 'relative) (eq (caar indentation-info) 'relative)) (setcdr (car indentation-info) (+ (cdar indentation-info) (cdr elt))) @@ -1962,8 +1962,8 @@ left out." (defun lua-forward-sexp (&optional count) "Forward to block end" (interactive "p") - ;; negative offsets not supported - (cl-assert (or (not count) (>= count 0))) + (unless (or (not count) (>= count 0)) + (error "Negative offsets not supported")) (save-match-data (let ((count (or count 1)) (block-start (mapcar 'car lua-sexp-alist))) From 7fabc65484cc9513489c305420483c1a747a21c5 Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 20 Mar 2025 19:14:59 -0500 Subject: [PATCH 082/158] ; Update comments & requires in 'lua-mode' --- lisp/progmodes/lua-mode.el | 59 +++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 32 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index ecd8facd220..113e9566acc 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -1,4 +1,6 @@ -;;; lua-mode.el --- a major-mode for editing Lua scripts -*- lexical-binding: t -*- +;;; lua-mode.el --- Major-mode for editing Lua files -*- lexical-binding: t -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. ;; Author: 2011-2013 immerrr ;; 2010-2011 Reuben Thomas @@ -11,31 +13,22 @@ ;; Paul Du Bois and ;; Aaron Smith . ;; -;; URL: https://immerrr.github.io/lua-mode -;; Version: 20221027 -;; Package-Requires: ((emacs "24.3")) -;; -;; This file is NOT part of Emacs. -;; -;; This program is free software; you can redistribute it and/or modify +;; Keywords: languages, processes, tools + +;; 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. ;; -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see . - -;; Keywords: languages, processes, tools - -;; This field is expanded to commit SHA and commit date during the -;; archive creation. -;; Revision: $Format:%h (%cD)$ -;; +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -43,10 +36,10 @@ ;; indentation, syntactical font-locking, running interactive shell, ;; Flymake checks with luacheck, interacting with `hs-minor-mode' and ;; online documentation lookup. - +;; ;; The following variables are available for customization (see more via ;; `M-x customize-group lua`): - +;; ;; - Var `lua-indent-level': ;; indentation offset in spaces ;; - Var `lua-indent-string-contents': @@ -64,9 +57,9 @@ ;; base URL for documentation lookup ;; - Var `lua-documentation-function': function used to ;; show documentation (`eww` is a viable alternative for Emacs 25) - +;; ;; These are variables/commands that operate on the Lua process: - +;; ;; - Var `lua-default-application': ;; command to start the Lua process (REPL) ;; - Var `lua-default-command-switches': @@ -74,9 +67,9 @@ ;; if you expect working with Lua shell interactively) ;; - Cmd `lua-start-process': start new REPL process, usually happens automatically ;; - Cmd `lua-kill-process': kill current REPL process - +;; ;; These are variables/commands for interaction with the Lua process: - +;; ;; - Cmd `lua-show-process-buffer': switch to REPL buffer ;; - Cmd `lua-hide-process-buffer': hide window showing REPL buffer ;; - Var `lua-always-show': show REPL buffer after sending something @@ -85,23 +78,24 @@ ;; - Cmd `lua-send-defun': send current top-level function ;; - Cmd `lua-send-region': send active region ;; - Cmd `lua-restart-with-whole-file': restart REPL and send whole buffer - +;; ;; To enable on-the-fly linting, make sure you have the luacheck ;; program installed (available from luarocks) and activate ;; `flymake-mode'. - +;; ;; See "M-x apropos-command ^lua-" for a list of commands. ;; See "M-x customize-group lua" for a list of customizable variables. ;;; Code: -(eval-when-compile - (require 'cl-lib) - (require 'compile)) (require 'comint) (require 'newcomment) (require 'rx) +(eval-when-compile + (require 'cl-lib) + (require 'compile)) + ;; rx-wrappers for Lua (eval-and-compile @@ -150,6 +144,7 @@ (rx-to-string form no-group)))) ;; Local variables + (defgroup lua nil "Major mode for editing Lua code." :prefix "lua-" @@ -327,8 +322,8 @@ traceback location." (defvar lua-region-end (make-marker) "End of special region for Lua communication.") -;; the whole defconst is inside eval-when-compile, because it's later referenced -;; inside another eval-and-compile block +;; The whole defconst is inside eval-when-compile, because it's later +;; referenced inside another eval-and-compile block. (eval-and-compile (defconst lua--builtins @@ -578,7 +573,7 @@ index of respective Lua reference manuals.") (lua-indent-line)) (blink-matching-open)) -;; private functions +;; Private functions (defun lua--fill-paragraph (&optional justify region) ;; Implementation of forward-paragraph for filling. @@ -2031,7 +2026,7 @@ member of `flymake-diagnostic-functions'." (process-send-region lua--flymake-process (point-min) (point-max)) (process-send-eof lua--flymake-process)))) -;; menu bar +;; Menu bar (easy-menu-define lua-mode-menu lua-mode-map "Menu bar entry for `lua-mode'." From 22e3ba30fac7a0722f121a5c4d5ddad443a40f77 Mon Sep 17 00:00:00 2001 From: john muhl Date: Fri, 21 Mar 2025 09:20:23 -0500 Subject: [PATCH 083/158] ; Improve compliance of 'lua-mode' * lisp/progmodes/lua-mode.el: Fix byte-compiler warnings, placate checkdoc and improve consistency of comment formatting. --- lisp/progmodes/lua-mode.el | 861 ++++++++++++++++++++----------------- 1 file changed, 472 insertions(+), 389 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 113e9566acc..ce4a1744d9f 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -63,9 +63,10 @@ ;; - Var `lua-default-application': ;; command to start the Lua process (REPL) ;; - Var `lua-default-command-switches': -;; arguments to pass to the Lua process on startup (make sure `-i` is there -;; if you expect working with Lua shell interactively) -;; - Cmd `lua-start-process': start new REPL process, usually happens automatically +;; arguments to pass to the Lua process on startup (make sure `-i` is +;; there if you expect working with Lua shell interactively) +;; - Cmd `lua-start-process': start new REPL process, usually happens +;; automatically ;; - Cmd `lua-kill-process': kill current REPL process ;; ;; These are variables/commands for interaction with the Lua process: @@ -79,9 +80,8 @@ ;; - Cmd `lua-send-region': send active region ;; - Cmd `lua-restart-with-whole-file': restart REPL and send whole buffer ;; -;; To enable on-the-fly linting, make sure you have the luacheck -;; program installed (available from luarocks) and activate -;; `flymake-mode'. +;; To enable on-the-fly linting, make sure you have the luacheck program +;; installed (available from luarocks) and activate `flymake-mode'. ;; ;; See "M-x apropos-command ^lua-" for a list of commands. ;; See "M-x customize-group lua" for a list of customizable variables. @@ -169,9 +169,9 @@ (defcustom lua-default-application "lua" "Default application to run in Lua process. -Can be a string, where it denotes a command to be executed to -start Lua process, or a (HOST . PORT) cons, that can be used to -connect to Lua process running remotely." +Can be a string, where it denotes a command to be executed to start Lua +process, or a (HOST . PORT) cons, that can be used to connect to Lua +process running remotely." :type '(choice (string) (cons string integer)) :version "31.1") @@ -183,7 +183,7 @@ Should be a list of strings." :version "31.1") (defcustom lua-always-show t - "*Non-nil means display lua-process-buffer after sending a command." + "Non-nil means display lua-process-buffer after sending a command." :type 'boolean :group 'lua) @@ -191,7 +191,8 @@ Should be a list of strings." "Function used to fetch the Lua reference manual." :type `(radio (function-item browse-url) ,@(when (fboundp 'eww) '((function-item eww))) - ,@(when (fboundp 'w3m-browse-url) '((function-item w3m-browse-url))) + ,@(when (fboundp 'w3m-browse-url) + '((function-item w3m-browse-url))) (function :tag "Other function")) :version "31.1") @@ -205,12 +206,13 @@ Should be a list of strings." (defvar lua-process nil - "The active Lua process") + "The active Lua process.") (defvar lua-process-buffer nil "Buffer used for communication with the Lua process.") (defun lua--customize-set-prefix-key (prefix-key-sym prefix-key-val) + "Set PREFIX-KEY-SYM to PREFIX-KEY-VAL." (unless (eq prefix-key-sym 'lua-prefix-key) (error "Prefix doesn't match lua-prefix-key")) (set prefix-key-sym (when (and prefix-key-val (> (length prefix-key-val) 0)) @@ -221,7 +223,7 @@ Should be a list of strings." (lua-prefix-key-update-bindings))) (defcustom lua-prefix-key "\C-c" - "Prefix for all lua-mode commands." + "Prefix for all `lua-mode' commands." :type 'string :set 'lua--customize-set-prefix-key :get (lambda (sym) @@ -232,7 +234,8 @@ Should be a list of strings." (eval-when-compile (let ((result-map (make-sparse-keymap))) (mapc (lambda (key_defn) - (define-key result-map (read-kbd-macro (car key_defn)) (cdr key_defn))) + (define-key + result-map (read-kbd-macro (car key_defn)) (cdr key_defn))) '(("C-l" . lua-send-buffer) ("C-f" . lua-search-documentation))) result-map)) @@ -254,19 +257,18 @@ If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") lua--electric-indent-chars)) (define-key result-map [remap backward-up-list] 'lua-backward-up-list) - ;; handle prefix-keyed bindings: - ;; * if no prefix, set prefix-map as parent, i.e. - ;; if key is not defined look it up in prefix-map + ;; Handle prefix-keyed bindings: + ;; * if no prefix, set prefix-map as parent, i.e. if key is not + ;; defined look it up in prefix-map ;; * if prefix is set, bind the prefix-map to that key (if lua-prefix-key (define-key result-map (vector lua-prefix-key) lua-prefix-mode-map) (set-keymap-parent result-map lua-prefix-mode-map)) result-map) - "Keymap used in lua-mode buffers.") + "Keymap used in `lua-mode' buffers.") (defvar-local lua-electric-flag t - "If t, electric actions (like automatic reindentation) will happen when an electric - key like `{' is pressed") + "Non-nil means electric actions are enabled.") (defcustom lua-prompt-regexp "[^\n]*\\(>[\t ]+\\)+$" "Regexp which matches the Lua program's prompt." @@ -284,25 +286,26 @@ Otherwise leading amount of whitespace on each line is preserved." :version "31.1") (defcustom lua-indent-nested-block-content-align t - "If non-nil, the contents of nested blocks are indented to -align with the column of the opening parenthesis, rather than -just forward by `lua-indent-level'." + "Controls how the content of nested blocks are indented. +If non-nil, the contents of nested blocks are indented to align with the +column of the opening parenthesis, rather than just forward by +`lua-indent-level'." :type 'boolean :safe #'booleanp :version "31.1") (defcustom lua-indent-close-paren-align t - "If non-nil, close parenthesis are aligned with their open -parenthesis. If nil, close parenthesis are aligned to the -beginning of the line." + "Controls how closing parenthesis is aligned. +If non-nil, close parenthesis are aligned with their open parenthesis. +If nil, close parenthesis are aligned to the beginning of the line." :type 'boolean :safe #'booleanp :version "31.1") (defcustom lua-jump-on-traceback t - "*Jump to innermost traceback location in *lua* buffer. When this -variable is non-nil and a traceback occurs when running Lua code in a -process, jump immediately to the source code of the innermost + "Jump to innermost traceback location in *lua* buffer. +When this variable is non-nil and a traceback occurs when running Lua +code in a process, jump immediately to the source code of the innermost traceback location." :type 'boolean :version "31.1") @@ -325,78 +328,76 @@ traceback location." ;; The whole defconst is inside eval-when-compile, because it's later ;; referenced inside another eval-and-compile block. (eval-and-compile - (defconst - lua--builtins - (let* - ((modules - '("_G" "_VERSION" "assert" "collectgarbage" "dofile" "error" "getfenv" - "getmetatable" "ipairs" "load" "loadfile" "loadstring" "module" - "next" "pairs" "pcall" "print" "rawequal" "rawget" "rawlen" "rawset" - "require" "select" "setfenv" "setmetatable" "tonumber" "tostring" - "type" "unpack" "xpcall" "self" - ("bit32" . ("arshift" "band" "bnot" "bor" "btest" "bxor" "extract" - "lrotate" "lshift" "replace" "rrotate" "rshift")) - ("coroutine" . ("create" "isyieldable" "resume" "running" "status" - "wrap" "yield")) - ("debug" . ("debug" "getfenv" "gethook" "getinfo" "getlocal" - "getmetatable" "getregistry" "getupvalue" "getuservalue" - "setfenv" "sethook" "setlocal" "setmetatable" - "setupvalue" "setuservalue" "traceback" "upvalueid" - "upvaluejoin")) - ("io" . ("close" "flush" "input" "lines" "open" "output" "popen" - "read" "stderr" "stdin" "stdout" "tmpfile" "type" "write")) - ("math" . ("abs" "acos" "asin" "atan" "atan2" "ceil" "cos" "cosh" - "deg" "exp" "floor" "fmod" "frexp" "huge" "ldexp" "log" - "log10" "max" "maxinteger" "min" "mininteger" "modf" "pi" - "pow" "rad" "random" "randomseed" "sin" "sinh" "sqrt" - "tan" "tanh" "tointeger" "type" "ult")) - ("os" . ("clock" "date" "difftime" "execute" "exit" "getenv" - "remove" "rename" "setlocale" "time" "tmpname")) - ("package" . ("config" "cpath" "loaded" "loaders" "loadlib" "path" - "preload" "searchers" "searchpath" "seeall")) - ("string" . ("byte" "char" "dump" "find" "format" "gmatch" "gsub" - "len" "lower" "match" "pack" "packsize" "rep" "reverse" - "sub" "unpack" "upper")) - ("table" . ("concat" "insert" "maxn" "move" "pack" "remove" "sort" - "unpack")) - ("utf8" . ("char" "charpattern" "codepoint" "codes" "len" - "offset"))))) + (defconst lua--builtins + (let* ((modules + '("_G" "_VERSION" "assert" "collectgarbage" "dofile" "error" "getfenv" + "getmetatable" "ipairs" "load" "loadfile" "loadstring" "module" + "next" "pairs" "pcall" "print" "rawequal" "rawget" "rawlen" "rawset" + "require" "select" "setfenv" "setmetatable" "tonumber" "tostring" + "type" "unpack" "xpcall" "self" + ("bit32" . ("arshift" "band" "bnot" "bor" "btest" "bxor" "extract" + "lrotate" "lshift" "replace" "rrotate" "rshift")) + ("coroutine" . ("create" "isyieldable" "resume" "running" "status" + "wrap" "yield")) + ("debug" . ("debug" "getfenv" "gethook" "getinfo" "getlocal" + "getmetatable" "getregistry" "getupvalue" "getuservalue" + "setfenv" "sethook" "setlocal" "setmetatable" + "setupvalue" "setuservalue" "traceback" "upvalueid" + "upvaluejoin")) + ("io" . ("close" "flush" "input" "lines" "open" "output" "popen" + "read" "stderr" "stdin" "stdout" "tmpfile" "type" "write")) + ("math" . ("abs" "acos" "asin" "atan" "atan2" "ceil" "cos" "cosh" + "deg" "exp" "floor" "fmod" "frexp" "huge" "ldexp" "log" + "log10" "max" "maxinteger" "min" "mininteger" "modf" "pi" + "pow" "rad" "random" "randomseed" "sin" "sinh" "sqrt" + "tan" "tanh" "tointeger" "type" "ult")) + ("os" . ("clock" "date" "difftime" "execute" "exit" "getenv" + "remove" "rename" "setlocale" "time" "tmpname")) + ("package" . ("config" "cpath" "loaded" "loaders" "loadlib" "path" + "preload" "searchers" "searchpath" "seeall")) + ("string" . ("byte" "char" "dump" "find" "format" "gmatch" "gsub" + "len" "lower" "match" "pack" "packsize" "rep" "reverse" + "sub" "unpack" "upper")) + ("table" . ("concat" "insert" "maxn" "move" "pack" "remove" "sort" + "unpack")) + ("utf8" . ("char" "charpattern" "codepoint" "codes" "len" + "offset"))))) (cl-labels ((module-name-re (x) - (concat "\\(?1:\\_<" - (if (listp x) (car x) x) - "\\_>\\)")) - (module-members-re (x) (if (listp x) - (concat "\\(?:[ \t]*\\.[ \t]*" - "\\_<\\(?2:" - (regexp-opt (cdr x)) - "\\)\\_>\\)?") - ""))) + (concat "\\(?1:\\_<" + (if (listp x) (car x) x) + "\\_>\\)")) + (module-members-re (x) + (if (listp x) + (concat "\\(?:[ \t]*\\.[ \t]*" + "\\_<\\(?2:" + (regexp-opt (cdr x)) + "\\)\\_>\\)?") + ""))) (concat - ;; common prefix: + ;; Common prefix: ;; - beginning-of-line ;; - or neither of [ '.', ':' ] to exclude "foo.string.rep" ;; - or concatenation operator ".." "\\(?:^\\|[^:. \t]\\|[.][.]\\)" - ;; optional whitespace + ;; Optional whitespace "[ \t]*" "\\(?:" - ;; any of modules/functions - (mapconcat (lambda (x) (concat (module-name-re x) - (module-members-re x))) + ;; Any of modules/functions + (mapconcat (lambda (x) + (concat (module-name-re x) (module-members-re x))) modules "\\|") "\\)")))) - "A regexp that matches Lua builtin functions & variables. This is a compilation of 5.1, 5.2 and 5.3 builtins taken from the index of respective Lua reference manuals.") (defvar lua-font-lock-keywords - `(;; highlight the hash-bang line "#!/foo/bar/lua" as comment + `(;; Highlight the hash-bang line "#!/foo/bar/lua" as comment ("^#!.*$" . font-lock-comment-face) ;; Builtin constants @@ -408,7 +409,7 @@ index of respective Lua reference manuals.") . font-lock-keyword-face) ;; Labels used by the "goto" statement - ;; Highlights the following syntax: ::label:: + ;; Highlights the following syntax: ::label:: (,(lua-rx "::" ws lua-name ws "::") . font-lock-constant-face) @@ -432,7 +433,8 @@ index of respective Lua reference manuals.") (8 font-lock-variable-name-face nil noerror) (9 font-lock-variable-name-face nil noerror)) - (,(lua-rx (symbol "function") (? ws+ lua-funcname) ws "(" ws lua-up-to-9-variables) + (,(lua-rx (symbol "function") (? ws+ lua-funcname) + ws "(" ws lua-up-to-9-variables) (1 font-lock-variable-name-face) (2 font-lock-variable-name-face nil noerror) (3 font-lock-variable-name-face nil noerror) @@ -453,7 +455,8 @@ index of respective Lua reference manuals.") ;; ;; local foo = function() ... ;; - ;; "foo" is fontified as function-name-face, and variable-name-face is not applied. + ;; "foo" is fontified as function-name-face, and variable-name-face + ;; is not applied. (,(lua-rx (symbol "local") ws+ lua-up-to-9-variables) (1 font-lock-variable-name-face) (2 font-lock-variable-name-face nil noerror) @@ -472,13 +475,17 @@ index of respective Lua reference manuals.") (group-n 2 lua-name)))) (1 font-lock-keyword-face t) (2 font-lock-variable-name-face t noerror))) - "Default expressions to highlight in Lua mode.") (defvar lua-imenu-generic-expression - `(("Requires" ,(lua-rx (or bol ";") ws (opt (seq (symbol "local") ws)) (group-n 1 lua-name) ws "=" ws (symbol "require")) 1) - (nil ,(lua-rx (or bol ";") ws (opt (seq (symbol "local") ws)) lua-funcheader) 1)) - "Imenu generic expression for lua-mode. See `imenu-generic-expression'.") + `(("Requires" ,(lua-rx (or bol ";") ws (opt (seq (symbol "local") ws)) + (group-n 1 lua-name) ws "=" ws (symbol "require")) + 1) + (nil ,(lua-rx (or bol ";") ws (opt (seq (symbol "local") ws)) + lua-funcheader) + 1)) + "Imenu generic expression for `lua-mode'. +See `imenu-generic-expression'.") (defvar lua-sexp-alist '(("then" . "end") ("function" . "end") @@ -486,7 +493,7 @@ index of respective Lua reference manuals.") ("repeat" . "until"))) (defvar lua-mode-abbrev-table nil - "Abbreviation table used in lua-mode buffers.") + "Abbreviation table used in `lua-mode' buffers.") (define-abbrev-table 'lua-mode-abbrev-table '(("end" "end" lua-indent-line :system t) @@ -495,15 +502,15 @@ index of respective Lua reference manuals.") (defvar lua-mode-syntax-table (with-syntax-table (copy-syntax-table) - ;; main comment syntax: begins with "--", ends with "\n" + ;; Main comment syntax: begins with "--", ends with "\n" (modify-syntax-entry ?- ". 12") (modify-syntax-entry ?\n ">") - ;; main string syntax: bounded by ' or " + ;; Main string syntax: bounded by ' or " (modify-syntax-entry ?\' "\"") (modify-syntax-entry ?\" "\"") - ;; single-character binary operators: punctuation + ;; Single-character binary operators: punctuation (modify-syntax-entry ?+ ".") (modify-syntax-entry ?* ".") (modify-syntax-entry ?/ ".") @@ -522,40 +529,39 @@ index of respective Lua reference manuals.") "Major mode for editing Lua code." :abbrev-table lua-mode-abbrev-table :syntax-table lua-mode-syntax-table - (setq-local font-lock-defaults '(lua-font-lock-keywords ;; keywords - nil ;; keywords-only - nil ;; case-fold - nil ;; syntax-alist - nil ;; syntax-begin - )) + (setq-local font-lock-defaults '(lua-font-lock-keywords ; keywords + nil ; keywords-only + nil ; case-fold + nil ; syntax-alist + nil)) ; syntax-begin (setq-local syntax-propertize-function 'lua--propertize-multiline-bounds) - (setq-local parse-sexp-lookup-properties t) - (setq-local indent-line-function 'lua-indent-line) - (setq-local beginning-of-defun-function 'lua-beginning-of-proc) - (setq-local end-of-defun-function 'lua-end-of-proc) - (setq-local comment-start lua-comment-start) - (setq-local comment-start-skip lua-comment-start-skip) - (setq-local comment-use-syntax t) - (setq-local fill-paragraph-function #'lua--fill-paragraph) + (setq-local parse-sexp-lookup-properties t) + (setq-local indent-line-function 'lua-indent-line) + (setq-local beginning-of-defun-function 'lua-beginning-of-proc) + (setq-local end-of-defun-function 'lua-end-of-proc) + (setq-local comment-start lua-comment-start) + (setq-local comment-start-skip lua-comment-start-skip) + (setq-local comment-use-syntax t) + (setq-local fill-paragraph-function #'lua--fill-paragraph) (with-no-warnings - (setq-local comment-use-global-state t)) - (setq-local imenu-generic-expression lua-imenu-generic-expression) + (setq-local comment-use-global-state t)) + (setq-local imenu-generic-expression lua-imenu-generic-expression) (when (boundp 'electric-indent-chars) - ;; If electric-indent-chars is not defined, electric indentation is done - ;; via `lua-mode-map'. + ;; If electric-indent-chars is not defined, electric indentation is + ;; done via `lua-mode-map'. (setq-local electric-indent-chars (append electric-indent-chars lua--electric-indent-chars))) (add-hook 'flymake-diagnostic-functions #'lua-flymake nil t) - ;; hideshow setup + ;; Hide-show setup (unless (assq 'lua-mode hs-special-modes-alist) (add-to-list 'hs-special-modes-alist `(lua-mode - ,(regexp-opt (mapcar 'car lua-sexp-alist) 'words) ;start - ,(regexp-opt (mapcar 'cdr lua-sexp-alist) 'words) ;end + ,(regexp-opt (mapcar 'car lua-sexp-alist) 'words) ; Start + ,(regexp-opt (mapcar 'cdr lua-sexp-alist) 'words) ; End nil lua-forward-sexp)))) ;;;###autoload @@ -565,7 +571,7 @@ index of respective Lua reference manuals.") (add-to-list 'interpreter-mode-alist '("lua" . lua-mode)) (defun lua-electric-match (arg) - "Insert character and adjust indentation." + "Insert character ARG and adjust indentation." (interactive "P") (let (blink-paren-function) (self-insert-command (prefix-numeric-value arg))) @@ -576,19 +582,21 @@ index of respective Lua reference manuals.") ;; Private functions (defun lua--fill-paragraph (&optional justify region) - ;; Implementation of forward-paragraph for filling. - ;; - ;; This function works around a corner case in the following situations: - ;; - ;; <> - ;; -- some very long comment .... - ;; some_code_right_after_the_comment - ;; - ;; If point is at the beginning of the comment line, fill paragraph code - ;; would have gone for comment-based filling and done the right thing, but it - ;; does not find a comment at the beginning of the empty line before the - ;; comment and falls back to text-based filling ignoring comment-start and - ;; spilling the comment into the code. + "Implementation of `forward-paragraph' for filling. + +This function works around a corner case in the following situations: + + <> + -- some very long comment .... + some_code_right_after_the_comment + +If point is at the beginning of the comment line, fill paragraph code +would have gone for comment-based filling and done the right thing, but +it does not find a comment at the beginning of the empty line before the +comment and falls back to text-based filling ignoring `comment-start' +and spilling the comment into the code. + +The arguments JUSTIFY and REGION control `fill-paragraph' (which see)." (save-excursion (while (and (not (eobp)) (progn (move-to-left-margin) @@ -598,10 +606,11 @@ index of respective Lua reference manuals.") (fill-paragraph justify region)))) (defun lua-prefix-key-update-bindings () + "Update prefix key bindings." (if (eq lua-prefix-mode-map (keymap-parent lua-mode-map)) - ;; if prefix-map is a parent, delete the parent + ;; If prefix-map is a parent, delete the parent (set-keymap-parent lua-mode-map nil) - ;; otherwise, look for it among children + ;; Otherwise, look for it among children (when-let* ((old-cons (rassoc lua-prefix-mode-map lua-mode-map))) (delq old-cons lua-mode-map))) (if (null lua-prefix-key) @@ -609,7 +618,7 @@ index of respective Lua reference manuals.") (define-key lua-mode-map (vector lua-prefix-key) lua-prefix-mode-map))) (defun lua-set-prefix-key (new-key-str) - "Changes `lua-prefix-key' properly and updates keymaps + "Change `lua-prefix-key' to NEW-KEY-STR and update keymaps. This function replaces previous prefix-key binding with a new one." (interactive "sNew prefix key (empty string means no key): ") @@ -618,7 +627,7 @@ This function replaces previous prefix-key binding with a new one." (lua-prefix-key-update-bindings)) (defun lua-string-p (&optional pos) - "Returns true if the point is in a string." + "Return non-nil if point or POS is in a string." (save-excursion (elt (syntax-ppss pos) 3))) (defun lua--containing-double-hyphen-start-pos () @@ -634,7 +643,9 @@ consider point as inside comment when it is between the two hyphens" (defun lua-comment-start-pos (&optional parsing-state) "Return position of comment containing current point. -If point is not inside a comment, return nil." +If point is not inside a comment, return nil. + +The argument PARSING-STATE is a `syntax-ppss' state." (if-let* ((parsing-state (or parsing-state (syntax-ppss))) ((not (nth 3 parsing-state))) ; Not a string. ((nth 4 parsing-state))) ; Syntax-based comment. @@ -642,12 +653,13 @@ If point is not inside a comment, return nil." (lua--containing-double-hyphen-start-pos))) (defun lua-comment-or-string-p (&optional pos) - "Returns true if the point is in a comment or string." - (save-excursion (let ((parse-result (syntax-ppss pos))) - (or (elt parse-result 3) (lua-comment-start-pos parse-result))))) + "Return non-nil if point or POS is in a comment or string." + (save-excursion + (let ((parse-result (syntax-ppss pos))) + (or (elt parse-result 3) (lua-comment-start-pos parse-result))))) (defun lua-comment-or-string-start-pos (&optional pos) - "Returns start position of string or comment which contains point. + "Return start position of string or comment containing point or POS. If point is not inside string or comment, return nil." (save-excursion @@ -665,8 +677,10 @@ If point is not inside string or comment, return nil." (defun lua-try-match-multiline-end (end) "Try to match close-bracket for multiline literal around point. -Basically, detect form of close bracket from syntactic -information provided at point and re-search-forward to it." +Basically, detect form of close bracket from syntactic information +provided at point and `re-search-forward' to it. + +The argument END is a buffer position that bounds the search." (let ((comment-or-string-start-pos (lua-comment-or-string-start-pos))) ;; Is there a literal around point? (and comment-or-string-start-pos @@ -675,8 +689,9 @@ information provided at point and re-search-forward to it." (goto-char comment-or-string-start-pos) (looking-at lua-ml-begin-regexp)) - ;; Yes it is, look for it matching close-bracket. Close-bracket's - ;; match group is determined by match-group of open-bracket. + ;; Yes it is, look for it matching close-bracket. Close + ;; bracket's match group is determined by match-group of + ;; open-bracket. (re-search-forward (format "]%s\\(?%s:]\\)" (match-string-no-properties 3) @@ -686,35 +701,39 @@ information provided at point and re-search-forward to it." (defun lua-try-match-multiline-begin (limit) "Try to match multiline open-brackets. -Find next opening long bracket outside of any string/comment. -If none can be found before reaching LIMIT, return nil." - +Find next opening long bracket outside of any string/comment. If none +can be found before reaching LIMIT, return nil." (let (last-search-matched) (while - ;; This loop will iterate skipping all multiline-begin tokens that are - ;; inside strings or comments ending either at EOL or at valid token. + ;; This loop will iterate skipping all multiline-begin tokens + ;; that are inside strings or comments ending either at EOL or + ;; at valid token. (and (setq last-search-matched (re-search-forward lua-ml-begin-regexp limit 'noerror)) ;; Ensure --[[ is not inside a comment or string. ;; - ;; This includes "---[[" sequence, in which "--" at the beginning - ;; creates a single-line comment, and thus "-[[" is no longer a - ;; multi-line opener. + ;; This includes "---[[" sequence, in which "--" at the + ;; beginning creates a single-line comment, and thus "-[[" + ;; is no longer a multi-line opener. ;; - ;; XXX: need to ensure syntax-ppss beyond (match-beginning 0) is - ;; not calculated, or otherwise we'll need to flush the cache. + ;; XXX: need to ensure syntax-ppss beyond (match-beginning + ;; 0) is not calculated, or otherwise we'll need to flush + ;; the cache. (lua-comment-or-string-start-pos (match-beginning 0)))) last-search-matched)) (defun lua-match-multiline-literal-bounds (limit) - ;; First, close any multiline literal spanning from previous block. This will - ;; move the point accordingly so as to avoid double traversal. + "Move point to multi-line literal bound. +The argument LIMIT is a buffer position that bounds the search." + ;; First, close any multiline literal spanning from previous block. + ;; This will move the point accordingly so as to avoid double + ;; traversal. (or (lua-try-match-multiline-end limit) (lua-try-match-multiline-begin limit))) (defun lua--propertize-multiline-bounds (start end) - "Put text properties on beginnings and ends of multiline literals. + "Put text properties on multiline literal bounds within START and END. Intended to be used as a `syntax-propertize-function'." (save-excursion @@ -732,7 +751,8 @@ Intended to be used as a `syntax-propertize-function'." Return the amount the indentation changed by." (let (indent (case-fold-search nil) - ;; save point as a distance to eob - it's invariant w.r.t indentation + ;; Save point as a distance to eob - it's invariant w.r.t + ;; indentation. (pos (- (point-max) (point)))) (back-to-indentation) (setq indent (if (lua-comment-or-string-p) @@ -744,18 +764,19 @@ Return the amount the indentation changed by." (delete-region (line-beginning-position) (point)) (indent-to indent)) - ;; If initial point was within line's indentation, - ;; position after the indentation. Else stay at same point in text. + ;; If initial point was within line's indentation, position after + ;; the indentation. Else stay at same point in text. (when (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) indent)) (defun lua-calculate-string-or-comment-indentation () - "This function should be run when point at (current-indentation) is inside string" + "This should be run when point at `current-indentation' is in a string." (if (and (lua-string-p) (not lua-indent-string-contents)) - ;; if inside string and strings aren't to be indented, return current indentation + ;; If inside string and strings aren't to be indented, return + ;; current indentation. (current-indentation) ;; At this point, we know that we're inside comment, so make sure @@ -778,8 +799,8 @@ Return the amount the indentation changed by." (defun lua--ensure-point-within-limit (limit backward) "Return non-nil if point is within LIMIT going forward. -With BACKWARD non-nil, return non-nil if point is within LIMIT -going backward. +With BACKWARD non-nil, return non-nil if point is within LIMIT going +backward. If point is beyond limit, move it onto limit." (if (= (lua--signum (- (point) limit)) @@ -791,29 +812,33 @@ If point is beyond limit, move it onto limit." (defun lua--escape-from-string (&optional backward) "Move point outside of string if it is inside one. -By default, point is placed after the string, with BACKWARD it is -placed before the string." +By default, point is placed after the string, with BACKWARD it is placed +before the string." (interactive) (let ((parse-state (syntax-ppss))) (when (nth 3 parse-state) (if backward (goto-char (nth 8 parse-state)) - (parse-partial-sexp (point) (line-end-position) nil nil (syntax-ppss) 'syntax-table)) + (parse-partial-sexp + (point) (line-end-position) nil nil (syntax-ppss) 'syntax-table)) t))) (defun lua-find-regexp (direction regexp &optional limit) - "Searches for a regular expression in the direction specified. + "Search for a regular expression in the direction specified. -Direction is one of \\='forward and \\='backward. +DIRECTION is one of \\='forward and \\='backward. -Matches in comments and strings are ignored. If the regexp is -found, returns point position, nil otherwise." +Matches in comments and strings are ignored. If the REGEXP is found, +returns point position, nil otherwise. + +The argument LIMIT is a buffer position that bounds the search." (let ((search-func (if (eq direction 'forward) 're-search-forward 're-search-backward)) (case-fold-search nil)) (cl-loop always (or (null limit) - (lua--ensure-point-within-limit limit (not (eq direction 'forward)))) + (lua--ensure-point-within-limit + limit (not (eq direction 'forward)))) always (funcall search-func regexp limit 'noerror) for match-beg = (match-beginning 0) for match-end = (match-end 0) @@ -840,34 +865,46 @@ found, returns point position, nil otherwise." (group (any "()[]{}")))))) (defconst lua-block-token-alist - '(("do" "\\_" "\\_" middle-or-open) - ("function" "\\_" nil open) - ("repeat" "\\_" nil open) - ("then" "\\_<\\(e\\(lse\\(if\\)?\\|nd\\)\\)\\_>" "\\_<\\(else\\)?if\\_>" middle) - ("{" "}" nil open) - ("[" "]" nil open) - ("(" ")" nil open) - ("if" "\\_" nil open) - ("for" "\\_" nil open) - ("while" "\\_" nil open) - ("else" "\\_" "\\_" middle) - ("elseif" "\\_" "\\_" middle) - ("end" nil "\\_<\\(do\\|function\\|then\\|else\\)\\_>" close) - ("until" nil "\\_" close) - ("}" nil "{" close) - ("]" nil "\\[" close) - (")" nil "(" close)) + '(("do" "\\_" "\\_" middle-or-open) + ("function" "\\_" nil open) + ("repeat" "\\_" nil open) + ("then" + "\\_<\\(e\\(lse\\(if\\)?\\|nd\\)\\)\\_>" "\\_<\\(else\\)?if\\_>" middle) + ("{" "}" nil open) + ("[" "]" nil open) + ("(" ")" nil open) + ("if" "\\_" nil open) + ("for" "\\_" nil open) + ("while" "\\_" nil open) + ("else" "\\_" "\\_" middle) + ("elseif" "\\_" "\\_" middle) + ("end" nil "\\_<\\(do\\|function\\|then\\|else\\)\\_>" close) + ("until" nil "\\_" close) + ("}" nil "{" close) + ("]" nil "\\[" close) + (")" nil "(" close)) "This is a list of block token information blocks. + Each token information entry is of the form: KEYWORD FORWARD-MATCH-REGEXP BACKWARDS-MATCH-REGEXP TOKEN-TYPE + KEYWORD is the token. -FORWARD-MATCH-REGEXP is a regexp that matches all possible tokens when going forward. -BACKWARDS-MATCH-REGEXP is a regexp that matches all possible tokens when going backwards. -TOKEN-TYPE determines where the token occurs on a statement. open indicates that the token appears at start, close indicates that it appears at end, middle indicates that it is a middle type token, and middle-or-open indicates that it can appear both as a middle or an open type.") + +FORWARD-MATCH-REGEXP is a regexp that matches all possible tokens when +going forward. + +BACKWARDS-MATCH-REGEXP is a regexp that matches all possible tokens when +going backwards. + +TOKEN-TYPE determines where the token occurs on a statement. Open +indicates that the token appears at start, close indicates that it +appears at end, middle indicates that it is a middle type token, and +middle-or-open indicates that it can appear both as a middle or an open +type.") (defconst lua-indentation-modifier-regexp ;; The absence of else is deliberate, since it does not modify the - ;; indentation level per se. It only may cause the line, in which the + ;; indentation level per se. It only may cause the line, in which the ;; else is, to be shifted to the left. (rx (or (group (or (seq symbol-start (group (or "do" "function" "repeat" "then" "if" @@ -880,28 +917,32 @@ TOKEN-TYPE determines where the token occurs on a statement. open indicates that (any ")]}")))))) (defun lua-get-block-token-info (token) - "Returns the block token info entry for TOKEN from lua-block-token-alist" + "Return the block token info entry for TOKEN from lua-block-token-alist." (assoc token lua-block-token-alist)) (defun lua-get-token-match-re (token-info direction) - "Returns the relevant match regexp from token info" + "Return the relevant match regexp from TOKEN-INFO. + +The argument DIRECTION controls if the search goes forward or backward." (cond ((eq direction 'forward) (cadr token-info)) ((eq direction 'backward) (nth 2 token-info)) (t nil))) (defun lua-get-token-type (token-info) - "Returns the relevant match regexp from token info" + "Return the relevant match regexp from TOKEN-INFO." (nth 3 token-info)) (defun lua-backwards-to-block-begin-or-end () - "Move backwards to nearest block begin or end. Returns nil if not successful." + "Move backwards to nearest block begin or end. +Return nil if unsuccessful." (interactive) (lua-find-regexp 'backward lua-block-regexp)) (defun lua-find-matching-token-word (token &optional direction) "Find matching open- or close-token for TOKEN in DIRECTION. -Point has to be exactly at the beginning of TOKEN, e.g. with | being point +Point has to be exactly at the beginning of TOKEN, e.g. with | being +point {{ }|} -- (lua-find-matching-token-word \"}\" \\='backward) will return -- the first { @@ -911,8 +952,8 @@ Point has to be exactly at the beginning of TOKEN, e.g. with | being point DIRECTION has to be either \\='forward or \\='backward." (let* ((token-info (lua-get-block-token-info token)) (match-type (lua-get-token-type token-info)) - ;; If we are on a middle token, go backwards. If it is a middle or open, - ;; go forwards + ;; If we are on a middle token, go backwards. If it is a + ;; middle or open, go forwards (search-direction (or direction (if (or (eq match-type 'open) (eq match-type 'middle-or-open)) @@ -921,32 +962,32 @@ DIRECTION has to be either \\='forward or \\='backward." 'backward)) (match (lua-get-token-match-re token-info search-direction)) maybe-found-pos) - ;; if we are searching forward from the token at the current point + ;; If we are searching forward from the token at the current point ;; (i.e. for a closing token), need to step one character forward ;; first, or the regexp will match the opening token. (when (eq search-direction 'forward) (forward-char 1)) (catch 'found - ;; If we are attempting to find a matching token for a terminating token - ;; (i.e. a token that starts a statement when searching back, or a token - ;; that ends a statement when searching forward), then we don't need to look - ;; any further. + ;; If we are attempting to find a matching token for a terminating + ;; token (i.e. a token that starts a statement when searching + ;; back, or a token that ends a statement when searching forward), + ;; then we don't need to look any further. (when (or (and (eq search-direction 'forward) (eq match-type 'close)) (and (eq search-direction 'backward) (eq match-type 'open))) (throw 'found nil)) - (while (lua-find-regexp search-direction lua-indentation-modifier-regexp) ; 03e991 - ;; have we found a valid matching token? + (while (lua-find-regexp search-direction lua-indentation-modifier-regexp) + ;; Have we found a valid matching token? (let* ((found-token (match-string 0)) (found-pos (match-beginning 0)) (found-type (lua-get-token-type (lua-get-block-token-info found-token)))) (if (not (and match (string-match match found-token))) - ;; no - then there is a nested block. If we were looking for - ;; a block begin token, found-token must be a block end - ;; token; likewise, if we were looking for a block end token, - ;; found-token must be a block begin token, otherwise there - ;; is a grammatical error in the code. + ;; No - then there is a nested block. If we were looking + ;; for a block begin token, found-token must be a block + ;; end token; likewise, if we were looking for a block end + ;; token, found-token must be a block begin token, + ;; otherwise there is a grammatical error in the code. (unless (and (or (eq match-type 'middle) (eq found-type 'middle) (eq match-type 'middle-or-open) @@ -958,17 +999,18 @@ DIRECTION has to be either \\='forward or \\='backward." (when maybe-found-pos (goto-char maybe-found-pos) (throw 'found maybe-found-pos))) - ;; yes. - ;; if it is a not a middle kind, report the location + ;; Yes. + ;; If it is a not a middle kind, report the location (unless (or (eq found-type 'middle) (eq found-type 'middle-or-open)) (throw 'found found-pos)) - ;; if it is a middle-or-open type, record location, but keep searching. - ;; If we fail to complete the search, we'll report the location + ;; If it is a middle-or-open type, record location, but keep + ;; searching. If we fail to complete the search, we'll + ;; report the location (when (eq found-type 'middle-or-open) (setq maybe-found-pos found-pos)) - ;; Cannot use tail recursion. too much nesting on long chains of - ;; if/elseif. Will reset variables instead. + ;; Cannot use tail recursion. Too much nesting on long + ;; chains of if/elseif. Will reset variables instead. (setq token found-token) (setq token-info (lua-get-block-token-info token)) (setq match (lua-get-token-match-re token-info search-direction)) @@ -977,11 +1019,13 @@ DIRECTION has to be either \\='forward or \\='backward." (defun lua-goto-matching-block-token (&optional parse-start direction) "Find block begion/end token matching the one at the point. -This function moves the point to the token that matches the one -at the current point. Returns the point position of the first character of -the matching token if successful, nil otherwise. +This function moves the point to the token that matches the one at the +current point. Returns the point position of the first character of the +matching token if successful, nil otherwise. + +Optional PARSE-START is a position to which the point should be moved +first. -Optional PARSE-START is a position to which the point should be moved first. DIRECTION has to be \\='forward or \\='backward (\\='forward by default)." (when parse-start (goto-char parse-start)) (let ((case-fold-search nil)) @@ -995,10 +1039,10 @@ DIRECTION has to be \\='forward or \\='backward (\\='forward by default)." If the point is on a keyword/brace that starts a block, go to the matching keyword that ends the block, and vice versa. -If optional NOREPORT is non-nil, it won't flag an error if there -is no block open/close open." +If optional NOREPORT is non-nil, it won't flag an error if there is no +block open/close open." (interactive) - ;; search backward to the beginning of the keyword if necessary + ;; Search backward to the beginning of the keyword if necessary (when (and (eq (char-syntax (following-char)) ?w) (not (looking-at "\\_<"))) (re-search-backward "\\_<" nil t)) @@ -1033,9 +1077,9 @@ Return non-nil if moved point." (let ((start-pos (point)) (comment-start-pos (lua-comment-start-pos)) (limit (max (point) (or limit (point-max))))) - ;; Escape from current comment. It is necessary to use "while" because - ;; luadoc parameters have non-comment face, and parse-partial-sexp with - ;; 'syntax-table flag will stop on them. + ;; Escape from current comment. It is necessary to use "while" + ;; because luadoc parameters have non-comment face, and + ;; parse-partial-sexp with 'syntax-table flag will stop on them. (when comment-start-pos (goto-char comment-start-pos) (forward-comment 1)) @@ -1044,13 +1088,15 @@ Return non-nil if moved point." (when (/= start-pos (point)) (point))))) (defun lua-forward-line-skip-blanks (&optional back) - "Move 1 line forward/backward and skip all insignificant ws/comment lines. + "Move 1 line forward/backward and skip insignificant ws/comment lines. -Moves point 1 line forward (or backward) skipping lines that contain -no Lua code besides comments. The point is put to the beginning of -the line. +Moves point 1 line forward (or backward) skipping lines that contain no +Lua code besides comments. The point is put to the beginning of the +line. -Returns final value of point as integer or nil if operation failed." +Returns final value of point as integer or nil if operation failed. + +Non-nil argument BACK changes the direction to backwards." (let ((start-pos (point))) (if back (progn @@ -1083,9 +1129,9 @@ Returns final value of point as integer or nil if operation failed." point))) "Regexp that matches the ending of a line that needs continuation. -This regexp starts from eol and looks for a binary operator or an unclosed -block intro (i.e. `for' without `do' or `if' without `then') followed by -an optional whitespace till the end of the line.") +This regexp starts from eol and looks for a binary operator or an +unclosed block intro (i.e. `for' without `do' or `if' without `then') +followed by an optional whitespace till the end of the line.") (defconst lua-cont-bol-regexp (eval-when-compile @@ -1102,10 +1148,11 @@ an optional whitespace till the end of the line.") (or eol (not (any ,lua-operator-class)))))))) "Regexp that matches a line that continues previous one. -This regexp means, starting from point there is an optional whitespace followed -by Lua binary operator. Lua is very liberal when it comes to continuation line, -so we're safe to assume that every line that starts with a binop continues -previous one even though it looked like an end-of-statement.") +This regexp means, starting from point there is an optional whitespace +followed by Lua binary operator. Lua is very liberal when it comes to +continuation line, so we're safe to assume that every line that starts +with a binop continues previous one even though it looked like an +end-of-statement.") (defun lua-last-token-continues-p () "Return non-nil if the last token on this line is a continuation token." @@ -1133,7 +1180,8 @@ previous one even though it looked like an end-of-statement.") ;; function() return 123 end ;; (looking-at (lua-rx (symbol "function"))) - ;; Looking at semicolon or any other keyword: not continuation + ;; Looking at semicolon or any other keyword: not + ;; continuation (not (looking-at (lua-rx (or ";" lua-keyword))))))) (setq return-value nil))) return-value))) @@ -1144,9 +1192,10 @@ previous one even though it looked like an end-of-statement.") (save-excursion (beginning-of-line) (lua-skip-ws-and-comments-forward line-end) - ;; if first character of the line is inside string, it's a continuation - ;; if strings aren't supposed to be indented, `lua-calculate-indentation' won't even let - ;; the control inside this function + ;; If first character of the line is inside string, it's a + ;; continuation if strings aren't supposed to be indented, + ;; `lua-calculate-indentation' won't even let the control inside + ;; this function (and (re-search-forward lua-cont-bol-regexp line-end t) (or (match-beginning 1) @@ -1159,7 +1208,7 @@ previous one even though it looked like an end-of-statement.") (scan-error nil))) (defun lua-backward-up-list () - "Goto starter/opener of the block that contains point." + "Goto starter/opener of the block containing point." (interactive) (let ((start-pos (point)) end-pos) @@ -1218,35 +1267,37 @@ The criteria for a continuing statement are: ;; Binary operator or keyword that implies continuation. (and (setq continuation-pos (or (lua-first-token-continues-p) - (save-excursion (and (goto-char prev-line) - ;; check last token of previous nonblank line - (lua-last-token-continues-p))))) + (save-excursion + (and (goto-char prev-line) + ;; Check last token of previous nonblank line + (lua-last-token-continues-p))))) (not - ;; Operators/keywords does not create continuation inside some blocks: - (and - (setq parent-block-opener (car-safe (lua--backward-up-list-noerror))) - (or - ;; - inside parens/brackets - (member parent-block-opener '("(" "[")) - ;; - inside braces if it is a comma - (and (eq (char-after continuation-pos) ?,) - (equal parent-block-opener "{"))))) + ;; Operators/keywords does not create continuation + ;; inside some blocks: + (and (setq parent-block-opener + (car-safe (lua--backward-up-list-noerror))) + (or + ;; Inside parens/brackets + (member parent-block-opener '("(" "[")) + ;; Inside braces if it is a comma + (and (eq (char-after continuation-pos) ?,) + (equal parent-block-opener "{"))))) continuation-pos)))))) (defun lua-is-continuing-statement-p (&optional parse-start) - "Returns non-nil if the line at PARSE-START should be indented as continuation line. + "Return non-nil if PARSE-START should be indented as continuation line. -This true is when the line : +This true is when the line: -* is continuing a statement itself +* Is continuing a statement itself -* starts with a 1+ block-closer tokens, an top-most block opener is on a continuation line -" +* Starts with a 1+ block-closer tokens, an top-most block opener is on a + continuation line." (save-excursion (when parse-start (goto-char parse-start)) - ;; If line starts with a series of closer tokens, whether or not the line - ;; is a continuation line is decided by the opener line, e.g. + ;; If line starts with a series of closer tokens, whether or not the + ;; line is a continuation line is decided by the opener line, e.g. ;; ;; x = foo + ;; long_function_name( @@ -1260,15 +1311,16 @@ This true is when the line : ;; }) ;; ;; Final line, "})" is a continuation line, but it is decided by the - ;; opener line, ") + long_function_name2({", which in its turn is decided - ;; by the "long_function_name(" line, which is a continuation line - ;; because the line before it ends with a binary operator. + ;; opener line, ") + long_function_name2({", which in its turn is + ;; decided by the "long_function_name(" line, which is a + ;; continuation line because the line before it ends with a binary + ;; operator. (cl-loop ;; Go to opener line while (and (lua--goto-line-beginning-rightmost-closer) (lua--backward-up-list-noerror)) - ;; If opener line is continuing, repeat. If opener line is not - ;; continuing, return nil. + ;; If opener line is continuing, repeat. If opener line is not + ;; Continuing, return nil. always (lua-is-continuing-statement-p-1) ;; We get here if there was no opener to go to: check current line. finally return (lua-is-continuing-statement-p-1)))) @@ -1279,37 +1331,39 @@ This true is when the line : This is a helper function to lua-calculate-indentation-info. Don't use standalone." (cond - ;; function is a bit tricky to indent right. They can appear in a lot ot - ;; different contexts. Until I find a shortcut, I'll leave it with a simple - ;; relative indentation. - ;; The special cases are for indenting according to the location of the - ;; function. i.e.: - ;; (cons 'absolute (+ (current-column) lua-indent-level)) - ;; TODO: Fix this. It causes really ugly indentations for in-line functions. + ;; Functions are a bit tricky to indent right. They can appear in a + ;; lot ot different contexts. Until I find a shortcut, I'll leave it + ;; with a simple relative indentation. + ;; The special cases are for indenting according to the location of + ;; the function. i.e.: + ;; (cons 'absolute (+ (current-column) lua-indent-level)) + ;; TODO: Fix this. It causes really ugly indentations for in-line + ;; functions. ((string-equal found-token "function") (cons 'relative lua-indent-level)) - ;; block openers + ;; Block openers ((and lua-indent-nested-block-content-align (member found-token (list "{" "(" "["))) (save-excursion (let ((found-bol (line-beginning-position))) (forward-comment (point-max)) - ;; If the next token is on this line and it's not a block opener, - ;; the next line should align to that token. + ;; If the next token is on this line and it's not a block + ;; opener, the next line should align to that token. (if (and (zerop (count-lines found-bol (line-beginning-position))) (not (looking-at lua-indentation-modifier-regexp))) (cons 'absolute (current-column)) (cons 'relative lua-indent-level))))) - ;; These are not really block starters. They should not add to indentation. - ;; The corresponding "then" and "do" handle the indentation. + ;; These are not really block starters. They should not add to + ;; indentation. The corresponding "then" and "do" handle the + ;; indentation. ((member found-token (list "if" "for" "while")) (cons 'relative 0)) ;; closing tokens follow: These are usually taken care of by ;; lua-calculate-indentation-override. - ;; elseif is a bit of a hack. It is not handled separately, but it needs to - ;; nullify a previous then if on the same line. + ;; elseif is a bit of a hack. It is not handled separately, but it + ;; needs to nullify a previous then if on the same line. ((member found-token (list "until" "elseif")) (save-excursion (let* ((line-beginning (line-beginning-position)) @@ -1319,10 +1373,10 @@ Don't use standalone." (cons 'remove-matching 0) (cons 'relative 0))))) - ;; else is a special case; if its matching block token is on the same line, - ;; instead of removing the matching token, it has to replace it, so that - ;; either the next line will be indented correctly, or the end on the same - ;; line will remove the effect of the else. + ;; else is a special case; if its matching block token is on the same + ;; line, instead of removing the matching token, it has to replace + ;; it, so that either the next line will be indented correctly, or + ;; the end on the same line will remove the effect of the else. ((string-equal found-token "else") (save-excursion (let* ((line-beginning (line-beginning-position)) @@ -1332,9 +1386,9 @@ Don't use standalone." (cons 'replace-matching (cons 'relative lua-indent-level)) (cons 'relative lua-indent-level))))) - ;; Block closers. If they are on the same line as their openers, they simply - ;; eat up the matching indentation modifier. Otherwise, they pull - ;; indentation back to the matching block opener. + ;; Block closers. If they are on the same line as their openers, + ;; they simply eat up the matching indentation modifier. Otherwise, + ;; they pull indentation back to the matching block opener. ((member found-token (list ")" "}" "]" "end")) (save-excursion (let* ((line-beginning (line-beginning-position)) @@ -1348,69 +1402,75 @@ Don't use standalone." (setq opener-continuation-offset (if (lua-is-continuing-statement-p-1) lua-indent-level 0)) - ;; Accumulate indentation up to opener, including indentation. If - ;; there were no other indentation modifiers until said opener, - ;; ensure there is no continuation after the closer. - `(multiple . ((absolute . ,(- (current-indentation) opener-continuation-offset)) + ;; Accumulate indentation up to opener, including indentation. + ;; If there were no other indentation modifiers until said + ;; opener, ensure there is no continuation after the closer. + `(multiple . ((absolute . ,(- (current-indentation) + opener-continuation-offset)) ,@(when (/= opener-continuation-offset 0) - (list (cons 'continued-line opener-continuation-offset))) - ,@(delete nil (list (lua-calculate-indentation-info-1 nil opener-pos))) + (list (cons 'continued-line + opener-continuation-offset))) + ,@(delete nil (list (lua-calculate-indentation-info-1 + nil opener-pos))) (cancel-continued-line . nil))))))) ((member found-token '("do" "then")) `(multiple . ((cancel-continued-line . nil) (relative . ,lua-indent-level)))) - ;; Everything else. This is from the original code: If opening a block - ;; (match-data 1 exists), then push indentation one level up, if it is - ;; closing a block, pull it one level down. + ;; Everything else. This is from the original code: If opening a + ;; block (match-data 1 exists), then push indentation one level up, + ;; if it is closing a block, pull it one level down. ('other-indentation-modifier (cons 'relative (if (nth 2 (match-data)) - ;; beginning of a block matched + ;; Beginning of a block matched lua-indent-level - ;; end of a block matched + ;; End of a block matched (- lua-indent-level)))))) (defun lua-add-indentation-info-pair (pair info-list) - "Add the given indentation info PAIR to the list of indentation INFO-LIST. + "Add the indentation info PAIR to the list of indentation INFO-LIST. This function has special case handling for two tokens: remove-matching, -and replace-matching. These two tokens are cleanup tokens that remove or -alter the effect of a previously recorded indentation info. +and replace-matching. These two tokens are cleanup tokens that remove +or alter the effect of a previously recorded indentation info. -When a remove-matching token is encountered, the last recorded info, i.e. -the car of the list is removed. This is used to roll-back an indentation of a -block opening statement when it is closed. +When a remove-matching token is encountered, the last recorded info, +i.e. the car of the list is removed. This is used to roll-back an +indentation of a block opening statement when it is closed. -When a replace-matching token is seen, the last recorded info is removed, -and the cdr of the replace-matching info is added in its place. This is used -when a middle-of the block (the only case is `else') is seen on the same line -the block is opened." +When a replace-matching token is seen, the last recorded info is +removed, and the cdr of the replace-matching info is added in its place. +This is used when a middle-of the block (the only case is `else') is +seen on the same line the block is opened." (cond - ( (eq 'multiple (car pair)) + ((eq 'multiple (car pair)) (let ((info-pair-elts (cdr pair))) (while info-pair-elts - (setq info-list (lua-add-indentation-info-pair (car info-pair-elts) info-list) + (setq info-list (lua-add-indentation-info-pair + (car info-pair-elts) info-list) info-pair-elts (cdr info-pair-elts))) info-list)) - ( (eq 'cancel-continued-line (car pair)) + ((eq 'cancel-continued-line (car pair)) (if (eq (caar info-list) 'continued-line) (cdr info-list) info-list)) - ( (eq 'remove-matching (car pair)) + ((eq 'remove-matching (car pair)) ;; Remove head of list (cdr info-list)) - ( (eq 'replace-matching (car pair)) - ;; remove head of list, and add the cdr of pair instead + ((eq 'replace-matching (car pair)) + ;; Remove head of list, and add the cdr of pair instead (cons (cdr pair) (cdr info-list))) - ( (listp (cdr-safe pair)) + ((listp (cdr-safe pair)) (nconc pair info-list)) - ( t + (t ;; Just add the pair (cons pair info-list)))) (defun lua-calculate-indentation-info-1 (indentation-info bound) "Helper function for `lua-calculate-indentation-info'. -Return list of indentation modifiers from point to BOUND." +Return list of indentation modifiers from point to BOUND. + +The argument INDENTATION-INFO is an indentation INFO-LIST." (while (lua-find-regexp 'forward lua-indentation-modifier-regexp bound) (let ((found-token (match-string 0)) @@ -1422,18 +1482,20 @@ Return list of indentation modifiers from point to BOUND." indentation-info) (defun lua-calculate-indentation-info (&optional parse-end) - "For each block token on the line, computes how it affects the indentation. + "Compute how each block token on the line affects indentation. The effect of each token can be either a shift relative to the current -indentation level, or indentation to some absolute column. This information -is collected in a list of indentation info pairs, which denote absolute -and relative each, and the shift/column to indent to." +indentation level, or indentation to some absolute column. This +information is collected in a list of indentation info pairs, which +denote absolute and relative each, and the shift/column to indent to. + +The argument PARSE-END is a buffer position that bounds the calculation." (let (indentation-info cont-stmt-pos) (while (setq cont-stmt-pos (lua-is-continuing-statement-p)) (lua-forward-line-skip-blanks 'back) (when (< cont-stmt-pos (point)) (goto-char cont-stmt-pos))) - ;; calculate indentation modifiers for the line itself + ;; Calculate indentation modifiers for the line itself (setq indentation-info (list (cons 'absolute (current-indentation)))) (back-to-indentation) @@ -1441,21 +1503,21 @@ and relative each, and the shift/column to indent to." (lua-calculate-indentation-info-1 indentation-info (min parse-end (line-end-position)))) - ;; and do the following for each continuation line before PARSE-END + ;; And do the following for each continuation line before PARSE-END (while (and (eql (forward-line 1) 0) (<= (point) parse-end)) - ;; handle continuation lines: + ;; Handle continuation lines: (if (lua-is-continuing-statement-p) - ;; if it's the first continuation line, add one level + ;; If it's the first continuation line, add one level (unless (eq (car (car indentation-info)) 'continued-line) (push (cons 'continued-line lua-indent-level) indentation-info)) - ;; if it's the first non-continued line, subtract one level + ;; If it's the first non-continued line, subtract one level (when (eq (car (car indentation-info)) 'continued-line) (push (cons 'stop-continued-line (- lua-indent-level)) indentation-info))) - ;; add modifiers found in this continuation line + ;; Add modifiers found in this continuation line (setq indentation-info (lua-calculate-indentation-info-1 indentation-info (min parse-end (line-end-position))))) @@ -1463,9 +1525,11 @@ and relative each, and the shift/column to indent to." indentation-info)) (defun lua-accumulate-indentation-info (reversed-indentation-info) - "Accumulates the indentation information previously calculated by -lua-calculate-indentation-info. Returns either the relative indentation -shift, or the absolute column to indent to." + "Accumulate indent information from lua-calculate-indentation-info. +Returns either the relative indentation shift, or the absolute column to +indent to. + +The argument REVERSED-INDENTATION-INFO is an indentation INFO-LIST." (let (indentation-info (type 'relative) (accu 0)) @@ -1489,10 +1553,11 @@ shift, or the absolute column to indent to." (defun lua-calculate-indentation-block-modifier (&optional parse-end) "Return amount by which this line modifies the indentation. -Beginnings of blocks add lua-indent-level once each, and endings -of blocks subtract lua-indent-level once each. This function is used -to determine how the indentation of the following line relates to this -one." +Beginnings of blocks add lua-indent-level once each, and endings of +blocks subtract lua-indent-level once each. This function is used to +determine how the indentation of the following line relates to this one. + +The argument PARSE-END is a buffer position that bounds the calculation." (let (indentation-info) (save-excursion ;; First go back to the line that starts it all @@ -1519,17 +1584,16 @@ one." (eval-when-compile (rx ;; This regexp should answer the following questions: - ;; 1. is there a left shifter regexp on that line? - ;; 2. where does block-open token of that left shifter reside? + ;; 1. Is there a left shifter regexp on that line? + ;; 2. Where does block-open token of that left shifter reside? (or (seq (group-n 1 symbol-start "local" (+ blank)) "function" symbol-end) - (seq (group-n 1 (eval lua--function-name-rx) (* blank)) (any "{(")) (seq (group-n 1 (or - ;; assignment statement prefix + ;; Assignment statement prefix (seq (* nonl) (not (any "<=>~")) "=" (* blank)) - ;; return statement prefix + ;; Return statement prefix (seq word-start "return" word-end (* blank)))) - ;; right hand side + ;; Right hand side (or "{" "function" "(" @@ -1538,10 +1602,10 @@ one." "Regular expression that matches left-shifter expression. -Left-shifter expression is defined as follows. If a block -follows a left-shifter expression, its contents & block-close -token should be indented relative to left-shifter expression -indentation rather then to block-open token. +Left-shifter expression is defined as follows. If a block follows a +left-shifter expression, its contents & block-close token should be +indented relative to left-shifter expression indentation rather then to +block-open token. For example: -- `local a = ' is a left-shifter expression @@ -1563,8 +1627,8 @@ The following left-shifter expressions are currently handled: (defun lua-point-is-after-left-shifter-p () "Check if point is right after a left-shifter expression. -See `lua--left-shifter-regexp' for description & example of -left-shifter expression. " +See `lua--left-shifter-regexp' for description & example of left-shifter +expression." (save-excursion (let ((old-point (point))) (back-to-indentation) @@ -1574,6 +1638,8 @@ left-shifter expression. " (= old-point (match-end 1)))))) (defun lua--goto-line-beginning-rightmost-closer (&optional parse-start) + "Move point to the opening of the rightmost closing bracket at point. +The argument PARSE-START is a buffer position to start from." (let (case-fold-search pos line-end-pos return-val) (save-excursion (when parse-start (goto-char parse-start)) @@ -1597,12 +1663,14 @@ left-shifter expression. " (defun lua-calculate-indentation-override (&optional parse-start) "Return overriding indentation amount for special cases. -If there's a sequence of block-close tokens starting at the -beginning of the line, calculate indentation according to the -line containing block-open token for the last block-close token -in the sequence. +If there's a sequence of block-close tokens starting at the beginning of +the line, calculate indentation according to the line containing +block-open token for the last block-close token in the sequence. -If not, return nil." +If not, return nil. + +Optional PARSE-START is a position to which the point should be moved +first." (let (case-fold-search rightmost-closer-info opener-info opener-pos) (save-excursion (when (and (setq rightmost-closer-info (lua--goto-line-beginning-rightmost-closer parse-start)) @@ -1612,9 +1680,10 @@ If not, return nil." (car opener-info))) ;; Special case: "middle" tokens like for/do, while/do, if/then, - ;; elseif/then: corresponding "end" or corresponding "else" must be - ;; unindented to the beginning of the statement, which is not - ;; necessarily the same as beginning of string that contains "do", e.g. + ;; elseif/then: corresponding "end" or corresponding "else" must + ;; be unindented to the beginning of the statement, which is not + ;; necessarily the same as beginning of string that contains + ;; "do", e.g. ;; ;; while ( ;; foo and @@ -1625,16 +1694,19 @@ If not, return nil." (when (/= (- opener-pos (line-beginning-position)) (current-indentation)) (unless (or (and (string-equal (car opener-info) "do") - (member (car (lua--backward-up-list-noerror)) '("while" "for"))) + (member (car (lua--backward-up-list-noerror)) + '("while" "for"))) (and (string-equal (car opener-info) "then") - (member (car (lua--backward-up-list-noerror)) '("if" "elseif")))) + (member (car (lua--backward-up-list-noerror)) + '("if" "elseif")))) (goto-char opener-pos))) ;; (let (cont-stmt-pos) ;; (while (setq cont-stmt-pos (lua-is-continuing-statement-p)) ;; (goto-char cont-stmt-pos))) ;; Exception cases: when the start of the line is an assignment, - ;; go to the start of the assignment instead of the matching item + ;; go to the start of the assignment instead of the matching + ;; item (if (and lua-indent-close-paren-align (member (car opener-info) '("{" "(" "[")) (not (lua-point-is-after-left-shifter-p))) @@ -1646,14 +1718,15 @@ If not, return nil." (save-excursion (let ((cur-line-begin-pos (line-beginning-position))) (or - ;; when calculating indentation, do the following: - ;; 1. check, if the line starts with indentation-modifier (open/close brace) - ;; and if it should be indented/unindented in special way + ;; When calculating indentation, do the following: + ;; 1. check, if the line starts with indentation-modifier + ;; (open/close brace) and if it should be indented/unindented + ;; in special way (lua-calculate-indentation-override) (when (lua-forward-line-skip-blanks 'back) - ;; the order of function calls here is important. block modifier - ;; call may change the point to another line + ;; The order of function calls here is important. block + ;; modifier call may change the point to another line (let* ((modifier (lua-calculate-indentation-block-modifier cur-line-begin-pos))) (+ (current-indentation) modifier))) @@ -1668,8 +1741,8 @@ If not, return nil." (defun lua-beginning-of-proc (&optional arg) "Move backward to the beginning of a Lua proc (or similar). -With argument, do it that many times. Negative arg -N -means move forward to Nth following beginning of proc. +With argument ARG, do it that many times. Negative ARG -N means move +forward to Nth following beginning of proc. Returns t unless search stops due to beginning or end of buffer." (interactive "P") @@ -1688,7 +1761,8 @@ Returns t unless search stops due to beginning or end of buffer." (defun lua-end-of-proc (&optional arg) "Move forward to next end of Lua proc (or similar). -With argument, do it that many times. Negative argument -N means move + +With argument ARG, do it that many times. Negative ARG -N means move back to Nth preceding end of proc. This function just searches for a `end' at the beginning of a line." @@ -1739,7 +1813,7 @@ This function just searches for a `end' at the beginning of a line." " ")) (defun lua-make-lua-string (str) - "Convert string to Lua literal." + "Convert STR to Lua literal." (save-match-data (with-temp-buffer (insert str) @@ -1761,13 +1835,18 @@ This function just searches for a `end' at the beginning of a line." (defun lua-start-process (&optional name program startfile &rest switches) "Start a Lua process named NAME, running PROGRAM. PROGRAM defaults to NAME, which defaults to `lua-default-application'. -When called interactively, switch to the process buffer." +When called interactively, switch to the process buffer. + +STARTFILE is the name of a file, whose contents are sent to the process +as its initial input. + +SWITCHES is a list of strings passed as arguments to PROGRAM." (interactive) (setq name (or name (if (consp lua-default-application) (car lua-default-application) lua-default-application))) (setq program (or program lua-default-application)) - ;; don't re-initialize if there already is a lua process + ;; Don't re-initialize if there already is a lua process (unless (comint-check-proc (format "*%s*" name)) (setq lua-process-buffer (apply #'make-comint name program startfile (or switches lua-default-command-switches))) @@ -1778,14 +1857,14 @@ When called interactively, switch to the process buffer." (compilation-shell-minor-mode 1) (setq-local comint-prompt-regexp lua-prompt-regexp) - ;; Don't send initialization code until seeing the prompt to ensure that - ;; the interpreter is ready. + ;; Don't send initialization code until seeing the prompt to + ;; ensure that the interpreter is ready. (while (not (lua-prompt-line)) (accept-process-output (get-buffer-process (current-buffer))) (goto-char (point-max))) (lua-send-string lua-process-init-code))) - ;; when called interactively, switch to process buffer + ;; When called interactively, switch to process buffer (when (called-interactively-p 'any) (switch-to-buffer lua-process-buffer))) @@ -1802,12 +1881,12 @@ When called interactively, switch to the process buffer." (setq lua-process-buffer nil))) (defun lua-set-lua-region-start (&optional arg) - "Set start of region for use with `lua-send-lua-region'." + "Set start of region for `lua-send-lua-region' to point or ARG." (interactive) (set-marker lua-region-start (or arg (point)))) (defun lua-set-lua-region-end (&optional arg) - "Set end of region for use with `lua-send-lua-region'." + "Set end of region for `lua-send-lua-region' to point or ARG." (interactive) (set-marker lua-region-end (or arg (point)))) @@ -1826,14 +1905,14 @@ If `lua-process' is nil or dead, start a new process first." (lua-send-region (line-beginning-position) (line-end-position))) (defun lua-send-defun (pos) - "Send the function definition around point to the Lua process." + "Send the function definition around POS to the Lua process." (interactive "d") (save-excursion (let ((start (if (save-match-data (looking-at "^function[ \t]")) - ;; point already at the start of "function". - ;; We need to handle this case explicitly since - ;; lua-beginning-of-proc will move to the - ;; beginning of the _previous_ function. + ;; point already at the start of "function". We + ;; need to handle this case explicitly since + ;; lua-beginning-of-proc will move to the beginning + ;; of the _previous_ function. (point) ;; point is not at the beginning of function, move ;; there and bind start to that position @@ -1841,18 +1920,18 @@ If `lua-process' is nil or dead, start a new process first." (point))) (end (progn (lua-end-of-proc) (point)))) - ;; make sure point is in a function definition before sending to + ;; Make sure point is in a function definition before sending to ;; the process (if (and (>= pos start) (< pos end)) (lua-send-region start end) (error "Not on a function definition"))))) (defun lua-maybe-skip-shebang-line (start) - "Skip shebang (#!/path/to/interpreter/) line at beginning of buffer. + "Skip interpreter line at beginning of buffer. Return a position that is after Lua-recognized shebang line (1st -character in file must be ?#) if START is at its beginning. -Otherwise, return START." +character in file must be #) if START is at its beginning. Otherwise, +return START." (save-restriction (widen) (if (and (eq start (point-min)) @@ -1864,14 +1943,16 @@ Otherwise, return START." start))) (defun lua-send-region (start end) + "Send region between START and END to the inferior Lua process." (interactive "r") (setq start (lua-maybe-skip-shebang-line start)) (let* ((lineno (line-number-at-pos start)) (lua-file (or (buffer-file-name) (buffer-name))) (region-str (buffer-substring-no-properties start end)) (command - ;; Print empty line before executing the code so that the first line - ;; of output doesn't end up on the same line as current prompt. + ;; Print empty line before executing the code so that the + ;; first line of output doesn't end up on the same line as + ;; current prompt. (format "print(''); luamode_loadstring(%s, %s, %s);\n" (lua-make-lua-string region-str) (lua-make-lua-string lua-file) @@ -1880,6 +1961,7 @@ Otherwise, return START." (when lua-always-show (lua-show-process-buffer)))) (defun lua-prompt-line () + "Return non-nil if the inferior Lua process prompt is available." (save-excursion (save-match-data (forward-line 0) @@ -1890,7 +1972,7 @@ Otherwise, return START." "Send preset Lua region to Lua process." (interactive) (unless (and lua-region-start lua-region-end) - (error "lua-region not set")) + (error "Region not set")) (lua-send-region lua-region-start lua-region-end)) (defalias 'lua-send-proc 'lua-send-defun) @@ -1920,7 +2002,7 @@ Create a Lua process if one doesn't already exist." (defun lua--funcname-char-p (c) "Check if character C is part of a function name. -Return nil if C is nil. See `lua-funcname-at-point'." +Return nil if C is nil. See `lua-funcname-at-point'." (and c (string-match-p "\\`[A-Za-z_.]\\'" (string c)))) (defun lua-funcname-at-point () @@ -1930,8 +2012,8 @@ Return nil if C is nil. See `lua-funcname-at-point'." (save-excursion (save-match-data (re-search-backward "\\`\\|[^A-Za-z_.]") - ;; NOTE: `point' will be either at the start of the buffer or on a - ;; non-symbol character. + ;; NOTE: `point' will be either at the start of the buffer or on + ;; a non-symbol character. (re-search-forward "\\([A-Za-z_]+\\(?:\\.[A-Za-z_]+\\)*\\)") (match-string-no-properties 1))))) @@ -1955,7 +2037,8 @@ left out." (message "%S" lua-electric-flag)) (defun lua-forward-sexp (&optional count) - "Forward to block end" + "Forward to block end. +A positive integer argument COUNT means to forward that many times." (interactive "p") (unless (or (not count) (>= count 0)) (error "Negative offsets not supported")) @@ -1963,7 +2046,7 @@ left out." (let ((count (or count 1)) (block-start (mapcar 'car lua-sexp-alist))) (while (> count 0) - ;; skip whitespace + ;; Skip whitespace (skip-chars-forward " \t\n") (if (looking-at (regexp-opt block-start 'words)) (let ((keyword (match-string 1))) From c042611106edecd7b29fb26d7c601cdec0003e22 Mon Sep 17 00:00:00 2001 From: john muhl Date: Fri, 21 Mar 2025 12:12:26 -0500 Subject: [PATCH 084/158] Add warn to 'lua-mode' builtins * lisp/progmodes/lua-mode.el (lua--builtins): Include warn. --- lisp/progmodes/lua-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index ce4a1744d9f..f8d9ed98f1a 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -334,7 +334,7 @@ traceback location." "getmetatable" "ipairs" "load" "loadfile" "loadstring" "module" "next" "pairs" "pcall" "print" "rawequal" "rawget" "rawlen" "rawset" "require" "select" "setfenv" "setmetatable" "tonumber" "tostring" - "type" "unpack" "xpcall" "self" + "type" "unpack" "xpcall" "self" "warn" ("bit32" . ("arshift" "band" "bnot" "bor" "btest" "bxor" "extract" "lrotate" "lshift" "replace" "rrotate" "rshift")) ("coroutine" . ("create" "isyieldable" "resume" "running" "status" From 38a07757425c711e037c526f2c76d342a81e7c17 Mon Sep 17 00:00:00 2001 From: john muhl Date: Fri, 21 Mar 2025 12:13:36 -0500 Subject: [PATCH 085/158] * etc/NEWS: Mention 'lua-mode' merge. --- etc/NEWS | 3 +++ 1 file changed, 3 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 25304922e57..758b7d4fa93 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2677,6 +2677,9 @@ A major mode based on the tree-sitter library for editing "go.work" files. If tree-sitter is properly set-up by the user, it can be enabled for files named "go.work". +** New package 'lua-mode'. +The 'lua-mode' package from Non-GNU ELPA is now included in Emacs. + * Incompatible Lisp Changes in Emacs 31.1 From c5656af2ff5f2ee4a683540db792ccece6db4e43 Mon Sep 17 00:00:00 2001 From: john muhl Date: Fri, 21 Mar 2025 12:15:02 -0500 Subject: [PATCH 086/158] ; Add tests for 'lua-mode' * test/lisp/progmodes/lua-mode-resources/font-lock.lua: * test/lisp/progmodes/lua-mode-resources/hide-show.lua: * test/lisp/progmodes/lua-mode-resources/indent.erts: * test/lisp/progmodes/lua-mode-resources/movement.erts: * test/lisp/progmodes/lua-mode-resources/which-function.lua: * test/lisp/progmodes/lua-mode-tests.el: New file. --- .../lua-mode-resources/font-lock.lua | 184 +++ .../lua-mode-resources/hide-show.lua | 35 + .../progmodes/lua-mode-resources/indent.erts | 1061 +++++++++++++++++ .../lua-mode-resources/movement.erts | 637 ++++++++++ .../lua-mode-resources/which-function.lua | 3 + test/lisp/progmodes/lua-mode-tests.el | 60 + 6 files changed, 1980 insertions(+) create mode 100644 test/lisp/progmodes/lua-mode-resources/font-lock.lua create mode 100644 test/lisp/progmodes/lua-mode-resources/hide-show.lua create mode 100644 test/lisp/progmodes/lua-mode-resources/indent.erts create mode 100644 test/lisp/progmodes/lua-mode-resources/movement.erts create mode 100644 test/lisp/progmodes/lua-mode-resources/which-function.lua create mode 100644 test/lisp/progmodes/lua-mode-tests.el diff --git a/test/lisp/progmodes/lua-mode-resources/font-lock.lua b/test/lisp/progmodes/lua-mode-resources/font-lock.lua new file mode 100644 index 00000000000..bcf77b632c2 --- /dev/null +++ b/test/lisp/progmodes/lua-mode-resources/font-lock.lua @@ -0,0 +1,184 @@ +#!/usr/bin/env lua +-- ^ font-lock-comment-face +-- Comment +-- <- font-lock-comment-delimiter-face +-- ^ font-lock-comment-face +--[[ +-- ^ font-lock-comment-face +Multi-line comment +-- ^ font-lock-comment-face +]] +-- <- font-lock-comment-face +local line_comment = "comment" -- comment +-- ^ font-lock-comment-face + +-- Definition +local function f1() end +-- ^ font-lock-function-name-face +local f2 = function() end +-- ^ font-lock-function-name-face +local tb = { f1 = function() end } +-- ^ font-lock-function-name-face +function tb.f2() end +-- ^ font-lock-function-name-face +function tb:f3() end +-- ^ font-lock-function-name-face +tbl.f4 = function() end +-- ^ font-lock-function-name-face +function x.y:z() end +-- ^ font-lock-function-name-face + +-- Keyword +if true then +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +elseif true then +-- <- font-lock-keyword-face +else end +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +local p = {} +-- ^ font-lock-keyword-face +for k,v in pairs({}) do end +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +repeat if true then break end until false +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +-- ^ font-lock-keyword-face +while true do end +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +function fn() return true end +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +goto label1 +-- ^ font-lock-keyword-face +::label1:: +if true and not false or nil then +-- ^ font-lock-keyword-face +-- ^ font-lock-keyword-face +-- ^ font-lock-keyword-face +end + +-- String +local _ +_ = "x" +-- ^ font-lock-string-face +_ = 'x' +-- ^ font-lock-string-face +_ = "x\ty" +-- ^ font-lock-string-face +-- ^ font-lock-string-face +_ = "x\"y" +-- ^ font-lock-string-face +-- ^ font-lock-string-face +_ = 'x\'y' +-- ^ font-lock-string-face +-- ^ font-lock-string-face +_ = "x\z + y" +-- ^ font-lock-string-face +_ = "x\0900y" +-- ^ font-lock-string-face +_ = "x\09y" +-- ^ font-lock-string-face +_ = "x\0y" +-- ^ font-lock-string-face +_ = "x\u{1f602}y" +-- ^ font-lock-string-face +_ = [[x]] +-- ^ font-lock-string-face +_ = [=[x]=] +-- ^ font-lock-string-face + +-- Assignment +local n = 0 +-- ^ font-lock-variable-name-face +for i=0,9 do end +-- ^ font-lock-variable-name-face + +-- Constant +::label2:: +-- ^ font-lock-constant-face +goto label2 +-- ^ font-lock-constant-face + +-- Builtin +assert() +-- <- font-lock-builtin-face +bit32() +-- <- font-lock-builtin-face +collectgarbage() +-- <- font-lock-builtin-face +coroutine() +-- <- font-lock-builtin-face +debug() +-- <- font-lock-builtin-face +dofile() +-- <- font-lock-builtin-face +error() +-- <- font-lock-builtin-face +getmetatable() +-- <- font-lock-builtin-face +io() +-- <- font-lock-builtin-face +ipairs() +-- <- font-lock-builtin-face +load() +-- <- font-lock-builtin-face +loadfile() +-- <- font-lock-builtin-face +math() +-- <- font-lock-builtin-face +next() +-- <- font-lock-builtin-face +os() +-- <- font-lock-builtin-face +package() +-- <- font-lock-builtin-face +pairs() +-- <- font-lock-builtin-face +pcall() +-- <- font-lock-builtin-face +print() +-- <- font-lock-builtin-face +rawequal() +-- <- font-lock-builtin-face +rawget() +-- <- font-lock-builtin-face +rawlen() +-- <- font-lock-builtin-face +rawset() +-- <- font-lock-builtin-face +require() +-- <- font-lock-builtin-face +select() +-- <- font-lock-builtin-face +setmetatable() +-- <- font-lock-builtin-face +string() +-- <- font-lock-builtin-face +table() +-- <- font-lock-builtin-face +tonumber() +-- <- font-lock-builtin-face +tostring() +-- <- font-lock-builtin-face +type() +-- <- font-lock-builtin-face +utf8() +-- <- font-lock-builtin-face +warn() +-- <- font-lock-builtin-face +xpcall() +-- <- font-lock-builtin-face +print(_G) +-- ^ font-lock-builtin-face +print(_VERSION) +-- ^ font-lock-builtin-face + +-- Variable +function fn(x, y) end +-- ^ font-lock-variable-name-face +-- ^ font-lock-variable-name-face diff --git a/test/lisp/progmodes/lua-mode-resources/hide-show.lua b/test/lisp/progmodes/lua-mode-resources/hide-show.lua new file mode 100644 index 00000000000..a23b46437bf --- /dev/null +++ b/test/lisp/progmodes/lua-mode-resources/hide-show.lua @@ -0,0 +1,35 @@ +--[[ +This is a +comment block. +]] +local function fun () + print("fun") +end +local f = (function () + print(1) +end) +for i = 1, 10 do + print(i) +end +repeat + print("repeat") +until false +while true do + print("while") +end +do + print(1) +end +if true then + print(1) +elseif false then + print(0) +else + print(0) +end +function f1 (has, + lots, + of, + parameters) + print("ok") +end diff --git a/test/lisp/progmodes/lua-mode-resources/indent.erts b/test/lisp/progmodes/lua-mode-resources/indent.erts new file mode 100644 index 00000000000..8b4d8dd0921 --- /dev/null +++ b/test/lisp/progmodes/lua-mode-resources/indent.erts @@ -0,0 +1,1061 @@ +Code: + (lambda () + (lua-mode) + (setq-local indent-tabs-mode nil) + (setq-local lua-indent-level 2) + (indent-region (point-min) (point-max))) + +Name: Function Indent 1 + +=-= +function f1(n) +print(n) +return n + 1 +end +=-= +function f1(n) + print(n) + return n + 1 +end +=-=-= + +Name: Function Indent 2 + +=-= +local function f2(n) +print(n) +return n * 2 +end +=-= +local function f2(n) + print(n) + return n * 2 +end +=-=-= + +Name: Function Indent 3 + +=-= +local f3 = function(n) +print(n) +return n / 3 +end +=-= +local f3 = function(n) + print(n) + return n / 3 +end +=-=-= + +Name: Function Indent 4 + +=-= +function f4(...) +local f = function (...) +if ok +then print(1) +else print(0) +end +end +return f +end +=-= +function f4(...) + local f = function (...) + if ok + then print(1) + else print(0) + end + end + return f +end +=-=-= + +Name: Function Indent 5 + +=-= +function f5(...) +local f = function (...) +if ok +then +print(1) +else +print(0) +end +end +return f +end +=-= +function f5(...) + local f = function (...) + if ok + then + print(1) + else + print(0) + end + end + return f +end +=-=-= + +Name: Function Indent 6 + +=-= +function f6(...) +local f = function (...) +if ok then +print(1) +else +print(0) +end +end +return f +end +=-= +function f6(...) + local f = function (...) + if ok then + print(1) + else + print(0) + end + end + return f +end +=-=-= + +Name: Function Indent 7 + +=-= +f7(function() +print'ok' +end) +=-= +f7(function() + print'ok' +end) +=-=-= + +Name: Function Indent 8 + +=-= +;(function () + return true + end)() +=-= +;(function () + return true + end)() +=-=-= + +Name: Conditional Indent 1 + +=-= +if true then +print(true) +return 1 +elseif false then +print(false) +return -1 +else +print(nil) +return 0 +end +=-= +if true then + print(true) + return 1 +elseif false then + print(false) + return -1 +else + print(nil) + return 0 +end +=-=-= + +Name: Conditional Indent 2 + +=-= +if true + then + print(true) + return 1 + elseif false + then + print(false) + return -1 + else + print(nil) + return 0 +end +=-= +if true +then + print(true) + return 1 +elseif false +then + print(false) + return -1 +else + print(nil) + return 0 +end +=-=-= + +Name: Conditional Indent 3 + +=-= +if true + then return 1 + elseif false + then return -1 + else return 0 +end +=-= +if true +then return 1 +elseif false +then return -1 +else return 0 +end +=-=-= + +Name: Loop Indent 1 + +=-= +for k,v in pairs({}) do + print(k) + print(v) +end +=-= +for k,v in pairs({}) do + print(k) + print(v) +end +=-=-= + +Name: Loop Indent 2 + +=-= +for i=1,10 + do print(i) +end +=-= +for i=1,10 +do print(i) +end +=-=-= + +Name: Loop Indent 3 + +=-= +while n < 10 do + n = n + 1 + print(n) +end +=-= +while n < 10 do + n = n + 1 + print(n) +end +=-=-= + +Name: Loop Indent 4 + +=-= +while n < 10 + do + n = n + 1 + print(n) +end +=-= +while n < 10 +do + n = n + 1 + print(n) +end +=-=-= + +Name: Loop Indent 5 + +=-= +for i=0,9 do +repeat n = n+1 + until n > 99 +end +=-= +for i=0,9 do + repeat n = n+1 + until n > 99 +end +=-=-= + +Name: Loop Indent 6 + +=-= +repeat +z = z * 2 +print(z) +until z > 12 +=-= +repeat + z = z * 2 + print(z) +until z > 12 +=-=-= + +Name: Loop Indent 7 + +=-= +for i,x in ipairs(t) do +while i < 9 +do +local n = t[x] +repeat n = n + 1 +until n > #t +while n < 99 +do +print(n) +end +end +print(t[i]) +end +=-= +for i,x in ipairs(t) do + while i < 9 + do + local n = t[x] + repeat n = n + 1 + until n > #t + while n < 99 + do + print(n) + end + end + print(t[i]) +end +=-=-= + +Name: Loop Indent 8 + +=-= +do +local a = b +print(a + 1) +end +=-= +do + local a = b + print(a + 1) +end +=-=-= + +Name: Bracket Indent 1 + +=-= +fn( + ) +=-= +fn( +) +=-=-= + +Name: Bracket Indent 2 + +=-= +tb={ + } +=-= +tb={ +} +=-=-= + +Name: Multi-line String Indent 1 + +=-= +local s = [[ + Multi-line + string content + ]] +=-=-= + +Name: Multi-line String Indent 2 + +=-= +function f() + local str = [[ + multi-line + string + ]] +return true +end +=-= +function f() + local str = [[ + multi-line + string + ]] + return true +end +=-=-= + +Name: Multi-line Comment Indent 1 + +=-= +--[[ + Multi-line + comment content +]] +=-=-= + +Name: Multi-line Comment Indent 2 + +=-= +function f() + --[[ + multi-line + comment + ]] + return true +end +=-=-= + +Name: Multi-line Comment Indent 3 + +=-= + --[[ + Long comment. + ]] +=-=-= + +Name: Comment Indent 1 + +=-= +local fn1 = function (a, b) +-- comment +return a + b +end +=-= +local fn1 = function (a, b) + -- comment + return a + b +end +=-=-= + +Name: Comment Indent 2 + +=-= +local tb1 = { + first = 1, +-- comment + second = 2, +} +=-= +local tb1 = { + first = 1, + -- comment + second = 2, +} +=-=-= + +Name: Comment Indent 3 + +=-= +local tb9 = { one = 1, +-- comment + two = 2 } +=-= +local tb9 = { one = 1, + -- comment + two = 2 } +=-=-= + +Name: Argument Indent 1 + +=-= +h( +"string", +1000 +) +=-= +h( + "string", + 1000 +) +=-=-= + +Name: Argument Indent 2 + +=-= +local p = h( +"string", + 1000 +) +=-= +local p = h( + "string", + 1000 +) +=-=-= + +Name: Argument Indent 3 + +=-= +fn(1, +2, + 3) +=-= +fn(1, + 2, + 3) +=-=-= + +Name: Argument Indent 4 + +=-= +fn( 1, 2, +3, 4 ) +=-= +fn( 1, 2, + 3, 4 ) +=-=-= + +Name: Argument Indent 5 + +=-= +f({ +x = 1, +y = 2, +z = 3, +}) +=-= +f({ + x = 1, + y = 2, + z = 3, +}) +=-=-= + +Name: Argument Indent 6 + +=-= +f({ x = 1, +y = 2, +z = 3, }) +=-= +f({ x = 1, + y = 2, + z = 3, }) +=-=-= + +Name: Argument Indent 7 + +=-= +Test({ +a=1 +}) +=-= +Test({ + a=1 +}) +=-=-= + +Name: Argument Indent 8 + +=-= +Test({ +a = 1, +b = 2, +}, +nil) +=-= +Test({ + a = 1, + b = 2, + }, + nil) +=-=-= + +Name: Argument Indent 9 + +=-= +Test(nil, { + a = 1, + b = 2, + }) +=-= +Test(nil, { + a = 1, + b = 2, +}) +=-=-= + +Name: Argument Indent 10 + +=-= +fn( -- comment + 1, + 2) +=-= +fn( -- comment + 1, + 2) +=-=-= + +Name: Parameter Indent 1 + +=-= +function f1( +a, +b +) +print(a,b) +end +=-= +function f1( + a, + b + ) + print(a,b) +end +=-=-= + +Name: Parameter Indent 2 + +=-= +local function f2(a, + b) +print(a,b) +end +=-= +local function f2(a, + b) + print(a,b) +end +=-=-= + +Name: Parameter Indent 3 + +=-= +local f3 = function( a, b, + c, d ) +print(a,b,c,d) +end +=-= +local f3 = function( a, b, + c, d ) + print(a,b,c,d) +end +=-=-= + +Name: Parameter Indent 4 + +=-= +local f4 = function(-- comment +a, b, c) +=-= +local f4 = function(-- comment + a, b, c) +=-=-= + +Name: Table Indent 1 + +=-= +local Other = { + First={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Second={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Third={up={Goto=true}, + down={Goto=true}, + left={Goto=true}, + right={Goto=true}} +} +=-= +local Other = { + First={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Second={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Third={up={Goto=true}, + down={Goto=true}, + left={Goto=true}, + right={Goto=true}} +} +=-=-= + +Name: Table Indent 2 + +=-= +local Other = { +a = 1, + b = 2, + c = 3, +} +=-= +local Other = { + a = 1, + b = 2, + c = 3, +} +=-=-= + +Name: Table Indent 3 + +=-= +local a = { -- hello world! + b = 10 +} +=-= +local a = { -- hello world! + b = 10 +} +=-=-= + +Name: Continuation Indent 1 + +=-= +local very_long_variable_name = +"ok".. + "ok" +=-= +local very_long_variable_name = + "ok".. + "ok" +=-=-= + +Name: Continuation Indent 2 + +=-= +local n = a + +b * +c / +1 +=-= +local n = a + + b * + c / + 1 +=-=-= + +Name: Continuation Indent 3 + +=-= +local x = "A".. +"B" +.."C" +=-= +local x = "A".. + "B" + .."C" +=-=-= + +Name: Continuation Indent 4 + +=-= +if a + and b + and c then + if x + and y then + local x = 1 + +2 * + 3 + end +elseif a + or b + or c then +end +=-= +if a + and b + and c then + if x + and y then + local x = 1 + + 2 * + 3 + end +elseif a + or b + or c then +end +=-=-= + +Code: + (lambda () + (lua-mode) + (setq-local lua-indent-level 4) + (setq-local indent-tabs-mode nil) + (indent-region (point-min) (point-max))) + +Name: End Indent 1 + +=-= +function f(x) + for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end end end end + return {x,y} or {math.random(),math.random()} + end +=-= +function f(x) + for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end end end end + return {x,y} or {math.random(),math.random()} +end +=-=-= + +Name: End Indent 2 + +=-= +for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end + end end end +=-= +for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end +end end end +=-=-= + +Name: Nested Function Indent 1 + +=-= +function a(...) +return (function (x) +return x +end)(foo(...)) +end +=-= +function a(...) + return (function (x) + return x + end)(foo(...)) +end +=-=-= + +Name: Nested Function Indent 2 + +=-= +function b(n) +local x = 1 +return function (i) +return function (...) +return (function (n, ...) +return function (f, ...) +return (function (...) +if ... and x < 9 then +x = x + 1 +return ... +end end)(n(f, ...)) +end, ... +end)(i(...)) +end end end +=-= +function b(n) + local x = 1 + return function (i) + return function (...) + return (function (n, ...) + return function (f, ...) + return (function (...) + if ... and x < 9 then + x = x + 1 + return ... + end end)(n(f, ...)) + end, ... + end)(i(...)) +end end end +=-=-= + +Name: Nested Function Indent 3 + +=-= +function c(f) +local f1 = function (...) +if nil ~= ... then +return f(...) +end +end +return function (i) +return function (...) +local fn = function (n, ...) +local x = function (f, ...) +return f1(n(f, ...)) +end +return x +end +return fn(i(...)) +end +end +end +=-= +function c(f) + local f1 = function (...) + if nil ~= ... then + return f(...) + end + end + return function (i) + return function (...) + local fn = function (n, ...) + local x = function (f, ...) + return f1(n(f, ...)) + end + return x + end + return fn(i(...)) + end + end +end +=-=-= + +Name: Nested Function Indent 4 + +=-= +function d(f) +local f1 = function (c, f, ...) +if ... then +if f(...) then +return ... +else +return c(f, ...) +end end end +return function (i) +return function (...) +return (function (n, ...) +local function j (f, ...) +return f1(j, f, n(f, ...)) +end +return j, ... +end)(i(...)) +end end end +=-= +function d(f) + local f1 = function (c, f, ...) + if ... then + if f(...) then + return ... + else + return c(f, ...) + end end end + return function (i) + return function (...) + return (function (n, ...) + local function j (f, ...) + return f1(j, f, n(f, ...)) + end + return j, ... + end)(i(...)) +end end end +=-=-= + +Name: Nested Function Indent 5 + +=-= +function e (n, t) +return function (i) +return function (...) +return ( +function (n, ...) +local x, y, z = 0, {} +return (function (f, ...) +return (function (i, ...) return i(i, ...) end)( +function (i, ...) +return f(function (x, ...) +return i(i, ...)(x, ...) +end, ...) +end) +end)(function (j) +return function(f, ...) +return (function (c, f, ...) +if ... then +if n+1 == x then +local y1, x1 = y, x +y, x = {}, 0 +return (function (...) +z = ... +return ... +end)(t(y1-1, x1-1, ...)) +else +x = x - 1 +return c(f, +(function (...) +z = ... +return ... +end)(t(y, x, ...))) +end +elseif x ~= 0 then +x = 0 +return z, y +end end)(j, f, n(f, ...)) +end end), ... +end)(i(...)) +end end end +=-= +function e (n, t) + return function (i) + return function (...) + return ( + function (n, ...) + local x, y, z = 0, {} + return (function (f, ...) + return (function (i, ...) return i(i, ...) end)( + function (i, ...) + return f(function (x, ...) + return i(i, ...)(x, ...) + end, ...) + end) + end)(function (j) + return function(f, ...) + return (function (c, f, ...) + if ... then + if n+1 == x then + local y1, x1 = y, x + y, x = {}, 0 + return (function (...) + z = ... + return ... + end)(t(y1-1, x1-1, ...)) + else + x = x - 1 + return c(f, + (function (...) + z = ... + return ... + end)(t(y, x, ...))) + end + elseif x ~= 0 then + x = 0 + return z, y + end end)(j, f, n(f, ...)) + end end), ... + end)(i(...)) +end end end +=-=-= diff --git a/test/lisp/progmodes/lua-mode-resources/movement.erts b/test/lisp/progmodes/lua-mode-resources/movement.erts new file mode 100644 index 00000000000..04a52e6bd01 --- /dev/null +++ b/test/lisp/progmodes/lua-mode-resources/movement.erts @@ -0,0 +1,637 @@ +Code: + (lambda () + (lua-mode) + (beginning-of-defun 1)) + +Point-Char: | + +Name: beginning-of-defun moves to start of function declaration + +=-= +local function Test() + if true then + print(1) + else + print(0) + end| +end +=-= +|local function Test() + if true then + print(1) + else + print(0) + end +end +=-=-= + +Code: + (lambda () + (lua-mode) + (end-of-defun 1)) + +Point-Char: | + +Name: end-of-defun moves to end of function declaration + +=-= +local function Test() + if true then + pr|int(1) + else + print(0) + end +end + +local t = Test() +=-= +local function Test() + if true then + print(1) + else + print(0) + end +end +| +local t = Test() +=-=-= + +Name: end-of-defun moves to end of function definition + +=-= +local t = { + f = function() + re|turn true + end, +} +=-= +local t = { + f = function() + return true +| end, +} +=-=-= + +Code: + (lambda () + (lua-mode) + (forward-sentence 1)) + +Point-Char: | + +Name: forward-sentence moves over if statements + +=-= +function f() + |if true then + print(1) + elseif false then + print(0) + else + print(2) + end +end +=-= +function f() + if true then + print(1) + elseif false then + print(0) + else + print(2) + end +end| +=-=-= + +Name: forward-sentence moves over variable declaration + +=-= +|local n = 1 + +print(n) +=-= +local n = 1| + +print(n) +=-=-= + +Name: forward-sentence moves over for statements + +=-= +|for k, v in pairs({}) do + print(k, v) +end + +print(1) +=-= +for k, v in pairs({}) do + print(k, v) +end| + +print(1) +=-=-= + +Name: forward-sentence moves over do statements + +=-= +|do + local x = 1 + local y = 2 + + print(x, y) +end + +print(1) +=-= +do + local x = 1 + local y = 2| + + print(x, y) +end + +print(1) +=-=-= + +Name: forward-sentence moves over while statements + +=-= +local i = 0 +|while i < 9 do + print(i) + i = i + 1 +end + +print(1) +=-= +local i = 0 +while i < 9 do + print(i) + i = i + 1 +end| + +print(1) +=-=-= + +Name: forward-sentence moves over repeat statements + +=-= +local i = 0 +|repeat + print(i) + i = i + 1 +until i > 9 + +print(1) +=-= +local i = 0 +repeat + print(i) + i = i + 1 +until i > 9| + +print(1) +=-=-= + +Name: forward-sentence moves over function calls + +=-= +|print(1) +=-= +print(1)| +=-=-= + +Name: forward-sentence moves over return statements + +=-= +function f() + |return math.random() +end +=-= +function f() + return math.random() +end| +=-=-= + +Code: + (lambda () + (lua-mode) + (forward-sentence 1)) + +Name: forward-sentence moves over table fields + +=-= +local t = { + |a = 1, + b = 2, +} +=-= +local t = { + a = 1, + b = 2, +}| +=-=-= + +Code: + (lambda () + (lua-mode) + (backward-sentence 1)) + +Point-Char: | + +Name: backward-sentence moves over if statements + +=-= +function f() + if true then + print(1) + elseif false then + print(0) + else + print(2) + end| +end +=-= +|function f() + if true then + print(1) + elseif false then + print(0) + else + print(2) + end +end +=-=-= + +Name: backward-sentence moves over variable declaration + +=-= +local n = 1| + +print(n) +=-= +|local n = 1 + +print(n) +=-=-= + +Name: backward-sentence moves over for statements + +=-= +for k, v in pairs({}) do + print(k, v) +end| + +print(1) +=-= +|for k, v in pairs({}) do + print(k, v) +end + +print(1) +=-=-= + +Name: backward-sentence moves over do statements + +=-= +do + local x = 1 + local y = 2 + + print(x, y) +end| + +print(1) +=-= +do + local x = 1 + local y = 2 + + |print(x, y) +end + +print(1) +=-=-= + +Name: backward-sentence moves over while statements + +=-= +local i = 0 +while i < 9 do + print(i) + i = i + 1 +end| + +print(1) +=-= +|local i = 0 +while i < 9 do + print(i) + i = i + 1 +end + +print(1) +=-=-= + +Name: backward-sentence moves over repeat statements + +=-= +local i = 0 +repeat + print(i) + i = i + 1 +until i > 9| + +print(1) +=-= +|local i = 0 +repeat + print(i) + i = i + 1 +until i > 9 + +print(1) +=-=-= + +Name: backward-sentence moves over function calls + +=-= +print(1)| +=-= +|print(1) +=-=-= + +Name: backward-sentence moves over return statements + +=-= +function f() + return math.random()| +end +=-= +|function f() + return math.random() +end +=-=-= + +Code: + (lambda () + (lua-mode) + (backward-sentence 2)) + +Point-Char: | + +Name: backward-sentence moves over table fields + +=-= +local t = { + a = 1, + b = 2|, +} +=-= +|local t = { + a = 1, + b = 2, +} +=-=-= + +Code: + (lambda () + (lua-mode) + (forward-sexp 1)) + +Point-Char: | + +Name: forward-sexp moves over arguments + +=-= +print|(1, 2, 3) +=-= +print(1, 2, 3)| +=-=-= + +Name: forward-sexp moves over parameters + +=-= +function f|(a, b) end +=-= +function f(a, b)| end +=-=-= + +Name: forward-sexp moves over strings + +=-= +print(|"1, 2, 3") +=-= +print("1, 2, 3"|) +=-=-= + +Name: forward-sexp moves over tables + +=-= +local t = |{ 1, + 2, + 3 } +=-= +local t = { 1, + 2, + 3 }| +=-=-= + +Name: forward-sexp moves over parenthesized expressions + +=-= +|(function (x) return x + 1 end)(41) +=-= +(function (x) return x + 1 end)|(41) +=-=-= + +Name: forward-sexp moves over function declarations + +=-= +|function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end +=-= +function| foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end +=-=-= + +Name: forward-sexp moves over do statements + +=-= +|do + print(a + 1) +end +=-= +do| + print(a + 1) +end +=-=-= + +Name: forward-sexp moves over for statements + +=-= +|for k,v in pairs({}) do + print(k, v) +end +=-= +for| k,v in pairs({}) do + print(k, v) +end +=-=-= + +Name: forward-sexp moves over repeat statements + +=-= +|repeat + n = n + 1 +until n > 10 +=-= +repeat| + n = n + 1 +until n > 10 +=-=-= + +Name: forward-sexp moves over while statements + +=-= +|while n < 99 +do + n = n+1 +end +=-= +while| n < 99 +do + n = n+1 +end +=-=-= + +Code: + (lambda () + (lua-mode) + (backward-sexp 1)) + +Point-Char: | + +Name: backward-sexp moves over arguments + +=-= +print(1, 2, 3)| +=-= +print|(1, 2, 3) +=-=-= + +Name: backward-sexp moves over parameters + +=-= +function f(a, b)| end +=-= +function f|(a, b) end +=-=-= + +Name: backward-sexp moves over strings + +=-= +print("1, 2, 3"|) +=-= +print(|"1, 2, 3") +=-=-= + +Name: backward-sexp moves over tables + +=-= +local t = { 1, + 2, + 3 }| +=-= +local t = |{ 1, + 2, + 3 } +=-=-= + +Name: backward-sexp moves over parenthesized expressions + +=-= +(function (x) return x + 1 end)|(41) +=-= +|(function (x) return x + 1 end)(41) +=-=-= + +Name: backward-sexp moves over function declarations + +=-= +function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end| +=-= +function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +|end +=-=-= + +Name: backward-sexp moves over do statements + +=-= +do + print(a + 1) +end| +=-= +do + print(a + 1) +|end +=-=-= + +Name: backward-sexp moves over for statements + +=-= +for k,v in pairs({}) do + print(k, v) +end| +=-= +for k,v in pairs({}) do + print(k, v) +|end +=-=-= + +Name: backward-sexp moves over repeat statements + +=-= +repeat + n = n + 1 +until n > 10| +=-= +repeat + n = n + 1 +until n > |10 +=-=-= + +Name: backward-sexp moves over while statements + +=-= +while n < 99 +do + n = n+1 +end| +=-= +while n < 99 +do + n = n+1 +|end +=-=-= diff --git a/test/lisp/progmodes/lua-mode-resources/which-function.lua b/test/lisp/progmodes/lua-mode-resources/which-function.lua new file mode 100644 index 00000000000..621d818461c --- /dev/null +++ b/test/lisp/progmodes/lua-mode-resources/which-function.lua @@ -0,0 +1,3 @@ +local function f(x) + print(x) +end diff --git a/test/lisp/progmodes/lua-mode-tests.el b/test/lisp/progmodes/lua-mode-tests.el new file mode 100644 index 00000000000..aee3a5f47cb --- /dev/null +++ b/test/lisp/progmodes/lua-mode-tests.el @@ -0,0 +1,60 @@ +;;; lua-mode-tests.el --- Tests for lua-mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Free Software Foundation, Inc. + +;; 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: + +(require 'ert) +(require 'ert-font-lock) +(require 'ert-x) +(require 'hideshow) +(require 'which-func) + +(ert-deftest lua-test-indentation () + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(ert-deftest lua-test-movement () + (ert-test-erts-file (ert-resource-file "movement.erts"))) + +(ert-deftest lua-test-font-lock () + (let ((font-lock-maximum-decoration t)) + (ert-font-lock-test-file (ert-resource-file "font-lock.lua") 'lua-mode))) + +(ert-deftest lua-test-which-function () + (with-temp-buffer + (insert-file-contents (ert-resource-file "which-function.lua")) + (lua-mode) + (which-function-mode) + (goto-char (point-min)) + (should (equal "f" (which-function))) + (which-function-mode -1))) + +(ert-deftest lua-test-hideshow () + (with-temp-buffer + (insert-file-contents (ert-resource-file "hide-show.lua")) + (lua-mode) + (hs-minor-mode) + (hs-hide-all) + (should (= 9 (length (overlays-in (point-min) (point-max))))) + (hs-show-all) + (should (= 0 (length (overlays-in (point-min) (point-max))))) + (hs-minor-mode -1))) + +(provide 'lua-mode-tests) + +;;; lua-mode-tests.el ends here From c934a4188b53e63324ef66c39dd6474728ae10d6 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 25 Aug 2025 09:33:10 +0300 Subject: [PATCH 087/158] * lisp/progmodes/lua-ts-mode.el: Simplify non-ts/ts mode mapping. (lua-ts-mode-maybe): Remove since lua-mode is added to core. --- lisp/progmodes/lua-ts-mode.el | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 5089e17c287..1c1812a7c30 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -769,23 +769,8 @@ Calls REPORT-FN directly." (derived-mode-add-parents 'lua-ts-mode '(lua-mode)) -;;;###autoload -(defun lua-ts-mode-maybe () - "Enable `lua-ts-mode' when its grammar is available. -Also propose to install the grammar when `treesit-enabled-modes' -is t or contains the mode name." - (declare-function treesit-language-available-p "treesit.c") - (if (or (treesit-language-available-p 'lua) - (eq treesit-enabled-modes t) - (memq 'lua-ts-mode treesit-enabled-modes)) - (lua-ts-mode) - (fundamental-mode))) - ;;;###autoload (when (treesit-available-p) - (add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-ts-mode-maybe)) - (add-to-list 'interpreter-mode-alist '("\\ Date: Mon, 25 Aug 2025 15:14:14 +0300 Subject: [PATCH 088/158] Pass remote name explicitly in bug-reference-try-setup-from-vc. * lisp/progmodes/bug-reference.el (bug-reference-setup-from-vc-alist): Add comment explaining the meaning of the nil argument when calling vc-call-backend. Even though "origin" and nil are equivalent when using the git backend, it is more intelligible to see "upstream" and "origin" passed explicitly (bug#79276). --- lisp/progmodes/bug-reference.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 5c03c949049..9901d5df245 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -393,7 +393,12 @@ applicable." (ignore-errors (vc-call-backend backend 'repository-url file-or-dir remote))) - '("upstream" nil)))) + ;; Try likely names for the remote which + ;; probably hosts the bug tracker. The nil + ;; value refers to the default remote name + ;; of the concrete VCS which is "origin" + ;; for Git or "default" for mercurial. + '("upstream" "origin" nil)))) (seq-some (lambda (config) (apply #'bug-reference-maybe-setup-from-vc url config)) (append bug-reference-setup-from-vc-alist From 0c49f5917fdd46a8f34181e66b3c11a8657d6bf2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 25 Aug 2025 18:19:14 +0300 Subject: [PATCH 089/158] Attempt to fix assertion violations in bug#79304 The following changes make the changes for bug#79275 less radical, closer to their previous shape, while still fixing that bug. * src/xdisp.c (push_prefix_prop, get_it_property): Restore original code that determined the object and position on it. (get_line_prefix_it_property): Take FROM_BUFFER from the actual object of the prefix property. --- src/xdisp.c | 29 ++++++++--------------------- 1 file changed, 8 insertions(+), 21 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index b8088f692c4..4f6acb84bbf 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24736,18 +24736,8 @@ cursor_row_p (struct glyph_row *row) static bool push_prefix_prop (struct it *it, Lisp_Object prop, int from_buffer) { - struct text_pos pos; - - if (STRINGP (it->string)) - { - if (from_buffer) /* a string, but prefix property from buffer */ - pos = it->current.string_pos; - else /* a string and prefix property from string */ - pos.charpos = pos.bytepos = 0; /* we have yet to iterate that string */ - } - else /* a buffer and prefix property from buffer */ - pos = it->current.pos; - + struct text_pos pos = + STRINGP (it->string) ? it->current.string_pos : it->current.pos; bool phoney_display_string = from_buffer && STRINGP (it->string) && it->string_from_display_prop_p; @@ -24844,14 +24834,11 @@ push_prefix_prop (struct it *it, Lisp_Object prop, int from_buffer) static Lisp_Object get_it_property (struct it *it, Lisp_Object prop) { - Lisp_Object position, object; + Lisp_Object position, object = it->object; - if (STRINGP (it->string)) - { - position = make_fixnum (IT_STRING_CHARPOS (*it)); - object = it->string; - } - else if (BUFFERP (it->object)) + if (STRINGP (object)) + position = make_fixnum (IT_STRING_CHARPOS (*it)); + else if (BUFFERP (object)) { position = make_fixnum (IT_CHARPOS (*it)); object = it->window; @@ -24871,11 +24858,11 @@ get_line_prefix_it_property (struct it *it, Lisp_Object prop, { Lisp_Object prefix = get_it_property (it, prop); - *from_buffer = false; + *from_buffer = BUFFERP (it->object); /* If we are looking at a display or overlay string, check also the underlying buffer text. */ - if (NILP (prefix) && it->sp > 0 && STRINGP (it->string)) + if (NILP (prefix) && it->sp > 0 && STRINGP (it->object)) { *from_buffer = true; return Fget_char_property (make_fixnum (IT_CHARPOS (*it)), prop, From f884b1acef5e053fa33b2ebd3bce100fe643d71a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 25 Aug 2025 20:44:36 +0300 Subject: [PATCH 090/158] Fix assertion violations caused by recent redisplay changes * src/xdisp.c (push_it): Don't rest the string_from_prefix_prop_p flag. (Bug#79304) --- src/xdisp.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 4f6acb84bbf..6411fd23335 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -7261,8 +7261,6 @@ push_it (struct it *it, struct text_pos *position) p->from_disp_prop_p = it->from_disp_prop_p; ++it->sp; - it->string_from_prefix_prop_p = false; - /* Save the state of the bidi iterator as well. */ if (it->bidi_p) bidi_push_it (&it->bidi_it); From 9bde50d6fd2afbba0aaf9a65f9699b9f001b08e0 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 25 Aug 2025 20:13:02 +0200 Subject: [PATCH 091/158] ; Comment out tramp-hlo in tramp.texi * doc/misc/tramp.texi (Frequently Asked Questions): Comment out tramp-hlo. It hasn't landed in GNU ELPA yet. --- doc/misc/tramp.texi | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 2944978f8ee..f2b1ddbcfb6 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5478,12 +5478,12 @@ Disable excessive traces. Set @code{tramp-verbose} to 3 or lower, default being 3. Increase trace levels temporarily when hunting for bugs. -@item -Use a package with @value{tramp} specific implementation of high-level -operations. For example, the GNU ELPA package @file{tramp-hlo} -implements specialized versions of @code{dir-locals--all-files}, -@code{locate-dominating-file} and @code{dir-locals-find-file} for -@value{tramp}'s @code{tramp-sh} backend (@pxref{New operations}). +@c @item +@c Use a package with @value{tramp} specific implementation of high-level +@c operations. For example, the GNU ELPA package @file{tramp-hlo} +@c implements specialized versions of @code{dir-locals--all-files}, +@c @code{locate-dominating-file} and @code{dir-locals-find-file} for +@c @value{tramp}'s @code{tramp-sh} backend (@pxref{New operations}). @end itemize From 21b072c6074466f3ec7d2489b82e21d8b0cae265 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 25 Aug 2025 22:27:10 +0300 Subject: [PATCH 092/158] Fix use of display-table for mode-line display * src/xdisp.c (next_element_from_display_vector): Fix handling non-ASCII characters in display-table cells corresponding to ASCII characters. (Bug#79311) --- src/xdisp.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/xdisp.c b/src/xdisp.c index 6411fd23335..59483768d92 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9156,6 +9156,10 @@ next_element_from_display_vector (struct it *it) it->c = GLYPH_CODE_CHAR (gc); it->len = CHAR_BYTES (it->c); + /* The character code in the display vector could be non-ASCII, in + which case we must make the iterator multibyte, so that a + suitable font for the character is looked up. */ + it->multibyte_p = !ASCII_CHAR_P (it->c); /* The entry may contain a face id to use. Such a face id is the id of a Lisp face, not a realized face. A face id of From 54bd2264d3347895aacc926b33c6f1bb5af5fa0d Mon Sep 17 00:00:00 2001 From: john muhl Date: Sun, 24 Aug 2025 11:29:43 -0500 Subject: [PATCH 093/158] Fix 'ruby-flymake-simple' for Ruby 3.4 (Bug#79257) * lisp/progmodes/ruby-mode.el (ruby-flymake-simple): Update regular expression to handle new versions of Ruby including the location of the executable in the output. --- lisp/progmodes/ruby-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 1079aad1a55..5c8a4025419 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -2516,7 +2516,7 @@ A slash character after any of these should begin a regexp.")) (goto-char (point-min)) (cl-loop while (search-forward-regexp - "^\\(?:.*\\.rb\\|-\\):\\([0-9]+\\): \\(.*\\)$" + "^\\(?:.*ruby: \\)?\\(?:.*\\.rb\\|-\\):\\([0-9]+\\): \\(.*\\)$" nil t) for msg = (match-string 2) for (beg . end) = (flymake-diag-region From c711ba3c7bcab1b0900604425283fc018257abe0 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 24 Aug 2025 19:27:47 -0700 Subject: [PATCH 094/158] Prefer window-text-pixel-size in erc-fill * lisp/erc/erc-fill.el (erc-fill--wrap-measure): Using `buffer-text-pixel-size' for measuring text size in the selected window can end up triggering a scroll, which then requires imperfect countering by the scrolltobottom module, especially with regard to the option `erc-scrolltobottom-all'. Thanks to Alcor for reporting and helping with this bug, which was introduced along with fill-wrap in ERC 5.6. --- lisp/erc/erc-fill.el | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 145a4c174a8..c4c9b6da76d 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -618,14 +618,20 @@ message has been marked `erc--ephemeral'." Ignore any `invisible' props that may be present when figuring. Expect the target region to be free of `line-prefix' and `wrap-prefix' properties, and expect `display-line-numbers-mode' -to be disabled." +to be disabled. On Emacs 28 and below, return END minus BEG." + ;; Rely on `buffer-text-pixel-size' here even for buffers displayed in + ;; another window because temporarily selecting such windows via + ;; `with-selected-window' seems to interfere with the implementation + ;; of `erc-scrolltobottom-all' in ERC 5.6, which needs improvement. (if (fboundp 'buffer-text-pixel-size) ;; `buffer-text-pixel-size' can move point! (save-excursion (save-restriction (narrow-to-region beg end) (let* ((buffer-invisibility-spec) - (rv (car (buffer-text-pixel-size)))) + (rv (car (if (eq (selected-window) (get-buffer-window)) + (window-text-pixel-size) + (buffer-text-pixel-size))))) (if erc-fill-wrap-use-pixels (if (zerop rv) 0 (list rv)) (/ rv (frame-char-width)))))) From d98e1a83753ecc988fe9109308aea05e86534734 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 24 Aug 2025 19:53:27 -0700 Subject: [PATCH 095/158] Remove scrolltobottom dependency from erc-fill module This mostly reverts 9668b4f97c2fc6bfff83258861d455a6d02516a8 "Make erc-fill-wrap depend on scrolltobottom". * etc/ERC-NEWS: Mention removal of formal dependency. * lisp/erc/erc-fill.el (erc-fill--wrap-scrolltobottom-exempt-p): Remove unused variable. (erc-fill--wrap-ensure-dependencies): Remove unused dependency check. (erc-fill-wrap-mode): Remove scrolltobottom dependency from doc string. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate): Remove unused binding from var list. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--make-bindings): Remove unused binding. --- etc/ERC-NEWS | 4 ++++ lisp/erc/erc-fill.el | 16 ++++------------ test/lisp/erc/erc-fill-tests.el | 1 - test/lisp/erc/resources/erc-scenarios-common.el | 1 - 4 files changed, 8 insertions(+), 14 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index dd960994b4f..513ed8f706d 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -36,6 +36,10 @@ The command 'erc-fill-wrap-cycle-visual-movement' was mistakenly given the key binding "C-c a" in an inadvertent holdover from development. It has been removed. +** The 'fill-wrap' module no longer depends on 'scrolltobottom'. +This change also affects the option 'erc-fill-function' when it's set to +'erc-fill-wrap'. + ** Updated defaults for the 'track' module's face-list options. The default values of options 'erc-track-faces-priority-list' and 'erc-track-faces-normal-list' have both gained a face for buttonized diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index c4c9b6da76d..291dcc2e306 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -417,11 +417,8 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." " " #'erc-fill--wrap-beginning-of-line) (defvar erc-button-mode) -(defvar erc-scrolltobottom-mode) (defvar erc-legacy-invisible-bounds-p) -(defvar erc-fill--wrap-scrolltobottom-exempt-p nil) - (defun erc-fill--wrap-ensure-dependencies () (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) (when erc-legacy-invisible-bounds-p @@ -434,10 +431,6 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." (unless erc-fill-mode (push 'fill missing-deps) (erc-fill-mode +1)) - (unless (or erc-scrolltobottom-mode erc-fill--wrap-scrolltobottom-exempt-p - (memq 'scrolltobottom erc-modules)) - (push 'scrolltobottom missing-deps) - (erc-scrolltobottom-mode +1)) (when erc-fill-wrap-merge (require 'erc-button) (unless erc-button-mode @@ -515,11 +508,10 @@ This normally poses at most a minor inconvenience. Users of the logged messages and instead prepends them to every line. A so-called \"local\" module, `fill-wrap' depends on the global -modules `fill', `stamp', `button', and `scrolltobottom'. It -activates them as needed when initializing and leaves them -enabled when shutting down. To opt out of `scrolltobottom' -specifically, disable its minor mode, `erc-scrolltobottom-mode', -via `erc-fill-wrap-mode-hook'." +modules `fill', `stamp', `button'. It therefore activates them +as needed when initializing and leaves them enabled when shutting +down. Users may also find the `scrolltobottom' module a +necessary addition for this fill style." ((erc-fill--wrap-ensure-dependencies) (when erc-fill-wrap-merge-indicator (erc-fill--wrap-massage-legacy-indicator-type)) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index bfc12d919c0..13a3e107d38 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -52,7 +52,6 @@ (defun erc-fill-tests--wrap-populate (test) (let ((original-window-buffer (window-buffer (selected-window))) - (erc-fill--wrap-scrolltobottom-exempt-p t) (erc-stamp--tz t) (erc-fill-function 'erc-fill-wrap) (pre-command-hook pre-command-hook) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index f193f3fb070..ce7595363c9 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -150,7 +150,6 @@ (timer-list (copy-sequence timer-list)) (timer-idle-list (copy-sequence timer-idle-list)) (erc-auth-source-parameters-join-function nil) - (erc-fill--wrap-scrolltobottom-exempt-p t) (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) From 8eb192c23dfea36bc78460032f465c47bbbf4416 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 26 Aug 2025 15:18:29 +0300 Subject: [PATCH 096/158] ; * admin/make-tarball.txt: Update the "Web pages" section (bug#79315). --- admin/make-tarball.txt | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt index 61d19e54b8e..3257dc6ce46 100644 --- a/admin/make-tarball.txt +++ b/admin/make-tarball.txt @@ -380,12 +380,14 @@ As soon as possible after a release, the Emacs web pages at should be updated. (See admin/notes/www for general information.) -The pages to update are: +The pages and files to update are: -emacs.html (for a new major release, a more thorough update is needed) -history.html -add the new NEWS file as news/NEWS.xx.y -Copy new etc/MACHINES to MACHINES and CONTRIBUTE to CONTRIBUTE + . emacs.html (see below; for a new major release, a more thorough + update is needed) + . history.html (add a line for the new release) + . add the new NEWS file as news/NEWS.xx.y + . copy new etc/MACHINES to MACHINES and CONTRIBUTE to CONTRIBUTE + . possibly/rarely also download.html (see below) For every new release, a banner is displayed on top of the emacs.html page. Uncomment the release banner in emacs.html. Keep it on the page From ff83b735f94359a602ac543c13492178d70b1bc3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 26 Aug 2025 16:24:55 +0300 Subject: [PATCH 097/158] Fix last change in 'next_element_from_display_vector' * src/xdisp.c (next_element_from_display_vector): Only switch the iterator from unibyte to multibyte, never in the other direction, and not if the original character came from a unibyte buffer. (Bug#79317) --- src/xdisp.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 59483768d92..89561d750b6 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9158,8 +9158,14 @@ next_element_from_display_vector (struct it *it) it->len = CHAR_BYTES (it->c); /* The character code in the display vector could be non-ASCII, in which case we must make the iterator multibyte, so that a - suitable font for the character is looked up. */ - it->multibyte_p = !ASCII_CHAR_P (it->c); + suitable font for the character is looked up. But don't do + that if the original character came from a unibyte buffer. */ + if (!ASCII_CHAR_P (it->c) + && !it->multibyte_p + && !(((it->sp == 0 && BUFFERP (it->object)) + || (it->sp > 1 && !NILP (it->stack[0].string))) + && NILP (BVAR (current_buffer, enable_multibyte_characters)))) + it->multibyte_p = 1; /* The entry may contain a face id to use. Such a face id is the id of a Lisp face, not a realized face. A face id of From 6b0b70233a2a29d3d4ea83b0ea07b337271c0d5f Mon Sep 17 00:00:00 2001 From: john muhl Date: Wed, 27 Aug 2025 00:04:56 +0300 Subject: [PATCH 098/158] ; ruby-flymake-simple: Only match relative file name (bug#79257) --- lisp/progmodes/ruby-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 5c8a4025419..0a6ead870a7 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -2516,7 +2516,7 @@ A slash character after any of these should begin a regexp.")) (goto-char (point-min)) (cl-loop while (search-forward-regexp - "^\\(?:.*ruby: \\)?\\(?:.*\\.rb\\|-\\):\\([0-9]+\\): \\(.*\\)$" + "^\\(?:ruby: \\)?\\(?:.*\\.rb\\|-\\):\\([0-9]+\\): \\(.*\\)$" nil t) for msg = (match-string 2) for (beg . end) = (flymake-diag-region From f908d854d616b7c68e1f4009ad4c1da0afc7db06 Mon Sep 17 00:00:00 2001 From: john muhl Date: Tue, 26 Aug 2025 15:12:26 -0500 Subject: [PATCH 099/158] ; Various code cleanup in 'lua-mode' (Bug#79309) * lisp/progmodes/lua-mode.el (lua-indent-level): Contemporary Lua style guides no longer recommend 3 as default. Change type to 'natnum'. (lua-always-show, lua-get-block-token-info) (lua--backward-up-list-noerror, lua-make-indentation-info-pair) (lua-accumulate-indentation-info) (lua-calculate-indentation-block-modifier): Quote function names. (lua-toggle-electric-state): Re-format to avoid confusion. (lua-is-continuing-statement-p-1): Fix typo. (lua--builtins): Move docstring to correct location. (lua-is-continuing-statement-p-1): Remove unnecessary 'or'. (lua-make-lua-string): Remove excessive backslashes and unnecessary use of a temporary buffer. (lua-find-matching-token-word): Make it clear that 'goto-char' is only used only for its side-effect. --- lisp/progmodes/lua-mode.el | 110 ++++++++++++++++++------------------- 1 file changed, 54 insertions(+), 56 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index f8d9ed98f1a..2e051d6d552 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -150,10 +150,10 @@ :prefix "lua-" :group 'languages) -(defcustom lua-indent-level 3 +(defcustom lua-indent-level 4 "Amount by which Lua subexpressions are indented." - :type 'integer - :safe #'integerp + :type 'natnum + :safe #'natnump :version "31.1") (defcustom lua-comment-start "-- " @@ -183,7 +183,7 @@ Should be a list of strings." :version "31.1") (defcustom lua-always-show t - "Non-nil means display lua-process-buffer after sending a command." + "Non-nil means display `lua-process-buffer' after sending a command." :type 'boolean :group 'lua) @@ -204,7 +204,6 @@ Should be a list of strings." :type 'string :group 'lua) - (defvar lua-process nil "The active Lua process.") @@ -390,11 +389,11 @@ traceback location." (concat (module-name-re x) (module-members-re x))) modules "\\|") - "\\)")))) - "A regexp that matches Lua builtin functions & variables. + "\\)"))) + "A regexp that matches Lua builtin functions & variables. -This is a compilation of 5.1, 5.2 and 5.3 builtins taken from the -index of respective Lua reference manuals.") +This is a compilation of 5.1-5.4 builtins taken from the index of +respective Lua reference manuals.")) (defvar lua-font-lock-keywords `(;; Highlight the hash-bang line "#!/foo/bar/lua" as comment @@ -917,7 +916,7 @@ type.") (any ")]}")))))) (defun lua-get-block-token-info (token) - "Return the block token info entry for TOKEN from lua-block-token-alist." + "Return the block token info entry for TOKEN from `lua-block-token-alist'." (assoc token lua-block-token-alist)) (defun lua-get-token-match-re (token-info direction) @@ -993,9 +992,10 @@ DIRECTION has to be either \\='forward or \\='backward." (eq match-type 'middle-or-open) (eq found-type 'middle-or-open) (eq match-type found-type)) - (goto-char found-pos) - (lua-find-matching-token-word - found-token search-direction)) + (progn + (goto-char found-pos) + (lua-find-matching-token-word + found-token search-direction))) (when maybe-found-pos (goto-char maybe-found-pos) (throw 'found maybe-found-pos))) @@ -1202,7 +1202,7 @@ end-of-statement.") (match-beginning 2)))))) (defun lua--backward-up-list-noerror () - "Safe version of lua-backward-up-list that does not signal an error." + "Safe version of `lua-backward-up-list' that does not signal an error." (condition-case nil (lua-backward-up-list) (scan-error nil))) @@ -1249,40 +1249,39 @@ end-of-statement.") lua-funcheader))))) (defun lua-is-continuing-statement-p-1 () - "Return non-nil if current lined continues a statement. + "Return non-nil if current line continues a statement. More specifically, return the point in the line that is continued. The criteria for a continuing statement are: -* the last token of the previous line is a continuing op, - OR the first token of the current line is a continuing op +* The last token of the previous line is a continuing op, + OR the first token of the current line is a continuing op. -* the expression is not enclosed by a parentheses/braces/brackets" +* The expression is not enclosed by a parentheses/braces/brackets." (let (prev-line continuation-pos parent-block-opener) (save-excursion (setq prev-line (lua-forward-line-skip-blanks 'back))) (and prev-line (not (lua--continuation-breaking-line-p)) (save-excursion - (or - ;; Binary operator or keyword that implies continuation. - (and (setq continuation-pos - (or (lua-first-token-continues-p) - (save-excursion - (and (goto-char prev-line) - ;; Check last token of previous nonblank line - (lua-last-token-continues-p))))) - (not - ;; Operators/keywords does not create continuation - ;; inside some blocks: - (and (setq parent-block-opener - (car-safe (lua--backward-up-list-noerror))) - (or - ;; Inside parens/brackets - (member parent-block-opener '("(" "[")) - ;; Inside braces if it is a comma - (and (eq (char-after continuation-pos) ?,) - (equal parent-block-opener "{"))))) - continuation-pos)))))) + ;; Binary operator or keyword that implies continuation. + (and (setq continuation-pos + (or (lua-first-token-continues-p) + (save-excursion + (goto-char prev-line) + ;; Check last token of previous nonblank line + (lua-last-token-continues-p)))) + (not + ;; Operators/keywords does not create continuation + ;; inside some blocks: + (and (setq parent-block-opener + (car-safe (lua--backward-up-list-noerror))) + (or + ;; Inside parens/brackets + (member parent-block-opener '("(" "[")) + ;; Inside braces if it is a comma + (and (eq (char-after continuation-pos) ?,) + (equal parent-block-opener "{"))))) + continuation-pos))))) (defun lua-is-continuing-statement-p (&optional parse-start) "Return non-nil if PARSE-START should be indented as continuation line. @@ -1328,7 +1327,7 @@ This true is when the line: (defun lua-make-indentation-info-pair (found-token found-pos) "Create a pair from FOUND-TOKEN and FOUND-POS for indentation calculation. -This is a helper function to lua-calculate-indentation-info. +This is a helper function to `lua-calculate-indentation-info'. Don't use standalone." (cond ;; Functions are a bit tricky to indent right. They can appear in a @@ -1525,7 +1524,7 @@ The argument PARSE-END is a buffer position that bounds the calculation." indentation-info)) (defun lua-accumulate-indentation-info (reversed-indentation-info) - "Accumulate indent information from lua-calculate-indentation-info. + "Accumulate indent information from `lua-calculate-indentation-info'. Returns either the relative indentation shift, or the absolute column to indent to. @@ -1553,8 +1552,8 @@ The argument REVERSED-INDENTATION-INFO is an indentation INFO-LIST." (defun lua-calculate-indentation-block-modifier (&optional parse-end) "Return amount by which this line modifies the indentation. -Beginnings of blocks add lua-indent-level once each, and endings of -blocks subtract lua-indent-level once each. This function is used to +Beginnings of blocks add `lua-indent-level' once each, and endings of +blocks subtract `lua-indent-level' once each. This function is used to determine how the indentation of the following line relates to this one. The argument PARSE-END is a buffer position that bounds the calculation." @@ -1814,19 +1813,17 @@ This function just searches for a `end' at the beginning of a line." (defun lua-make-lua-string (str) "Convert STR to Lua literal." - (save-match-data - (with-temp-buffer - (insert str) - (goto-char (point-min)) - (while (re-search-forward "[\"'\\\t\\\n]" nil t) - (cond - ((string= (match-string 0) "\n") - (replace-match "\\\\n")) - ((string= (match-string 0) "\t") - (replace-match "\\\\t")) - (t - (replace-match "\\\\\\&" t)))) - (concat "'" (buffer-string) "'")))) + (concat "'" + (replace-regexp-in-string + (rx (or ?\" ?' ?\t ?\n ?\\)) + (lambda (s) + (cdr (assq (aref s 0) '((?\" . "\\\"") + (?\\ . "\\\\") + (?\n . "\\n") + (?\t . "\\t") + (?' . "\\'"))))) + str t t) + "'")) ;;;###autoload (defalias 'run-lua #'lua-start-process) @@ -2031,7 +2028,8 @@ left out." (interactive "P") (let ((num_arg (prefix-numeric-value arg))) (setq lua-electric-flag (cond ((or (null arg) - (zerop num_arg)) (not lua-electric-flag)) + (zerop num_arg)) + (not lua-electric-flag)) ((< num_arg 0) nil) ((> num_arg 0) t)))) (message "%S" lua-electric-flag)) From 29c35668d0b61883a9bf06b8396b9932aa3113fe Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 27 Aug 2025 11:24:12 +0200 Subject: [PATCH 100/158] Extend info-xref-test-emacs-manuals, fix info reference * doc/lispref/loading.texi (Autoload): Fix reference. * test/lisp/info-xref-tests.el (info-xref-test-emacs-manuals): Print output buffer. --- doc/lispref/loading.texi | 2 +- test/lisp/info-xref-tests.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 836d980ff0d..f6a3a0e2c26 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -690,7 +690,7 @@ and @code{define-overloadable-function} (see the commentary in (@pxref{Top,Autotyping,,autotype,Autotyping}), @code{transient-define-prefix}, @code{transient-define-suffix}, @code{transient-define-infix}, @code{transient-define-argument}, and -@code{transient-define-group} (@pxref{TOP,Transient,,transient,Transient +@code{transient-define-group} (@pxref{Top,Transient,,transient,Transient User and Developer Manual}). @end table diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el index 718e4712e4e..f7e42978b80 100644 --- a/test/lisp/info-xref-tests.el +++ b/test/lisp/info-xref-tests.el @@ -165,11 +165,11 @@ text. (skip-unless (file-readable-p "emacs.info")) (info-xref-check-all) (with-current-buffer info-xref-output-buffer + (message "%s" (buffer-substring-no-properties (point-min) (point-max))) (goto-char (point-max)) (should (search-backward "done" nil t)) (should (string-match-p " [0-9]\\{3,\\} good, 0 bad" (buffer-substring-no-properties (pos-bol) (pos-eol))))))) - ;;; info-xref-tests.el ends here From b7cef005717b4b125e250863f20691f99e4fdb91 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Tue, 26 Aug 2025 11:46:57 +0200 Subject: [PATCH 101/158] ; Fix formatting * src/process.c (clear_fd_callback_data, delete_write_fd, delete_keyboard_wait_descriptor): Space before paren. --- src/process.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/process.c b/src/process.c index c8b70a4174c..d6efac5479d 100644 --- a/src/process.c +++ b/src/process.c @@ -467,7 +467,7 @@ static struct fd_callback_data } fd_callback_info[FD_SETSIZE]; static void -clear_fd_callback_data(struct fd_callback_data* elem) +clear_fd_callback_data (struct fd_callback_data* elem) { elem->func = NULL; elem->data = NULL; @@ -577,7 +577,7 @@ delete_write_fd (int fd) fd_callback_info[fd].flags &= ~(FOR_WRITE | NON_BLOCKING_CONNECT_FD); if (fd_callback_info[fd].flags == 0) { - clear_fd_callback_data(&fd_callback_info[fd]); + clear_fd_callback_data (&fd_callback_info[fd]); if (fd == max_desc) recompute_max_desc (); @@ -8322,7 +8322,7 @@ delete_keyboard_wait_descriptor (int desc) #ifdef subprocesses eassert (desc >= 0 && desc < FD_SETSIZE); - clear_fd_callback_data(&fd_callback_info[desc]); + clear_fd_callback_data (&fd_callback_info[desc]); if (desc == max_desc) recompute_max_desc (); From 6aa0be3d46eca9ad66bc0a519585e5e53a53caa9 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Wed, 27 Aug 2025 10:52:32 +0200 Subject: [PATCH 102/158] ; * etc/NEWS: Correct AUTH=PLAIN description. --- etc/NEWS | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 6845a726c29..cdf46096034 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1478,9 +1478,10 @@ replies. --- *** 'imap-authenticate' can now use PLAIN authentication. -"AUTH=PLAIN" support is auto-enabled if the IMAP server supports it. Pass -a specific authentication type to 'imap-authenticate' or remove 'plain' -from 'imap-authenticators' if you do not wish to use "AUTH=PLAIN". +"AUTH=PLAIN" support is auto-enabled if the IMAP server supports it. If +you do not wish to use "AUTH=PLAIN", pass a specific authentication type +to 'imap-open' for 'imap-authenticate' to use, or remove 'plain' from +'imap-authenticators'. ** Rmail From 7efa4e34bbde31f3b8fbfe510a1cc2ddbc45ac1f Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Thu, 7 Aug 2025 15:51:19 +0200 Subject: [PATCH 103/158] ; * lisp/font-lock.el: Remove unneeded "cl-lib" require. --- lisp/font-lock.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 188f03cbb9c..0d1bd18ee23 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -207,7 +207,6 @@ ;;; Code: (require 'syntax) -(eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) ;; Define core `font-lock' group. From 293e258a1b26830e75259b9dbb4f29961ffb402c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 27 Aug 2025 12:08:12 +0200 Subject: [PATCH 104/158] * doc/emacs/screen.texi (Mode Line): Fix reference. --- doc/emacs/screen.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/screen.texi b/doc/emacs/screen.texi index ca3690edb9a..e2546ce132d 100644 --- a/doc/emacs/screen.texi +++ b/doc/emacs/screen.texi @@ -234,7 +234,7 @@ current buffer is on a remote machine, @samp{@@} is displayed instead. @var{d} appears if the window is dedicated to its current buffer. It appears as @samp{D} for strong dedication and @samp{d} for other forms of dedication. If the window is not dedicated, @var{d} does not -appear. @xref{Dedicated Windows,, elisp, The Emacs Lisp Reference +appear. @xref{Dedicated Windows,,, elisp, The Emacs Lisp Reference Manual}. @var{fr} gives the selected frame name (@pxref{Frames}). It appears From e46471ed0746ad290d466e893015f6f794c06cc1 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Thu, 21 Aug 2025 14:33:23 -0400 Subject: [PATCH 105/158] Make RET choose the selected completion Previously, one could select a completion via M-/M-, but then RET would not actually select the chosen completion. With the addition of completion-auto-deselect, this is not actually necessary: we can reasonably assume that when a completion is selected, the user wants to use that, since their last action must have been to select it. So, just choose the selected completion on RET. This lets us default minibuffer-completion-auto-choose to nil. For minibuffers with require-match completion, this can be done by changing the existing command bound to RET. For minibuffers with nil require-match completion, RET was previously bound to exit-minibuffer, and changing exit-minibuffer to have this logic is risky. We handle that case by adding a new minibuffer-completion-exit which wraps exit-minibuffer and bind RET to it. * lisp/minibuffer.el (minibuffer-insert-completion-if-selected) (minibuffer-completion-exit, completion--selected-candidate): Add. (minibuffer-complete-and-exit): Call minibuffer-choose-completion. (bug#77253) (minibuffer-local-completion-map): Bind RET to minibuffer-completion-exit, overriding exit-minibuffer. (completion-in-region-mode-map): Bind RET to minibuffer-choose-completion when there's a selected candidate. (minibuffer-completion-auto-choose): Default to nil. (minibuffer-visible-completions--filter) (minibuffer-visible-completions-map): Delete RET binding, no longer necessary. * lisp/simple.el (completion-setup-function): Update completion help text to show more correct bindings. * test/lisp/minibuffer-tests.el (completions-header-format-test) (minibuffer-next-completion): Set minibuffer-completion-auto-choose=t explicitly. (with-minibuffer-setup, minibuffer-completion-RET-prefix) (completion-in-region-next-completion): Add new tests. * etc/NEWS: Announce. --- etc/NEWS | 8 ++++++ lisp/minibuffer.el | 50 +++++++++++++++++++++++++-------- lisp/simple.el | 32 +++++++++------------ test/lisp/minibuffer-tests.el | 53 ++++++++++++++++++++++++++++++++++- 4 files changed, 112 insertions(+), 31 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index cdf46096034..af6dd0c2151 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -183,6 +183,14 @@ different completion categories by customizing be updated as you type, or nil to suppress this always. Note that for large or inefficient completion tables this can slow down typing. +--- +*** RET chooses the completion selected with M-/M- +If a completion candidate is selected with M- or M-, hitting +RET will exit completion with that as the result. This works both in +minibuffer completion and in-buffer completion. This supersedes +'minibuffer-completion-auto-choose', which previously provided similar +behavior; that variable is now nil by default. + +++ *** New user option 'completion-pcm-leading-wildcard'. This option configures how the partial-completion style does completion. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 3558b14bf78..55b6d79a813 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1983,12 +1983,17 @@ DONT-CYCLE tells the function not to setup cycling." (defvar minibuffer--original-buffer nil "Buffer that was current when `completing-read' was called.") -(defun minibuffer-complete-and-exit () +(defun minibuffer-complete-and-exit (&optional no-exit) "Exit if the minibuffer contains a valid completion. Otherwise, try to complete the minibuffer contents. If completion leads to a valid completion, a repetition of this command will exit. +If a completion candidate is selected in the *Completions* buffer, it +will be inserted in the minibuffer first. If NO-EXIT is non-nil, don't +actually exit the minibuffer, just insert the selected completion if +any. + If `minibuffer-completion-confirm' is `confirm', do not try to complete; instead, ask for confirmation and accept any input if confirmed. @@ -1997,9 +2002,12 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', preceding minibuffer command was a member of `minibuffer-confirm-exit-commands', and accept the input otherwise." - (interactive) - (completion-complete-and-exit (minibuffer--completion-prompt-end) (point-max) - #'exit-minibuffer)) + (interactive "P") + (when (completion--selected-candidate) + (minibuffer-choose-completion t t)) + (unless no-exit + (completion-complete-and-exit (minibuffer--completion-prompt-end) (point-max) + #'exit-minibuffer))) (defun completion-complete-and-exit (beg end exit-function) (completion--complete-and-exit @@ -3010,6 +3018,11 @@ Also respects the obsolete wrapper hook `completion-in-region-functions'. ;; completion-at-point called directly. "M-?" #'completion-help-at-point "TAB" #'completion-at-point + ;; If a completion is selected, RET will choose it. + "RET" `(menu-item "" minibuffer-choose-completion :filter + ,(lambda (cmd) + (when (completion--selected-candidate) + cmd))) "M-" #'minibuffer-previous-completion "M-" #'minibuffer-next-completion "M-RET" #'minibuffer-choose-completion) @@ -3216,6 +3229,17 @@ The completion method is determined by `completion-at-point-functions'." (define-key map "\n" 'exit-minibuffer) (define-key map "\r" 'exit-minibuffer)) +(defun minibuffer-completion-exit (&optional no-exit) + "Call `exit-minibuffer', inserting the selected completion first if any. + +If NO-EXIT is non-nil, don't `exit-minibuffer', just insert the selected +completion." + (interactive "P") + (when (completion--selected-candidate) + (minibuffer-choose-completion t t)) + (unless no-exit + (exit-minibuffer))) + (defvar-keymap minibuffer-local-completion-map :doc "Local keymap for minibuffer input with completion." :parent minibuffer-local-map @@ -3225,6 +3249,7 @@ The completion method is determined by `completion-at-point-functions'." ;; another binding for it. ;; "M-TAB" #'minibuffer-force-complete "SPC" #'minibuffer-complete-word + "RET" #'minibuffer-completion-exit "?" #'minibuffer-completion-help "" #'switch-to-completions "M-v" #'switch-to-completions @@ -3344,16 +3369,18 @@ and `RET' accepts the input typed into the minibuffer." (window-buffer (active-minibuffer-window))) window))) +(defun completion--selected-candidate () + "Return the selected completion candidate if any." + (when-let* ((window (minibuffer--completions-visible))) + (with-current-buffer (window-buffer window) + (get-text-property (point) 'completion--string)))) + (defun minibuffer-visible-completions--filter (cmd) "Return CMD if `minibuffer-visible-completions' bindings should be active." (if minibuffer-visible-completions--always-bind cmd (when-let* ((window (minibuffer--completions-visible))) - (when (if (eq cmd #'minibuffer-choose-completion-or-exit) - (with-current-buffer (window-buffer window) - (get-text-property (point) 'completion--string)) - t) - cmd)))) + cmd))) (defun minibuffer-visible-completions--bind (binding) "Use BINDING when completions are visible. @@ -3369,7 +3396,6 @@ displaying the *Completions* buffer exists." "" (minibuffer-visible-completions--bind #'minibuffer-next-completion) "" (minibuffer-visible-completions--bind #'minibuffer-previous-line-completion) "" (minibuffer-visible-completions--bind #'minibuffer-next-line-completion) - "RET" (minibuffer-visible-completions--bind #'minibuffer-choose-completion-or-exit) "C-g" (minibuffer-visible-completions--bind #'minibuffer-hide-completions)) ;;; Completion tables. @@ -5125,13 +5151,13 @@ and execute the forms." (completion--lazy-insert-strings) ,@body)))) -(defcustom minibuffer-completion-auto-choose t +(defcustom minibuffer-completion-auto-choose nil "Non-nil means to automatically insert completions to the minibuffer. When non-nil, then `minibuffer-next-completion' and `minibuffer-previous-completion' will insert the completion selected by these commands to the minibuffer." :type 'boolean - :version "29.1") + :version "31.1") (defun minibuffer-next-completion (&optional n vertical) "Move to the next item in its completions window from the minibuffer. diff --git a/lisp/simple.el b/lisp/simple.el index b0f6621b37e..2a13d59e5cd 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10570,28 +10570,24 @@ Called from `temp-buffer-show-hook'." ;; Maybe insert help string. (when completion-show-help (goto-char (point-min)) - (if minibuffer-visible-completions - (let ((helps - (with-current-buffer (window-buffer (active-minibuffer-window)) - (let ((minibuffer-visible-completions--always-bind t)) - (list - (substitute-command-keys - (if (display-mouse-p) - "Click or type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n" - "Type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n")) + (let ((helps + (with-current-buffer (window-buffer (active-minibuffer-window)) + (let ((minibuffer-visible-completions--always-bind t)) + (list + (substitute-command-keys + (if (display-mouse-p) + "Click or type \\[minibuffer-choose-completion] on a completion to select it.\n" + "Type \\[minibuffer-choose-completion] on a completion to select it.\n")) + (if minibuffer-visible-completions (substitute-command-keys "Type \\[minibuffer-next-completion], \\[minibuffer-previous-completion], \ \\[minibuffer-next-line-completion], \\[minibuffer-previous-line-completion] \ -to move point between completions.\n\n")))))) - (dolist (help helps) - (insert help))) - (insert (substitute-command-keys - (if (display-mouse-p) - "Click or type \\[minibuffer-choose-completion] on a completion to select it.\n" - "Type \\[minibuffer-choose-completion] on a completion to select it.\n"))) - (insert (substitute-command-keys - "Type \\[minibuffer-next-completion] or \\[minibuffer-previous-completion] \ +to move point between completions.\n\n") + (substitute-command-keys + "Type \\[minibuffer-next-completion] or \\[minibuffer-previous-completion] \ to move point between completions.\n\n"))))))) + (dolist (help helps) + (insert help))))))) (add-hook 'completion-setup-hook #'completion-setup-function) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index c2c37e63012..99753f31330 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -433,6 +433,17 @@ 15))) +(defmacro with-minibuffer-setup (completing-read &rest body) + (declare (indent 1) (debug (collection body))) + `(catch 'result + (minibuffer-with-setup-hook + (lambda () + (let ((redisplay-skip-initial-frame nil) + (executing-kbd-macro nil)) ; Don't skip redisplay + (throw 'result (progn . ,body)))) + (let ((executing-kbd-macro t)) ; Force the real minibuffer + ,completing-read)))) + (defmacro completing-read-with-minibuffer-setup (collection &rest body) (declare (indent 1) (debug (collection body))) `(catch 'result @@ -569,6 +580,7 @@ (ert-deftest completions-header-format-test () (let ((completion-show-help nil) + (minibuffer-completion-auto-choose t) (completions-header-format nil)) (completing-read-with-minibuffer-setup '("aa" "ab" "ac") @@ -718,11 +730,50 @@ (should (equal (minibuffer-contents) "ccc"))))) (ert-deftest minibuffer-next-completion () - (let ((default-directory (ert-resource-directory))) + (let ((default-directory (ert-resource-directory)) + (minibuffer-completion-auto-choose t)) (completing-read-with-minibuffer-setup #'read-file-name-internal (insert "d/") (execute-kbd-macro (kbd "M- M- M-")) (should (equal "data/minibuffer-test-cttq$$tion" (minibuffer-contents)))))) +(ert-deftest minibuffer-completion-RET-prefix () + ;; REQUIRE-MATCH=nil + (with-minibuffer-setup + (completing-read ":" '("aaa" "bbb" "ccc") nil nil) + (execute-kbd-macro (kbd "M- M- C-u RET")) + (should (equal "bbb" (minibuffer-contents)))) + ;; REQUIRE-MATCH=t + (with-minibuffer-setup + (completing-read ":" '("aaa" "bbb" "ccc") nil t) + (execute-kbd-macro (kbd "M- M- C-u RET")) + (should (equal "bbb" (minibuffer-contents))))) + +(defun test/completion-at-point () + (list (point-min) (point) '("test:a" "test:b"))) + +(ert-deftest completion-in-region-next-completion () + (with-current-buffer (get-buffer-create "*test*") + ;; Put this buffer in the selected window so + ;; `minibuffer--completions-visible' works. + (pop-to-buffer (current-buffer)) + (setq-local completion-at-point-functions (list #'test/completion-at-point)) + (insert "test:") + (completion-help-at-point) + (should (minibuffer--completions-visible)) + ;; C-u RET and RET have basically the same behavior for + ;; completion-in-region-mode, since they both dismiss *Completions* + ;; while leaving completion-in-region-mode still active. + (execute-kbd-macro (kbd "M-")) + (should (equal (completion--selected-candidate) "test:a")) + (execute-kbd-macro (kbd "C-u RET")) + (should (equal (buffer-string) "test:a")) + (delete-char -1) + (completion-help-at-point) + (execute-kbd-macro (kbd "M- M-")) + (should (equal (completion--selected-candidate) "test:b")) + (execute-kbd-macro (kbd "RET")) + (should (equal (buffer-string) "test:b")))) + (provide 'minibuffer-tests) ;;; minibuffer-tests.el ends here From 088c53175429c4cfd8be4c3c24438494ce205a23 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 28 Aug 2025 03:16:35 +0300 Subject: [PATCH 106/158] ruby-flymake-simple: Refine further * lisp/progmodes/ruby-mode.el (ruby-flymake-simple): Relax regexp but limit allowed characters (bug#79257). --- lisp/progmodes/ruby-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 0a6ead870a7..459f8f338f7 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -2516,7 +2516,7 @@ A slash character after any of these should begin a regexp.")) (goto-char (point-min)) (cl-loop while (search-forward-regexp - "^\\(?:ruby: \\)?\\(?:.*\\.rb\\|-\\):\\([0-9]+\\): \\(.*\\)$" + "^\\(?:[^:|]+: \\)?\\(?:.*\\.rb\\|-\\):\\([0-9]+\\): \\(.*\\)$" nil t) for msg = (match-string 2) for (beg . end) = (flymake-diag-region From ec50d775acf6efa6e11347efecaa93d039cc5700 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 28 Aug 2025 08:58:17 +0300 Subject: [PATCH 107/158] ; * doc/misc/flymake.texi (Finding diagnostics): Fix a typo (bug#79325). --- doc/misc/flymake.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 54835767928..65c10588f39 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -152,7 +152,7 @@ variables}) @cindex next and previous diagnostic If the diagnostics are outside the visible region of the buffer, -@code{flymake-goto-next-error} and @code{flymake-goto-prev-error} are +@code{flymake-goto-next-error} and @code{flymake-goto-prev-error} let you navigate to the next/previous erroneous regions, respectively. It might be a good idea to map them to @kbd{M-n} and @kbd{M-p} in @code{flymake-mode}, by adding to your init file: From b5ec833bc8c6d06a5c57409f37175d0cace715ab Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 28 Aug 2025 09:09:18 +0300 Subject: [PATCH 108/158] * lisp/tab-bar.el (frameset-session-filter-tabs): New function. Push new function to 'frameset-session-filter-alist' with 'tabs' key (bug#79291). --- lisp/tab-bar.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 4c585985fb6..db16775d884 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1469,6 +1469,14 @@ be scaled for display on the current frame." (push '(tabs . frameset-filter-tabs) frameset-filter-alist) +;; Session filter used within same session by `frameset-to-register' +;; should make a deep copy of tabs to prevent modification +;; of saved data. +(defun frameset-session-filter-tabs (current _filtered _parameters _saving) + (copy-tree current)) + +(push '(tabs . frameset-session-filter-tabs) frameset-session-filter-alist) + (defun tab-bar--tab (&optional frame) "Make a new tab data structure that can be added to tabs on the FRAME." (let* ((tab (tab-bar--current-tab-find nil frame)) From 81267db01dfab3d9f24ff12359db3577efdf9ccf Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Fri, 22 Aug 2025 17:19:09 -0400 Subject: [PATCH 109/158] Pass dired default filenames via defaults argument Rather than using minibuffer-with-setup-hook, just pass the list of default file names as a regular argument to read-file-name. This allows read-file-name to run abbreviate-file-name on the defaults as it normally does, instead of the defaults appearing in expanded form. dired-dwim-target-defaults changes slightly to return the correct default at the start of the list. * lisp/dired-aux.el (dired-do-create-files) (dired-compare-directories): Pass default file names as an argument. (bug#79293) (dired-dwim-target-defaults): Return the correct default at the start of the list. --- lisp/dired-aux.el | 51 +++++++++++++++++++---------------------------- 1 file changed, 20 insertions(+), 31 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 049d200f590..e28106d9865 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -330,14 +330,13 @@ only in the active region if `dired-mark-region' is non-nil." (interactive (list (let* ((target-dir (dired-dwim-target-directory)) - (defaults (dired-dwim-target-defaults nil target-dir))) + (defaults (dired-dwim-target-defaults nil target-dir))) (minibuffer-with-setup-hook (lambda () - (setq-local minibuffer-default-add-function nil) - (setq minibuffer-default defaults)) + (setq-local minibuffer-default-add-function nil)) (read-directory-name (format "Compare %s with: " (dired-current-directory)) - target-dir target-dir t))) + target-dir defaults t))) (read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil")) dired-mode) (let* ((dir1 (dired-current-directory)) @@ -2668,17 +2667,12 @@ Optional arg HOW-TO determines how to treat the target. (dired-one-file ; fluid variable inside dired-create-files (and (consp fn-list) (null (cdr fn-list)) (car fn-list))) (target-dir (dired-dwim-target-directory)) - (default (and dired-one-file - (not dired-dwim-target) ; Bug#25609 - (expand-file-name (file-name-nondirectory - (car fn-list)) - target-dir))) (defaults (dired-dwim-target-defaults fn-list target-dir)) (target (expand-file-name ; fluid variable inside dired-create-files (minibuffer-with-setup-hook (lambda () - (setq-local minibuffer-default-add-function nil) - (setq minibuffer-default defaults)) + ;; Don't run `read-file-name--defaults' + (setq-local minibuffer-default-add-function nil)) (dired-mark-read-file-name (format "%s %%s %s: " (if dired-one-file op1 operation) @@ -2688,7 +2682,7 @@ Optional arg HOW-TO determines how to treat the target. ;; other operations copy (etc) to the ;; prompted file name. "from" "to")) - target-dir op-symbol arg rfn-list default)))) + target-dir op-symbol arg rfn-list defaults)))) (into-dir (progn (when @@ -2813,28 +2807,26 @@ Optional arg HOW-TO determines how to treat the target. this-dir))) (defun dired-dwim-target-defaults (fn-list target-dir) - ;; Return a list of default values for file-reading functions in Dired. - ;; This list may contain directories from Dired buffers in other windows. - ;; `fn-list' is a list of file names used to build a list of defaults. - ;; When nil or more than one element, a list of defaults will - ;; contain only directory names. `target-dir' is a directory name - ;; to exclude from the returned list, for the case when this - ;; directory name is already presented in initial input. - ;; For Dired operations that support `dired-dwim-target', - ;; the argument `target-dir' should have the value returned - ;; from `dired-dwim-target-directory'. + "Return a list of default values for file-reading functions in Dired. + +This list may contain directories from Dired buffers in other windows. +FN-LIST is a list of file names used to build a list of defaults. +When nil or more than one element, a list of defaults will +contain only directory names. + +TARGET-DIR should be the initial input in the minibuffer for the +file-reading function. For Dired operations that support +`dired-dwim-target', TARGET-DIR should have the value returned from +`dired-dwim-target-directory'." (let ((dired-one-file (and (consp fn-list) (null (cdr fn-list)) (car fn-list))) (current-dir (and (eq major-mode 'dired-mode) (dired-current-directory))) ;; Get a list of directories of visible buffers in dired-mode. (dired-dirs (dired-dwim-target-directories))) - ;; Force the current dir to be the first in the list. + ;; Force TARGET-DIR then CURRENT-DIR to be first in the list. (setq dired-dirs - (delete-dups (delq nil (cons current-dir dired-dirs)))) - ;; Remove the target dir (if specified) or the current dir from - ;; default values, because it should be already in initial input. - (setq dired-dirs (delete (or target-dir current-dir) dired-dirs)) + (delete-dups (delq nil (cons target-dir (cons current-dir dired-dirs))))) ;; Return a list of default values. (if dired-one-file ;; For one file operation, provide a list that contains @@ -2847,10 +2839,7 @@ Optional arg HOW-TO determines how to treat the target. (mapcar (lambda (dir) (expand-file-name (file-name-nondirectory (car fn-list)) dir)) - (reverse dired-dirs)) - (list (expand-file-name - (file-name-nondirectory (car fn-list)) - (or target-dir current-dir)))) + (reverse dired-dirs))) ;; For multi-file operation, return only a list of other directories. dired-dirs))) From 62e0cde96712abb3d830d1cd9384925c8c6d3755 Mon Sep 17 00:00:00 2001 From: Arash Esbati Date: Thu, 28 Aug 2025 11:50:26 +0200 Subject: [PATCH 110/158] ; Delete unnecessary backslashes * doc/misc/reftex.texi (Options - Creating Citations): Delete unnecessary backslashes. --- doc/misc/reftex.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi index 40ffbac737d..33e1cee8d3c 100644 --- a/doc/misc/reftex.texi +++ b/doc/misc/reftex.texi @@ -4507,7 +4507,7 @@ The keymap which is active in the labels selection process @defopt reftex-bibfile-ignore-regexps List of regular expressions to exclude files in -@code{\\bibliography@{..@}}. File names matched by any of these regexps +@code{\bibliography@{..@}}. File names matched by any of these regexps will not be parsed. Intended for files which contain only @code{@@string} macro definitions and the like, which are ignored by @RefTeX{} anyway. @@ -4605,7 +4605,7 @@ return the string to insert into the buffer. @defopt reftex-cite-prompt-optional-args Non-@code{nil} means, prompt for empty optional arguments in cite macros. When an entry in @code{reftex-cite-format} is given with square brackets to -indicate optional arguments (for example @samp{\\cite[][]@{%l@}}), RefTeX can +indicate optional arguments (for example @samp{\cite[][]@{%l@}}), RefTeX can prompt for values. Possible values are: @example nil @r{Never prompt for optional arguments} @@ -4658,7 +4658,7 @@ The keymap which is active in the citation-key selection process @end deffn @defopt reftex-cite-key-separator -String used to separate several keys in a single @samp{\\cite} macro. +String used to separate several keys in a single @samp{\cite} macro. Per default this is @samp{","} but if you often have to deal with a lot of entries and need to break the macro across several lines you might want to change it to @samp{", "}. From 972e4f4a7f4fe6e2fafbdc5fe68640a166bce2bb Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Mon, 4 Aug 2025 17:40:04 +0200 Subject: [PATCH 111/158] Prefer tls to ssl in nnimap and smtpmail code * lisp/gnus/nnimap.el (nnimap-open-connection): Use 'tls. (nnimap-open-connection-1): Check 'tls before 'ssl. * lisp/mail/smtpmail.el (smtpmail-stream-type): Add 'ssl to allowed values, state 'tls is preferred. --- lisp/gnus/nnimap.el | 9 +++++---- lisp/mail/smtpmail.el | 7 +++++-- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 566c3e3fba4..2eb6751a211 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -448,13 +448,14 @@ during splitting, which may be slow." (defun nnimap-open-connection (buffer) ;; Be backwards-compatible -- the earlier value of nnimap-stream was - ;; `ssl' when nnimap-server-port was nil. Sort of. + ;; `ssl' when nnimap-server-port was nil. Sort of. But it's `tls' + ;; now, because we're post the Great 2025 Spelling Reform. (when (and nnimap-server-port (eq nnimap-stream 'undecided)) - (setq nnimap-stream 'ssl)) + (setq nnimap-stream 'tls)) (let ((stream (if (eq nnimap-stream 'undecided) - (cl-loop for type in '(ssl network) + (cl-loop for type in '(tls network) for stream = (let ((nnimap-stream type)) (nnimap-open-connection-1 buffer)) while (eq stream 'no-connect) @@ -493,7 +494,7 @@ during splitting, which may be slow." (nnheader-message 7 "Opening connection to %s via shell..." nnimap-address) '("imap")) - ((memq nnimap-stream '(ssl tls)) + ((memq nnimap-stream '(tls ssl)) (nnheader-message 7 "Opening connection to %s via tls..." nnimap-address) '("imaps" "imap" "993" "143")) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 2461ddcfd0d..2acb48438ec 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -99,12 +99,15 @@ don't define this value." "Type of SMTP connections to use. This may be either nil (upgrade with STARTTLS if possible), `starttls' (refuse to send if STARTTLS isn't available), -`plain' (never use STARTTLS), or `ssl' (to use TLS/SSL)." +`plain' (never use STARTTLS), or `tls' (to use TLS/SSL). +`ssl' is accepted as a backwards-compatible equivalent +to `tls'" :version "24.1" :type '(choice (const :tag "Possibly upgrade to STARTTLS" nil) (const :tag "Always use STARTTLS" starttls) (const :tag "Never use STARTTLS" plain) - (const :tag "Use TLS/SSL" ssl))) + (const :tag "Use TLS/SSL" tls) + (const :tag "Use TLS/SSL (old name)" ssl))) (defcustom smtpmail-sendto-domain nil "Local domain name without a host name. From bba28b744c0f3fda20d66d0a054917db2c0a2529 Mon Sep 17 00:00:00 2001 From: john muhl Date: Fri, 29 Aug 2025 09:47:24 +0200 Subject: [PATCH 112/158] Make 'lua-prefix-key' option a 'key-sequence' This fixes a failure in 'test-custom-opts' caused by both strings and integers being used for 'lua-prefix-key'. * lisp/progmodes/lua-mode.el (lua-prefix-key): Convert option to 'key-sequence' type. (lua-mode-map, lua-prefix-key-update-bindings, lua-set-prefix-key) (lua--customize-set-prefix-key): Adjust to the change of type for 'lua-prefix-key'. (lua-prefix-mode-map): Use 'defvar-keymap'. (Bug#79335) --- lisp/progmodes/lua-mode.el | 63 +++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 32 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 2e051d6d552..d65154a38cd 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -210,37 +210,21 @@ Should be a list of strings." (defvar lua-process-buffer nil "Buffer used for communication with the Lua process.") -(defun lua--customize-set-prefix-key (prefix-key-sym prefix-key-val) - "Set PREFIX-KEY-SYM to PREFIX-KEY-VAL." - (unless (eq prefix-key-sym 'lua-prefix-key) - (error "Prefix doesn't match lua-prefix-key")) - (set prefix-key-sym (when (and prefix-key-val (> (length prefix-key-val) 0)) - ;; read-kbd-macro returns a string or a vector - ;; in both cases (elt x 0) is ok - (elt (read-kbd-macro prefix-key-val) 0))) - (when (fboundp 'lua-prefix-key-update-bindings) - (lua-prefix-key-update-bindings))) - (defcustom lua-prefix-key "\C-c" "Prefix for all `lua-mode' commands." - :type 'string - :set 'lua--customize-set-prefix-key + :type 'key-sequence + :initialize #'custom-initialize-default + :set #'lua--customize-set-prefix-key :get (lambda (sym) - (if-let* ((val (eval sym))) (single-key-description val) "")) + (let ((prefix-key (symbol-value sym))) + (if (eq 'ignore prefix-key) "" prefix-key))) :version "31.1") -(defvar lua-prefix-mode-map - (eval-when-compile - (let ((result-map (make-sparse-keymap))) - (mapc (lambda (key_defn) - (define-key - result-map (read-kbd-macro (car key_defn)) (cdr key_defn))) - '(("C-l" . lua-send-buffer) - ("C-f" . lua-search-documentation))) - result-map)) - "Keymap that is used to define keys accessible by `lua-prefix-key'. - -If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") +(defvar-keymap lua-prefix-mode-map + :doc "Keymap that is used to define keys accessible by `lua-prefix-key'. +If the latter is nil, the keymap translates into `lua-mode-map' verbatim." + "C-l" #'lua-send-buffer + "C-f" #'lua-search-documentation) (defvar lua--electric-indent-chars (mapcar #'string-to-char '("}" "]" ")"))) @@ -261,11 +245,27 @@ If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") ;; defined look it up in prefix-map ;; * if prefix is set, bind the prefix-map to that key (if lua-prefix-key - (define-key result-map (vector lua-prefix-key) lua-prefix-mode-map) + (define-key result-map lua-prefix-key lua-prefix-mode-map) (set-keymap-parent result-map lua-prefix-mode-map)) result-map) "Keymap used in `lua-mode' buffers.") +(defun lua--customize-set-prefix-key (prefix-key-sym prefix-key-val) + "Set PREFIX-KEY-SYM to PREFIX-KEY-VAL." + (unless (eq prefix-key-sym 'lua-prefix-key) + (error "Prefix doesn't match lua-prefix-key")) + (define-key lua-mode-map lua-prefix-key nil) + ;; `lua-set-prefix-key' uses an empty string to remove the prefix. + (when (and (equal 'string (type-of prefix-key-val)) + (string-blank-p prefix-key-val)) + (setq prefix-key-val (vector #'ignore))) + (if (eq 'ignore (elt prefix-key-val 0)) + (set-keymap-parent lua-mode-map lua-prefix-mode-map) + (define-key lua-mode-map prefix-key-val lua-prefix-mode-map)) + (set-default prefix-key-sym prefix-key-val) + (when (fboundp 'lua-prefix-key-update-bindings) + (lua-prefix-key-update-bindings))) + (defvar-local lua-electric-flag t "Non-nil means electric actions are enabled.") @@ -612,18 +612,17 @@ The arguments JUSTIFY and REGION control `fill-paragraph' (which see)." ;; Otherwise, look for it among children (when-let* ((old-cons (rassoc lua-prefix-mode-map lua-mode-map))) (delq old-cons lua-mode-map))) - (if (null lua-prefix-key) + (if (eq 'ignore (elt lua-prefix-key 0)) (set-keymap-parent lua-mode-map lua-prefix-mode-map) - (define-key lua-mode-map (vector lua-prefix-key) lua-prefix-mode-map))) + (define-key lua-mode-map lua-prefix-key lua-prefix-mode-map))) (defun lua-set-prefix-key (new-key-str) "Change `lua-prefix-key' to NEW-KEY-STR and update keymaps. This function replaces previous prefix-key binding with a new one." (interactive "sNew prefix key (empty string means no key): ") - (lua--customize-set-prefix-key 'lua-prefix-key new-key-str) - (message "Prefix key set to %S" (single-key-description lua-prefix-key)) - (lua-prefix-key-update-bindings)) + (lua--customize-set-prefix-key 'lua-prefix-key (kbd new-key-str)) + (message "Prefix key set to %S" lua-prefix-key)) (defun lua-string-p (&optional pos) "Return non-nil if point or POS is in a string." From bebba6be3da6544ec5d8051d74a976dcd52314ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 29 Aug 2025 10:55:21 +0200 Subject: [PATCH 113/158] Fix org-habit bug related to string mutation * lisp/org/org-habit.el (org-habit-build-graph): Rewrite without using string mutation (using vectors instead), fixing a bug where org-habit-completed-glyph and org-habit-today-glyph wouldn't display properly if in the U+0080..00FF range, discovered by the more restricted string mutation. Reported by Daniel Mendler in https://lists.gnu.org/archive/html/emacs-orgmode/2025-08/msg00224.html --- lisp/org/org-habit.el | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 38975682152..010c9daa00e 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -333,7 +333,8 @@ current time." (start (time-to-days starting)) (now (time-to-days current)) (end (time-to-days ending)) - (graph (make-string (1+ (- end start)) ?\s)) + (graph (make-vector (1+ (- end start)) ?\s)) + (props nil) (index 0) last-done-date) (while (and done-dates (< (car done-dates) start)) @@ -411,17 +412,20 @@ current time." (not (eq face 'org-habit-overdue-face)) (not markedp)) (setq face (cdr faces))) - (put-text-property index (1+ index) 'face face graph) - (put-text-property index (1+ index) - 'help-echo - (concat (format-time-string - (org-time-stamp-format) - (time-add starting (days-to-time (- start (time-to-days starting))))) - (if donep " DONE" "")) - graph)) + (push (list index (1+ index) 'face face) props) + (push (list index (1+ index) + 'help-echo + (concat (format-time-string + (org-time-stamp-format) + (time-add starting (days-to-time (- start (time-to-days starting))))) + (if donep " DONE" ""))) + props)) (setq start (1+ start) index (1+ index))) - graph)) + (let ((graph-str (concat graph))) + (dolist (p props) + (put-text-property (nth 0 p) (nth 1 p) (nth 2 p) (nth 3 p) graph-str)) + graph-str))) (defun org-habit-insert-consistency-graphs (&optional line) "Insert consistency graph for any habitual tasks." From 95232f556ed70a39c2c5c24868b8a4aaf0e82484 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 29 Aug 2025 13:47:51 +0200 Subject: [PATCH 114/158] `Fix read-directory-name' for Tramp files * lisp/minibuffer.el (completion-file-name-table): Improve bypass for directory checking. (Bug#79236) * lisp/net/tramp.el (tramp-user-regexp): Exclude "[" and "]". (tramp-completion-make-tramp-file-name): Handle port for IPv6 hosts. (tramp-completion-handle-file-directory-p) (tramp-completion-handle-file-exists-p): Simplify. (tramp-completion-handle-file-name-completion): Ignore PREDICATE. (tramp-completion-dissect-file-name): Handle ports. (tramp-parse-default-user-host): Suppress '(nil nil) result. (tramp-parse-file): Delete duplicates. (tramp-parse-shosts-group): Accept also IPv6 addresses. (tramp-handle-file-directory-p): Return t for filenames "/method:foo:". (tramp-parse-auth-sources, tramp-parse-netrc): * lisp/net/tramp-cache.el (tramp-parse-connection-properties): * lisp/net/tramp-gvfs.el (tramp-gvfs-parse-device-names): Use `tramp-compat-seq-keep'. * test/lisp/net/tramp-tests.el (edebug-mode): Declare. (tramp--test-message): Write also trace value. (tramp-test26-file-name-completion): (tramp-test26-interactive-file-name-completion): Extend tests. --- lisp/minibuffer.el | 8 +- lisp/net/tramp-cache.el | 23 ++-- lisp/net/tramp-compat.el | 2 +- lisp/net/tramp-gvfs.el | 2 +- lisp/net/tramp.el | 229 +++++++++++++++++++++++------------ test/lisp/net/tramp-tests.el | 187 +++++++++++++++++++--------- 6 files changed, 303 insertions(+), 148 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 55b6d79a813..64eb5d93fe6 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3522,9 +3522,15 @@ same as `substitute-in-file-name'." (unless (memq pred '(nil file-exists-p)) (let ((comp ()) (pred - (if (eq pred 'file-directory-p) + (if (and (eq pred 'file-directory-p) + (not (string-match-p + (or (bound-and-true-p + tramp-completion-file-name-regexp) + (rx unmatchable)) + string))) ;; Brute-force speed up for directory checking: ;; Discard strings which don't end in a slash. + ;; Unless it is a Tramp construct like "/ssh:". (lambda (s) (let ((len (length s))) (and (> len 0) (eq (aref s (1- len)) ?/)))) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 721b7be123f..4ecc804bf20 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -647,17 +647,18 @@ your laptop to different networks frequently." "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from connection history." - (mapcar - (lambda (key) - (let ((tramp-verbose 0)) - (and (tramp-file-name-p key) - (string-equal method (tramp-file-name-method key)) - (not (tramp-file-name-localname key)) - (tramp-get-method-parameter - key 'tramp-completion-use-cache tramp-completion-use-cache) - (list (tramp-file-name-user key) - (tramp-file-name-host key))))) - (hash-table-keys tramp-cache-data))) + (delete-dups + (tramp-compat-seq-keep + (lambda (key) + (let ((tramp-verbose 0)) + (and (tramp-file-name-p key) + (string-equal method (tramp-file-name-method key)) + (not (tramp-file-name-localname key)) + (tramp-get-method-parameter + key 'tramp-completion-use-cache tramp-completion-use-cache) + (list (tramp-file-name-user key) + (tramp-file-name-host key))))) + (hash-table-keys tramp-cache-data)))) ;; When "emacs -Q" has been called, both variables are nil. We do not ;; load the persistency file then, in order to have a clean test environment. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 5db8f1f61da..feda8943be5 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -251,7 +251,7 @@ value is the default binding of the variable." ;; ;; * Use `ensure-list'. ;; -;; * Starting with Emacs 29.1, use `buffer-match-p'. +;; * Starting with Emacs 29.1, use `buffer-match-p' and `match-buffers'. ;; ;; * Starting with Emacs 29.1, use `string-split'. ;; diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index b5f1135a60d..7f3ac945bb6 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2557,7 +2557,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." (shell-command-to-string (format "avahi-browse -trkp %s" service)) (rx (+ (any "\r\n"))) 'omit (rx bol "+;" (* nonl) eol))))) (delete-dups - (mapcar + (tramp-compat-seq-keep (lambda (x) (ignore-errors (let* ((list (split-string x ";")) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e80a470957f..1b9efd3dab6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -103,9 +103,9 @@ (put 'tramp--startup-hook 'tramp-suppress-trace t) - ;; TODO: once (autoload-macro expand) is available in all supported - ;; Emacs versions, this can be eliminated: - ;; backward compatibility for autoload-macro declare form + ;; TODO: Once (autoload-macro expand) is available in all supported + ;; Emacs versions (Emacs 31.1+), this can be eliminated: + ;; Backward compatibility for autoload-macro declare form. (unless (assq 'autoload-macro macro-declarations-alist) (push '(autoload-macro ignore) macro-declarations-alist)) @@ -1047,7 +1047,7 @@ Used in `tramp-make-tramp-file-name'.") "Regexp matching delimiter between method and user or host names. Derived from `tramp-postfix-method-format'.") -(defconst tramp-user-regexp (rx (+ (not (any "/:|" blank)))) +(defconst tramp-user-regexp (rx (+ (not (any "/:|[]" blank)))) "Regexp matching user names.") (defconst tramp-prefix-domain-format "%" @@ -2001,10 +2001,21 @@ necessary only. This function will be used in file name completion." (concat user tramp-postfix-user-format)) (unless (tramp-string-empty-or-nil-p host) (concat - (if (string-match-p tramp-ipv6-regexp host) - (concat - tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) - host) + (cond + (;; ipv6#port -> [ipv6]#port + (string-match + (rx (group (regexp tramp-ipv6-regexp)) + (group (regexp tramp-prefix-port-regexp) + (regexp tramp-port-regexp))) + host) + (concat + tramp-prefix-ipv6-format (match-string 1 host) + tramp-postfix-ipv6-format (match-string 2 host))) + (;; ipv6 -> [ipv6] + (string-match-p tramp-ipv6-regexp host) + (concat + tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)) + (t host)) tramp-postfix-host-format)) localname)) @@ -2910,31 +2921,6 @@ not in completion mode." ;; We need special handling only when a method is needed. Then we ;; regard all files "/method:" or "/[method/" as existent, if ;; "method" is a valid Tramp method. - (or (string-equal filename "/") - (and ;; Is it a valid method? - (not (string-empty-p tramp-postfix-method-format)) - (string-match - (rx - (regexp tramp-prefix-regexp) - (* (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)) - (group-n 9 (regexp tramp-method-regexp)) - (? (regexp tramp-postfix-method-regexp)) - eos) - filename) - (assoc (match-string 9 filename) tramp-methods) - t) - - (tramp-run-real-handler #'file-directory-p (list filename)))) - -(defun tramp-completion-handle-file-exists-p (filename) - "Like `file-exists-p' for partial Tramp files." - ;; We need special handling only when a method is needed. Then we - ;; regard all files "/method:" or "/[method/" as existent, if - ;; "method" is a valid Tramp method. And we regard all files - ;; "/method:user@", "/user@" or "/[method/user@" as existent, if - ;; "user@" is a valid file name completion. Host completion is - ;; performed in the respective backend operation. (or (and (cond ;; Completion styles like `flex' and `substring' check for ;; the file name "/". This does exist. @@ -2947,28 +2933,37 @@ not in completion mode." (* (regexp tramp-remote-file-name-spec-regexp) (regexp tramp-postfix-hop-regexp)) (group-n 9 (regexp tramp-method-regexp)) - (? (regexp tramp-postfix-method-regexp)) - eos) + (| (regexp tramp-postfix-method-regexp) eos)) filename)) (assoc (match-string 9 filename) tramp-methods)) - ;; Is it a valid user? - ((string-match - (rx - (regexp tramp-prefix-regexp) - (* (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)) - (group-n 10 - (regexp tramp-method-regexp) - (regexp tramp-postfix-method-regexp)) - (group-n 11 - (regexp tramp-user-regexp) - (regexp tramp-postfix-user-regexp)) - eos) - filename) - (member - (match-string 11 filename) - (file-name-all-completions - "" (concat tramp-prefix-format (match-string 10 filename)))))) + ;; Is it a completion file name? + ((string-match-p tramp-completion-file-name-regexp filename))) + t) + + (tramp-run-real-handler #'file-directory-p (list filename)))) + +(defun tramp-completion-handle-file-exists-p (filename) + "Like `file-exists-p' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; regard all files "/method:" or "/[method/" as existent, if + ;; "method" is a valid Tramp method. + (or (and (cond + ;; Completion styles like `flex' and `substring' check for + ;; the file name "/". This does exist. + ((string-equal filename "/")) + ;; Is it a valid method? + ((and (not (string-empty-p tramp-postfix-method-format)) + (string-match + (rx + (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (group-n 9 (regexp tramp-method-regexp)) + (| (regexp tramp-postfix-method-regexp) eos)) + filename)) + (assoc (match-string 9 filename) tramp-methods)) + ;; Is it a completion file name? + ((string-match-p tramp-completion-file-name-regexp filename))) t) (tramp-run-real-handler #'file-exists-p (list filename)))) @@ -3083,15 +3078,14 @@ BODY is the backend specific code." ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion - (filename directory &optional predicate) - "Like `file-name-completion' for partial Tramp files." + (filename directory &optional _predicate) + "Like `file-name-completion' for partial Tramp files. +It ignores PREDICATE, because there's no meaningful result." ;; Suppress eager completion on not connected hosts. (let ((non-essential t)) (try-completion filename - (mapcar #'list (file-name-all-completions filename directory)) - (when (and predicate (tramp-connectable-p directory)) - (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))) + (mapcar #'list (file-name-all-completions filename directory))))) ;; I misuse a little bit the `tramp-file-name' structure in order to ;; handle completion possibilities for partial methods / user names / @@ -3113,7 +3107,15 @@ BODY is the backend specific code." (defun tramp-completion-dissect-file-name (name) "Return a list of `tramp-file-name' structures for NAME. They are collected by `tramp-completion-dissect-file-name1'." - (let (;; "/method" "/[method" + ;; We don't need a special handling for "user%domain", because "%" + ;; is also hit by `tramp-user-regexp'. "host#port" is normalized + ;; for IPv6 hosts. + (let ((internal-name + (replace-regexp-in-string + (rx (regexp tramp-postfix-ipv6-regexp) + (regexp tramp-prefix-port-regexp)) + tramp-prefix-port-format name)) + ;; "/method" "/[method" (tramp-completion-file-name-structure1 (list (rx @@ -3170,16 +3172,75 @@ They are collected by `tramp-completion-dissect-file-name1'." (regexp tramp-postfix-user-regexp) (regexp tramp-prefix-ipv6-regexp) (group (? (regexp tramp-ipv6-regexp))) eol) + 1 2 3 nil)) + ;; "/method:host#port" "/[method/host#port" + (tramp-completion-file-name-structure7 + (list + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-host-regexp) + (regexp tramp-prefix-port-regexp) + (? (regexp tramp-port-regexp))) + eol) + 1 nil 2 nil)) + ;; "/method:[ipv6]#port" "/[method/ipv6#port" + (tramp-completion-file-name-structure8 + (list + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (regexp tramp-ipv6-regexp) + (regexp tramp-prefix-port-regexp) + (? (regexp tramp-port-regexp))) + eol) + 1 nil 2 nil)) + ;; "/method:user@host#port" "/[method/user@host#port" + (tramp-completion-file-name-structure9 + (list + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (group (regexp tramp-host-regexp) + (regexp tramp-prefix-port-regexp) + (? (regexp tramp-port-regexp))) + eol) + 1 2 3 nil)) + ;; "/method:user@[ipv6]#port" "/[method/user@ipv6#port" + (tramp-completion-file-name-structure10 + (list + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (regexp tramp-ipv6-regexp) + (regexp tramp-prefix-port-regexp) + (? (regexp tramp-port-regexp))) + eol) 1 2 3 nil))) (tramp-compat-seq-keep - (lambda (structure) (tramp-completion-dissect-file-name1 structure name)) + (lambda (structure) + (tramp-completion-dissect-file-name1 structure internal-name)) (list tramp-completion-file-name-structure1 tramp-completion-file-name-structure2 tramp-completion-file-name-structure3 tramp-completion-file-name-structure4 tramp-completion-file-name-structure5 - tramp-completion-file-name-structure6)))) + tramp-completion-file-name-structure6 + tramp-completion-file-name-structure7 + tramp-completion-file-name-structure8 + tramp-completion-file-name-structure9 + tramp-completion-file-name-structure10)))) (defun tramp-completion-dissect-file-name1 (structure name) "Return a `tramp-file-name' structure for NAME matching STRUCTURE. @@ -3281,7 +3342,10 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from default settings." - `((,(tramp-find-user method nil nil) ,(tramp-find-host method nil nil)))) + (let ((user (tramp-find-user method nil nil)) + (host (tramp-find-host method nil nil))) + (when (or user host) + `(,user ,host)))) ;;;###tramp-autoload (defcustom tramp-completion-multi-hop-methods nil @@ -3303,10 +3367,11 @@ as for \"~/.authinfo.gpg\"." This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from default settings." (and tramp-completion-use-auth-sources - (mapcar - (lambda (x) `(,(plist-get x :user) ,(plist-get x :host))) - (auth-source-search - :port method :require '(:port) :max most-positive-fixnum)))) + (delete-dups + (tramp-compat-seq-keep + (lambda (x) `(,(plist-get x :user) ,(plist-get x :host))) + (auth-source-search + :port method :require '(:port) :max most-positive-fixnum))))) ;; Generic function. (defun tramp-parse-group (regexp match-level skip-chars) @@ -3331,7 +3396,8 @@ User is always nil." (with-temp-buffer (insert-file-contents-literally filename) (goto-char (point-min)) - (cl-loop while (not (eobp)) collect (funcall function)))))) + (delete-dups (delq nil + (cl-loop while (not (eobp)) collect (funcall function)))))))) (defun tramp-parse-rhosts (filename) "Return a list of (user host) tuples allowed to access. @@ -3359,7 +3425,9 @@ User is always nil." (defun tramp-parse-shosts-group () "Return a (user host) tuple allowed to access. User is always nil." - (tramp-parse-group (rx bol (group (regexp tramp-host-regexp))) 1 ",")) + (tramp-parse-group + (rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) + 1 ",")) (defun tramp-parse-sconfig (filename) "Return a list of (user host) tuples allowed to access. @@ -3465,11 +3533,12 @@ Host is always \"localhost\"." (defun tramp-parse-netrc (filename) "Return a list of (user host) tuples allowed to access. User may be nil." - (mapcar - (lambda (item) - (and (assoc "machine" item) - `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item))))) - (tramp-compat-auth-source-netrc-parse-all filename))) + (delete-dups + (tramp-compat-seq-keep + (lambda (item) + (and (assoc "machine" item) + `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item))))) + (tramp-compat-auth-source-netrc-parse-all filename)))) (defun tramp-parse-putty (registry-or-dirname) "Return a list of (user host) tuples allowed to access. @@ -4270,10 +4339,16 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." - ;; `file-truename' could raise an error, for example due to a cyclic - ;; symlink. - (ignore-errors - (eq (file-attribute-type (file-attributes (file-truename filename))) t))) + (or + ;; `file-directory-p' is used as predicate for file name completion. + ;; Sometimes, when a connection is not established yet, it is + ;; desirable to return t immediately for "/method:foo:". It can be + ;; expected that this is always a directory. + (tramp-string-empty-or-nil-p (tramp-file-local-name filename)) + ;; `file-truename' could raise an error, for example due to a + ;; cyclic symlink. + (ignore-errors + (eq (file-attribute-type (file-attributes (file-truename filename))) t)))) (defun tramp-handle-file-equal-p (filename1 filename2) "Like `file-equal-p' for Tramp files." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 58b5083b2c0..892e4ef519c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -68,6 +68,7 @@ (require 'vc-git) (require 'vc-hg) +(declare-function edebug-mode "edebug") (declare-function project-mode-line-format "project") (declare-function tramp-check-remote-uname "tramp-sh") (declare-function tramp-find-executable "tramp-sh") @@ -215,7 +216,10 @@ is greater than 10. (kill-buffer buf)))))) (defsubst tramp--test-message (fmt-string &rest arguments) - "Emit a message into ERT *Messages*." + "Emit a message into \"ERT *Messages*\" and the trace buffer." + (declare (tramp-suppress-trace t)) + (when (get-buffer trace-buffer) + (trace-values (apply #'format fmt-string arguments))) (tramp--test-instrument-test-case 0 (apply #'tramp-message tramp-test-vec 0 fmt-string arguments))) @@ -4857,6 +4861,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (host (file-remote-p ert-remote-temporary-file-directory 'host)) (orig-syntax tramp-syntax) (minibuffer-completing-file-name t)) + ;; `file-remote-p' returns as host the string "host#port", which + ;; isn't useful. (when (and (stringp host) (string-match (rx (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp)) @@ -4868,7 +4874,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp-syntax-values) `(,orig-syntax))) (tramp-change-syntax syntax) ;; This has cleaned up all connection data, which are used - ;; for completion. We must refill the cache. + ;; for completion. We must refill the cache in order to get + ;; at least one completion candidate. (tramp-set-connection-property tramp-test-vec "completion-use-cache" t) (let (;; This is needed for the `separate' syntax. @@ -4883,6 +4890,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Complete method name. (unless (or (tramp-string-empty-or-nil-p method) (string-empty-p tramp-method-regexp)) + ;; `read-directory-name' uses `file-directory-p'. + ;; `file-directory-p' works since Emacs 31. + ;; (Bug#79236) + (when (tramp--test-emacs31-p) + (should + (file-name-completion + (concat prefix-format (substring method 0 1)) + "/" #'file-directory-p))) (should (member (concat prefix-format method tramp-postfix-method-format) @@ -4892,6 +4907,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (unless (or (tramp-string-empty-or-nil-p method) (string-empty-p tramp-method-regexp) (tramp-string-empty-or-nil-p host)) + ;; `read-directory-name' uses `file-directory-p'. + ;; `file-directory-p' works since Emacs 31. + ;; (Bug#79236) + (when (tramp--test-emacs31-p) + (should + (file-name-completion + (concat prefix-format method tramp-postfix-method-format) + "/" #'file-directory-p))) (should (member (concat @@ -4983,6 +5006,17 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; and Bug#60505. (ert-deftest tramp-test26-interactive-file-name-completion () "Check interactive completion with different `completion-styles'." + (skip-unless (tramp--test-enabled)) + + ;; (when (get-buffer trace-buffer) (kill-buffer trace-buffer)) + ;; (dolist (elt (append + ;; (mapcar + ;; #'intern (all-completions "tramp-" obarray #'functionp)) + ;; tramp-trace-functions)) + ;; (unless (get elt 'tramp-suppress-trace) + ;; (trace-function-background elt))) + ;; (trace-function-background #'completion-file-name-table) + ;; (trace-function-background #'read-file-name) ;; Method, user and host name in completion mode. (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) @@ -4991,39 +5025,54 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (hop (file-remote-p ert-remote-temporary-file-directory 'hop)) (orig-syntax tramp-syntax) (non-essential t) - (inhibit-message t)) + (inhibit-message (not (ignore-errors (edebug-mode))))) + ;; `file-remote-p' returns as host the string "host#port", which + ;; isn't useful. (when (and (stringp host) (string-match (rx (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp)) host)) (setq host (replace-match "" nil nil host))) - ;; (trace-function #'tramp-completion-file-name-handler) - ;; (trace-function #'completion-file-name-table) (unwind-protect (dolist (syntax (if (tramp--test-expensive-test-p) (tramp-syntax-values) `(,orig-syntax))) (tramp-change-syntax syntax) ;; This has cleaned up all connection data, which are used - ;; for completion. We must refill the cache. + ;; for completion. We must refill the cache in order to get + ;; at least one completion candidate. (tramp-set-connection-property tramp-test-vec "completion-use-cache" t) (dolist (style (if (tramp--test-expensive-test-p) - ;; It doesn't work for `initials' and `shorthand' - ;; completion styles. Should it? + ;; FIXME: It doesn't work for `initials' and + ;; `shorthand' completion styles. Should it? ;; `orderless' passes the tests, but it is an ELPA package. - '(emacs21 emacs22 basic partial-completion substring flex) + ;; What about `company' backends, `consult', `cider', `helm'? + `(emacs21 emacs22 basic partial-completion substring + ;; FIXME: `flex' is not compatible with IPv6 hosts. + ,@(unless (string-match-p tramp-ipv6-regexp host) '(flex))) '(basic))) (when (assoc style completion-styles-alist) (let* (;; Force the real minibuffer in batch mode. (executing-kbd-macro noninteractive) + ;; FIXME: Is this TRT for test? + (minibuffer-completing-file-name t) + (confirm-nonexistent-file-or-buffer nil) (completion-styles `(,style)) completion-category-defaults completion-category-overrides - ;; This is needed for the `simplified' syntax, + ;; FIXME: Is this TRT for test? + (completion-pcm--delim-wild-regex + ;; "::1" is a complete word. ":" isn't a + ;; delimiter, therefore. + (rx-to-string + `(any + ,(string-replace + ":" "" completion-pcm-word-delimiters)))) + ;; This is needed for the `simplified' syntax. (tramp-default-method method) (method-string (unless (string-empty-p tramp-method-regexp) @@ -5101,60 +5150,78 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." user-string host-string) ,host-string))))) - (ignore-errors (kill-buffer "*Completions*")) - ;; (and (bufferp trace-buffer) (kill-buffer trace-buffer)) - (discard-input) - (setq test (car test-and-result) - unread-command-events - (mapcar #'identity (concat test "\t\t\n")) - completions nil - result (read-file-name "Prompt: ")) + (dolist + (predicate + (if (and (tramp--test-expensive-test-p) + (tramp--test-emacs31-p)) + ;; `nil' will be expanded to `file-exists-p'. + ;; `read-directory-name' uses `file-directory-p'. + ;; `file-directory-p' works since Emacs 31. + ;; (Bug#79236) + '(file-exists-p file-directory-p) '(nil))) - (if (or (not (get-buffer "*Completions*")) - (string-match-p - (if (string-empty-p tramp-method-regexp) + (ignore-errors (kill-buffer "*Completions*")) + ;; (when (get-buffer trace-buffer) + ;; (kill-buffer trace-buffer)) + (discard-input) + (setq test (car test-and-result) + unread-command-events + (append test '(tab tab return return)) + completions nil + result + (read-file-name + "Prompt: " nil nil 'confirm nil predicate)) + + (if (or (not (get-buffer "*Completions*")) + (string-match-p + (if (string-empty-p tramp-method-regexp) + (rx + (| (regexp tramp-postfix-user-regexp) + (regexp tramp-postfix-host-regexp)) + eos) (rx - (| (regexp tramp-postfix-user-regexp) + (| (regexp tramp-postfix-method-regexp) + (regexp tramp-postfix-user-regexp) (regexp tramp-postfix-host-regexp)) - eos) - (rx - (| (regexp tramp-postfix-method-regexp) - (regexp tramp-postfix-user-regexp) - (regexp tramp-postfix-host-regexp)) - eos)) - result)) - (progn - ;; (tramp--test-message - ;; "syntax: %s style: %s test: %s result: %s" - ;; syntax style test result) - (should (string-prefix-p (cadr test-and-result) result))) + eos)) + result)) + (progn + ;; (tramp--test-message + ;; (concat + ;; "syntax: %s style: %s predicate: %s " + ;; "test: %s result: %s") + ;; syntax style predicate test result) + (should + (string-prefix-p (cadr test-and-result) result))) - (with-current-buffer "*Completions*" - ;; We must remove leading `default-directory'. - (goto-char (point-min)) - (let ((inhibit-read-only t)) - (while (search-forward-regexp "//" nil 'noerror) - (delete-region (line-beginning-position) (point)))) - (goto-char (point-min)) - (search-forward-regexp - (rx bol (0+ nonl) - (any "Pp") "ossible completions" - (0+ nonl) eol)) - (forward-line 1) - (setq completions - (split-string - (buffer-substring-no-properties (point) (point-max)) - (rx (any "\r\n\t ")) 'omit))) + (with-current-buffer "*Completions*" + ;; We must remove leading `default-directory'. + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (while (search-forward-regexp "//" nil 'noerror) + (delete-region (line-beginning-position) (point)))) + (goto-char (point-min)) + (search-forward-regexp + (rx bol (0+ nonl) + (any "Pp") "ossible completions" + (0+ nonl) eol)) + (forward-line 1) + (setq completions + (split-string + (buffer-substring-no-properties + (point) (point-max)) + (rx (any "\r\n\t ")) 'omit))) - ;; (tramp--test-message - ;; "syntax: %s style: %s test: %s result: %s completions: %S" - ;; syntax style test result completions) - (should (member (caddr test-and-result) completions)))))))) + ;; (tramp--test-message + ;; (concat + ;; "syntax: %s style: %s predicate: %s test: %s " + ;; "result: %s completions: %S") + ;; syntax style predicate test result completions) + (should + (member (caddr test-and-result) completions))))))))) ;; Cleanup. - ;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer)) - ;; (untrace-function #'tramp-completion-file-name-handler) - ;; (untrace-function #'completion-file-name-table) + ;; (untrace-all) (tramp-change-syntax orig-syntax) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))) @@ -8815,6 +8882,12 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Use `skip-when' starting with Emacs 30.1. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for "ftp". +;; * In `tramp-test26-file-name-completion', check also user, domain, +;; port and hop. +;; * In `tramp-test26-interactive-file-name-completion', check `flex', +;; `initials' and `shorthand' completion styles. Should +;; `minibuffer-completing-file-name' and `completion-pcm--delim-wild-regex' +;; be bound? Check also domain, port and hop. ;; * Check, why a process filter t doesn't work in ;; `tramp-test29-start-file-process' and ;; `tramp-test30-make-process'. From f7188ed77f82b71e856e21aab6c266f68bf21ee2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 29 Aug 2025 17:29:54 +0200 Subject: [PATCH 115/158] ; Fix last commit * lisp/net/tramp.el (tramp-parse-default-user-host): Fix thinko. (tramp-handle-file-directory-p): Extend simple check. --- lisp/net/tramp.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1b9efd3dab6..c7450bc015d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3345,7 +3345,7 @@ for all methods. Resulting data are derived from default settings." (let ((user (tramp-find-user method nil nil)) (host (tramp-find-host method nil nil))) (when (or user host) - `(,user ,host)))) + `((,user ,host))))) ;;;###tramp-autoload (defcustom tramp-completion-multi-hop-methods nil @@ -4340,11 +4340,13 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." (or - ;; `file-directory-p' is used as predicate for file name completion. - ;; Sometimes, when a connection is not established yet, it is - ;; desirable to return t immediately for "/method:foo:". It can be - ;; expected that this is always a directory. + ;; `file-directory-p' is used as predicate for file name + ;; completion. Sometimes, when a connection is not established + ;; yet, it is desirable to return t immediately for "/method:foo:" + ;; or "/method:foo:/". It can be expected that this is always a + ;; directory. (tramp-string-empty-or-nil-p (tramp-file-local-name filename)) + (string-equal (tramp-file-local-name filename) "/") ;; `file-truename' could raise an error, for example due to a ;; cyclic symlink. (ignore-errors From b8ad7c38aebeb457f81e8298d9be10d9d30f2921 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 29 Aug 2025 19:27:32 +0300 Subject: [PATCH 116/158] * lisp/progmodes/python.el: Use 'treesit-major-mode-remap-alist'. (python-ts-mode): Don't duplicate 'auto-mode-alist' and 'interpreter-mode-alist' settings in Emacs 31 (bug#79180). Add ts-mode mapping to 'treesit-major-mode-remap-alist'. --- lisp/progmodes/python.el | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3cd20d6babf..649f47f6e69 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -7424,12 +7424,19 @@ implementations: `python-mode' and `python-ts-mode'." (when python-indent-guess-indent-offset (python-indent-guess-indent-offset)) - (add-to-list 'auto-mode-alist (cons python--auto-mode-alist-regexp 'python-ts-mode)) - (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode)))) + (unless (boundp 'treesit-major-mode-remap-alist) ; Emacs 31.1 + (add-to-list 'auto-mode-alist (cons python--auto-mode-alist-regexp 'python-ts-mode)) + (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode))))) (when (fboundp 'derived-mode-add-parents) ; Emacs 30.1 (derived-mode-add-parents 'python-ts-mode '(python-mode))) +;;;###autoload +(when (and (fboundp 'treesit-available-p) (treesit-available-p) + (boundp 'treesit-major-mode-remap-alist)) ; Emacs 31.1 + (add-to-list 'treesit-major-mode-remap-alist + '(python-mode . python-ts-mode))) + ;;; Completion predicates for M-x ;; Commands that only make sense when editing Python code. (dolist (sym '(python-add-import From 35f8ce783558e7a4c02983b5b360cba9e1cb6503 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 29 Aug 2025 19:32:22 +0300 Subject: [PATCH 117/158] * lisp/textmodes/markdown-ts-mode.el: Fix embed settings. (markdown-ts--range-settings): Move embed settings for html/toml/yaml to 'markdown-ts-setup'. (markdown-ts-setup): Append range rules to 'treesit-range-settings' only when grammars for html/toml/yaml are installed. --- lisp/textmodes/markdown-ts-mode.el | 50 +++++++++++++++++------------- 1 file changed, 28 insertions(+), 22 deletions(-) diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el index 7f705ddb8b2..4929f2d91ee 100644 --- a/lisp/textmodes/markdown-ts-mode.el +++ b/lisp/textmodes/markdown-ts-mode.el @@ -307,25 +307,6 @@ the same features enabled in MODE." :range-fn #'treesit-range-fn-exclude-children '((inline) @markdown-inline) - :embed 'yaml - :host 'markdown - :local t - '((minus_metadata) @yaml) - - :embed 'toml - :host 'markdown - :local t - '((plus_metadata) @toml) - - :embed 'html - :host 'markdown - :local t - '((html_block) @html) - - :embed 'html - :host 'markdown-inline - '((html_tag) @html) - :embed #'markdown-ts--convert-code-block-language :host 'markdown :local t @@ -350,7 +331,18 @@ the same features enabled in MODE." (setq-local treesit-font-lock-feature-list (treesit-merge-font-lock-feature-list treesit-font-lock-feature-list - html-ts-mode--treesit-font-lock-feature-list))) + html-ts-mode--treesit-font-lock-feature-list)) + (setq-local treesit-range-settings + (append treesit-range-settings + (treesit-range-rules + :embed 'html + :host 'markdown + :local t + '((html_block) @html) + + :embed 'html + :host 'markdown-inline + '((html_tag) @html))))) (when (treesit-ready-p 'yaml t) (require 'yaml-ts-mode) @@ -362,7 +354,14 @@ the same features enabled in MODE." (setq-local treesit-font-lock-feature-list (treesit-merge-font-lock-feature-list treesit-font-lock-feature-list - yaml-ts-mode--font-lock-feature-list))) + yaml-ts-mode--font-lock-feature-list)) + (setq-local treesit-range-settings + (append treesit-range-settings + (treesit-range-rules + :embed 'yaml + :host 'markdown + :local t + '((minus_metadata) @yaml))))) (when (treesit-ready-p 'toml t) (require 'toml-ts-mode) @@ -374,7 +373,14 @@ the same features enabled in MODE." (setq-local treesit-font-lock-feature-list (treesit-merge-font-lock-feature-list treesit-font-lock-feature-list - toml-ts-mode--font-lock-feature-list))) + toml-ts-mode--font-lock-feature-list)) + (setq-local treesit-range-settings + (append treesit-range-settings + (treesit-range-rules + :embed 'toml + :host 'markdown + :local t + '((plus_metadata) @toml))))) (treesit-major-mode-setup)) From 8d3554683f5def6ac85a1ba02876575ea3d498a8 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 29 Aug 2025 19:35:58 +0300 Subject: [PATCH 118/158] * lisp/treesit-x.el (treesit-generic-mode-font-lock-map): Extend. Add more font-lock mappings based on existing settings in ts-modes. --- admin/tree-sitter/treesit-admin.el | 2 +- lisp/treesit-x.el | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/admin/tree-sitter/treesit-admin.el b/admin/tree-sitter/treesit-admin.el index 2e85d6b0d8c..1f1fa1ce752 100644 --- a/admin/tree-sitter/treesit-admin.el +++ b/admin/tree-sitter/treesit-admin.el @@ -316,7 +316,7 @@ Return non-nil if all queries are valid, nil otherwise." ;; TODO: A more generic way to find all queries. (let ((c-ts-mode-enable-doxygen t) (c-ts-mode-enable-doxygen t) - (java-ts-mode-enabel-doxygen t)) + (java-ts-mode-enable-doxygen t)) (funcall mode)) (font-lock-mode -1) treesit-font-lock-settings))) diff --git a/lisp/treesit-x.el b/lisp/treesit-x.el index 65845ed0ac0..308e2c23f8c 100644 --- a/lisp/treesit-x.el +++ b/lisp/treesit-x.el @@ -155,16 +155,21 @@ of `define-treesit-generic-mode'. (defvar treesit-generic-mode-font-lock-map '( + ("@attribute" . "@font-lock-preprocessor-face") ("@boolean" . "@font-lock-constant-face") ("@comment" . "@font-lock-comment-face") + ("@constructor" . "@font-lock-type-face") ("@constant" . "@font-lock-constant-face") + ("@constant.builtin" . "@font-lock-builtin-face") ("@delimiter" . "@font-lock-delimiter-face") ("@error" . "@font-lock-warning-face") ("@escape" . "@font-lock-escape-face") ("@function" . "@font-lock-function-name-face") + ("@function.builtin" . "@font-lock-builtin-face") ("@function.call" . "@font-lock-function-call-face") ("@keyword" . "@font-lock-keyword-face") ("@keyword.operator" . "@font-lock-operator-face") + ("@module" . "@font-lock-keyword-face") ("@number" . "@font-lock-number-face") ("@operator" . "@font-lock-operator-face") ("@property" . "@font-lock-property-name-face") @@ -174,9 +179,11 @@ of `define-treesit-generic-mode'. ("@string" . "@font-lock-string-face") ("@string.regexp" . "@font-lock-regexp-face") ("@string.special" . "@font-lock-string-face") + ("@tag" . "@font-lock-function-name-face") ("@tag.delimiter" . "@font-lock-delimiter-face") ("@text.reference" . "@font-lock-doc-face") ("@type" . "@font-lock-type-face") + ("@type.builtin" . "@font-lock-builtin-face") ("@variable" . "@font-lock-variable-name-face") ("@variable.builtin" . "@font-lock-builtin-face") ("@variable.parameter" . "@font-lock-variable-name-face") From 8c71ef0f8edc91d2dc0b220447856cf656f33f57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 29 Aug 2025 16:24:02 +0200 Subject: [PATCH 119/158] ; use modern sort calls in more places * lisp/emacs-lisp/regexp-opt.el (regexp-opt, regexp-opt-group): * lisp/emacs-lisp/rx.el (rx--parse-any): New-style calls, also faster. --- lisp/emacs-lisp/regexp-opt.el | 4 ++-- lisp/emacs-lisp/rx.el | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 6c2350e9548..3edaca78e32 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -140,7 +140,7 @@ usually more efficient than that of a simplified version: (open (cond ((stringp paren) paren) (paren "\\("))) (re (if strings (regexp-opt-group - (delete-dups (sort (copy-sequence strings) 'string-lessp)) + (delete-dups (sort strings)) (or open t) (not open)) ;; No strings: return an unmatchable regexp. (concat (or open "\\(?:") regexp-unmatchable "\\)")))) @@ -250,7 +250,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." (prefixes ;; Sorting is necessary in cases such as ("ad" "d"). (sort (mapcar (lambda (s) (substring s 0 n)) strings) - 'string-lessp))) + :in-place t))) (concat open-group (regexp-opt-group prefixes t t) (regexp-quote (nreverse xiffus)) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index c512d42cd15..58f95c7d89a 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -581,7 +581,7 @@ a list of named character classes in the order they occur in BODY." (cons (rx--condense-intervals (sort (append conses (mapcan #'rx--string-to-intervals strings)) - #'car-less-than-car)) + :key #'car :in-place t)) (nreverse classes)))) (defun rx--generate-alt (negated intervals classes) From aa60f16e6651721aaa3b8f92549b50832f2d213c Mon Sep 17 00:00:00 2001 From: Sean Devlin Date: Sat, 2 Aug 2025 09:47:14 -0500 Subject: [PATCH 120/158] Add user option to inhibit Calc startup message (bug#79143) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/misc/calc.texi (Customizing Calc): Document the new option. * etc/NEWS: Document the new option. * lisp/calc/calc.el (calc-inhibit-startup-message): New option to inhibit Calc’s startup message. (calc): Respect the option in Calc’s startup code. * test/lisp/calc/calc-tests.el (ert): Require ert-x for 'ert-with-message-capture'. (calc-inhibit-startup-message): Test the new user option. --- doc/misc/calc.texi | 8 ++++++++ etc/NEWS | 5 +++++ lisp/calc/calc.el | 21 ++++++++++++++------- test/lisp/calc/calc-tests.el | 15 +++++++++++++++ 4 files changed, 42 insertions(+), 7 deletions(-) diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index eda442ecb38..9b7cdd8b37f 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -35714,6 +35714,14 @@ The default value of @code{calc-string-maximum-character} is @code{0xFF} or 255. @end defvar +@defvar calc-inhibit-startup-message +The variable @code{calc-inhibit-startup-message} controls display of a +welcome message when starting Calc. If it is @code{nil} (the default), +Calc will print a brief message listing key bindings to get help or to +quit. If it is non-@code{nil}, Calc will start without printing +anything. +@end defvar + @node Reporting Bugs @appendix Reporting Bugs diff --git a/etc/NEWS b/etc/NEWS index af6dd0c2151..37d38d0d91d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2605,6 +2605,11 @@ Latin-1 range 0-255. This hard-coded maximum is replaced by the display of matching vectors as Unicode strings. The default value is 0xFF or 255 to preserve the existing behavior. ++++ +*** New user option 'calc-inhibit-startup-message'. +If it is non-nil, inhibit Calc from printing its startup message. The +default value is nil to preserve the existing behavior. + ** Time *** New user option 'world-clock-sort-order'. diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index a350419b320..d4fb8776c6c 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1473,6 +1473,11 @@ commands given here will actually operate on the *Calculator* stack." (require 'calc-ext) (calc-set-language calc-language calc-language-option t))) +(defcustom calc-inhibit-startup-message nil + "If non-nil, inhibit the Calc startup message." + :version "31.1" + :type 'boolean) + (defcustom calc-make-windows-dedicated nil "If non-nil, windows displaying Calc buffers will be marked dedicated. See `window-dedicated-p' for what that means." @@ -1524,9 +1529,10 @@ See `window-dedicated-p' for what that means." (with-current-buffer (calc-trail-buffer) (and calc-display-trail (calc-trail-display 1 t))) - (message (substitute-command-keys - (concat "Welcome to the GNU Emacs Calculator! \\" - "Press \\[calc-help] or \\[calc-help-prefix] for help, \\[calc-quit] to quit"))) + (unless calc-inhibit-startup-message + (message (substitute-command-keys + (concat "Welcome to the GNU Emacs Calculator! \\" + "Press \\[calc-help] or \\[calc-help-prefix] for help, \\[calc-quit] to quit")))) (run-hooks 'calc-start-hook) (and (windowp full-display) (window-point full-display) @@ -1534,10 +1540,11 @@ See `window-dedicated-p' for what that means." (and calc-make-windows-dedicated (set-window-dedicated-p nil t)) (calc-check-defines) - (when (and calc-said-hello interactive) - (sit-for 2) - (message "")) - (setq calc-said-hello t))))) + (unless calc-inhibit-startup-message + (when (and calc-said-hello interactive) + (sit-for 2) + (message "")) + (setq calc-said-hello t)))))) ;;;###autoload (defun full-calc (&optional interactive) diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index 2fd6a6be45e..49762e146a5 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -26,6 +26,7 @@ (require 'cl-lib) (require 'ert) +(require 'ert-x) (require 'calc) (require 'calc-ext) (require 'calc-units) @@ -946,5 +947,19 @@ an error in the comparison." (should-error (math-vector-is-string cplx-vec) :type 'wrong-type-argument)))) +(ert-deftest calc-inhibit-startup-message () + "Test user option `calc-inhibit-startup-message'." + (let ((welcome-message "Welcome to the GNU Emacs Calculator!")) + (ert-with-message-capture messages + (let ((calc-inhibit-startup-message t)) + (calc)) + (should-not (string-match-p welcome-message messages)) + (calc-quit)) + (ert-with-message-capture messages + (let ((calc-inhibit-startup-message nil)) + (calc)) + (should (string-match-p welcome-message messages)) + (calc-quit)))) + (provide 'calc-tests) ;;; calc-tests.el ends here From b85f9d6a97eb379bd7a461bc1b3499846eb1d933 Mon Sep 17 00:00:00 2001 From: Sean Devlin Date: Sat, 2 Aug 2025 10:51:18 -0500 Subject: [PATCH 121/158] Fix recursive load when 'calc-always-load-extensions' is set * lisp/calc/calc.el (calc-create-buffer): Call 'calc-load-everything'. (calc-always-load-extensions): Delete erroneous stanza. (Bug#79157) --- lisp/calc/calc.el | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index d4fb8776c6c..6f4664dd6c4 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1468,7 +1468,8 @@ commands given here will actually operate on the *Calculator* stack." (calc-mode)) (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000)) (when calc-always-load-extensions - (require 'calc-ext)) + (require 'calc-ext) + (calc-load-everything)) (when calc-language (require 'calc-ext) (calc-set-language calc-language calc-language-option t))) @@ -3522,11 +3523,6 @@ See Info node `(calc)Defining Functions'." (defcalcmodevar math-half-2-word-size 2147483648 "One-half of two to the power of `calc-word-size'.") -(when calc-always-load-extensions - (require 'calc-ext) - (calc-load-everything)) - - (run-hooks 'calc-load-hook) (provide 'calc) From b0efe06551bfed447328c11d6711ffd9fc63dfe4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 30 Aug 2025 11:24:51 +0300 Subject: [PATCH 122/158] ; * lisp/ehelp.el (ehelp-command): Fix the autoload form (bug#79289). --- lisp/ehelp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ehelp.el b/lisp/ehelp.el index ed86f663100..611aa712628 100644 --- a/lisp/ehelp.el +++ b/lisp/ehelp.el @@ -433,7 +433,7 @@ will select it.)" (substitute-key-definition 'describe-syntax 'electric-describe-syntax map) map)) -;;;###(autoload 'ehelp-command "ehelp" "Prefix command for ehelp." t 'keymap) +;;;###autoload (autoload 'ehelp-command "ehelp" "Prefix command for ehelp." t 'keymap) (defalias 'ehelp-command ehelp-map) (put 'ehelp-command 'documentation "Prefix command for ehelp.") From 34f3ac6c5b98d79e51bd9bbaf3c5bd89b2faaba3 Mon Sep 17 00:00:00 2001 From: john muhl Date: Wed, 14 May 2025 08:53:42 -0500 Subject: [PATCH 123/158] Fontify all comment delimiters in 'lua-ts-mode' * lisp/progmodes/lua-ts-mode.el (lua-ts--comment-font-lock): Apply 'font-lock-comment-delimiter-face' to the entire span of initial dashes. In particular, this improves the appearance of LuaCATS and EmmyLua style annotations which use "---". * test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua: Add tests. (Bug#79258) --- lisp/progmodes/lua-ts-mode.el | 7 +++++-- test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua | 5 +++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 1c1812a7c30..35700255ba4 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -168,10 +168,13 @@ values of OVERRIDE." (let* ((node-start (treesit-node-start node)) (node-end (treesit-node-end node)) (node-text (treesit-node-text node t)) - (delimiter-end (+ 2 node-start))) + (delimiter-end (progn + (goto-char node-start) + (while (looking-at-p "-") (forward-char)) + (point)))) (when (and (>= node-start start) (<= delimiter-end end) - (string-match "\\`--" node-text)) + (string-match "\\`---*" node-text)) (treesit-fontify-with-override node-start delimiter-end 'font-lock-comment-delimiter-face diff --git a/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua b/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua index 93d589e3825..5a36bcad10b 100644 --- a/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua +++ b/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua @@ -11,6 +11,11 @@ Multi-line comment -- <- font-lock-comment-face local line_comment = "comment" -- comment -- ^ font-lock-comment-face +---@alias MyNumber integer +-- <- font-lock-comment-delimiter-face +------Calculate new number +-- ^ font-lock-comment-delimiter-face +function calc() end -- Definition local function f1() end From 3d2a8186793043805fd3d71ef5aa70e0a3ccc603 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 30 Aug 2025 12:23:42 +0300 Subject: [PATCH 124/158] * doc/misc/efaq-w32.texi (UTF-8 encoding): New section (bug#79296). --- doc/misc/efaq-w32.texi | 64 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 64 insertions(+) diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index e50716ff654..5c24364286d 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -913,6 +913,7 @@ The doc string contains a list of the system sounds you can use. * Multilingual fonts:: * Font menu:: * Line ends:: +* UTF-8 encoding:: @end menu @node Font names @@ -1191,6 +1192,69 @@ recent versions of Emacs, this is seldom useful for existing files, but can still be used to influence the choice of line ends for newly created files. +@node UTF-8 encoding +@section Can I use UTF-8 as default encoding on MS-Windows? +@cindex UTF-8 as default encoding on Windows +@cindex codepage 65001 support in Emacs + +Recent versions of MS-Windows (Windows 10 since build 1803, and Windows +11 or later versions) allow to use UTF-8 (a.k.a.@: ``codepage 65001'') +as the default system codepage. As of this writing, this is still an +experimental feature, even in Windows 11, and is disabled by default. +On Windows 11 you can enable it as follows: + +@enumerate +@item +Open Settings. + +@item +Select ``Time & Language'', then ``Language & region''. + +@item +Click on ``Administrative language settings''. + +@item +On the dialog that pops up click ``Change system locale...'' + +@item +In the ``Region Settings'' dialog that pops up, check the check-box +labeled ``Beta: Use Unicode UTF-8 for worldwide language support'', then +confirm by clicking ``OK'' to both dialogs. +@end enumerate + +@cindex UCRT runtime library +@cindex MSVCRT runtime library +Emacs supports this feature starting from version 30.2, but only when +running on the versions of Windows that provide this feature, and only +if the Emacs executable was linked against the @samp{UCRT} library as +the Windows C runtime, not against the older @samp{MSVCRT}. This is +because the C functions that deal with non-ASCII characters, as +implemented by @samp{MSVCRT}, don't support UTF-8 as the multibyte +encoding of non-ASCII characters. (Which runtime to link against is +determined by the person who built your Emacs binary. Note that using +Emacs linked against @samp{UCRT} needs all of the libraries loaded by +Emacs dynamically, such as GnuTLS, image libraries like @samp{rsvg}, +Tree-sitter, and all the others, to be also linked against @samp{UCRT}, +otherwise subtle problems could happen when dealing with non-ASCII +characters and strings.) + +If you have an Emacs linked against @samp{UCRT}, and you turned on the +UTF-8 support in Windows as described above, you can customize Emacs to +use UTF-8 as your default encoding, e.g., by adding + +@lisp + (prefer-coding-system 'utf-8) +@end lisp + +@noindent +to your init file, or by using the @samp{UTF-8} language environment +(@pxref{Language Environments,,, emacs, The GNU Emacs Manual}) in your +Emacs sessions. + +Please be aware that, since this feature of Windows is still in beta, +there could be some subtle issues with it. So we do not yet recommend +to turn this on, unless you feel adventurous. + @c ------------------------------------------------------------ @node Printing @chapter Printing From fdc6bb2caf959ceafd1c516f4f7a0687eb292ea4 Mon Sep 17 00:00:00 2001 From: Jens Schmidt Date: Thu, 21 Aug 2025 20:58:42 +0200 Subject: [PATCH 125/158] Add edebug-bounce-to-previous-value Command edebug-bounce-to-previous-value uses the previous value observed while single-stepping or evaluating an expression to bounce point in the outside current buffer to the buffer position corresponding to that value. * lisp/emacs-lisp/edebug.el (edebug-previous-value): Add variable. (edebug-compute-previous-result, edebug-eval-expression): Update it. (edebug-bounce-to-previous-value): Add command. (edebug-mode-map): Add keybinding for the new command, replacing the binding of "P" to edebug-view-outside. (edebug-mode-menus): Add menu entry for the new command. * doc/lispref/edebug.texi (Edebug Views): Add documentation. * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el (edebug-test-code-bounce-point): Add test code. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-bounce-outside-buffer) (edebug-tests-bounce-outside-point) (edebug-tests-bounce-outside-mark) (edebug-tests-bounce-record-outside-environment) (edebug-tests-should-have-bounced-to): Add infrastructure to test bounces. (edebug-tests-check-keymap): Update tests to new key bindings. (edebug-tests-bounce-point) (edebug-tests-bounce-to-previous-value) (edebug-tests-bounce-to-previous-non-position): Add tests. (edebug-tests-evaluation-of-current-buffer-bug-19611): Clean up side effects. (Bug#79288) --- doc/lispref/edebug.texi | 28 +++- etc/NEWS | 12 ++ lisp/emacs-lisp/edebug.el | 47 +++++- .../edebug-resources/edebug-test-code.el | 10 ++ test/lisp/emacs-lisp/edebug-tests.el | 147 ++++++++++++++++-- 5 files changed, 222 insertions(+), 22 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index f16190b85c9..97909e2bb55 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -677,8 +677,7 @@ effect outside of Edebug. @table @kbd @findex edebug-view-outside -@item P -@itemx v +@item v Switch to viewing the outside window configuration (@code{edebug-view-outside}). Type @kbd{C-x X w} to return to Edebug. @@ -689,6 +688,17 @@ outside position (@code{edebug-bounce-point}), pausing for one second before returning to Edebug. With a prefix argument @var{n}, pause for @var{n} seconds instead. +@findex edebug-bounce-to-previous-value +@item P +Temporarily display the outside current buffer with the outside point +corresponding to the previous value +(@code{edebug-bounce-to-previous-value}). The previous value is what +Edebug has evaluated before its last stop point or what you have +evaluated in the context outside of Edebug, for example, with +@kbd{C-x C-e}. This command pauses for one second before returning to +Edebug. With a prefix argument @var{n}, it pauses for @var{n} seconds +instead. + @findex edebug-where @item w Move point back to the current stop point in the source code buffer @@ -713,6 +723,20 @@ source code buffer, you must use @kbd{C-x X W} from the global keymap. bounce to the point in the current buffer with @kbd{p}, even if it is not normally displayed. + You can also bounce to buffer positions other than the current point. +Suppose you are debugging the form + +@example +(make-overlay beg end) +@end example + +@noindent +and you would like to know where @code{beg} and @code{end} are located +in the outside buffer. Then you could either evaluate these, for +example, with @kbd{C-x C-e}, or step over them with @kbd{n}, and +immediately after that press @kbd{P}, to bounce to the position you have +previously evaluated. + After moving point, you may wish to jump back to the stop point. You can do that with @kbd{w} from a source code buffer. You can jump back to the stop point in the source code buffer from any buffer using diff --git a/etc/NEWS b/etc/NEWS index 37d38d0d91d..c9f30dc7ef7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2521,6 +2521,18 @@ If non-nil, FFAP always finds remote files in buffers with remote 'default-directory'. If nil, FFAP finds local files first for absolute file names in above buffers. The default is nil. +** Debugging + ++++ +*** New command 'edebug-bounce-to-previous-value' (bound to 'P') +This command temporarily displays the outside current buffer with the +outside point corresponding to the previous value, where the previous +value is what Edebug has evaluated before its last stop point or what +the user has evaluated in the context outside of Edebug. + +This replaces the binding of command 'edebug-view-outside' to 'P', which +is still available on 'v'. + --- ** Flymake diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 284e3acd959..fc349787c93 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2617,7 +2617,11 @@ when edebug becomes active." (defvar edebug-eval-list nil) ;; List of expressions to evaluate. -(defvar edebug-previous-result nil) ;; Last result returned. +;; Last value seen while single-stepping or evaluating in the outside +;; environment. +(defvar edebug-previous-value nil) +;; Last value seen while single-stepping, converted to a string. +(defvar edebug-previous-result nil) (defun edebug--display (value offset-index arg-mode) ;; edebug--display-1 is too big, we should split it. This function @@ -3113,6 +3117,37 @@ before returning. The default is one second." (sit-for arg) (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))) +(defun edebug-bounce-to-previous-value (arg) + "Bounce point to previous value in the outside current buffer. +The previous value is what Edebug has evaluated before its last stop +point or what you have evaluated in the context outside of Edebug, for +example, by calling function `edebug-eval-expression', whatever comes +later. +If prefix argument ARG is supplied, sit for that many seconds before +returning. The default is one second." + (interactive "p") + (if (not edebug-active) + (error "Edebug is not active")) + (if (not (integer-or-marker-p edebug-previous-value)) + (error "Previous value not a number or marker")) + (save-excursion + ;; If the buffer's currently displayed, avoid set-window-configuration. + (save-window-excursion + (let ((point-info "")) + (edebug-pop-to-buffer edebug-outside-buffer) + (cond + ((< edebug-previous-value (point-min)) + (setq point-info (format " (< Point min: %s)" (point-min)))) + ((> edebug-previous-value (point-max)) + (setq point-info (format " (> Point max: %s)" (point-max)))) + ((invisible-p edebug-previous-value) + (setq point-info (format " (invisible)")))) + (goto-char edebug-previous-value) + (message "Current buffer: %s Point: %s%s" + (current-buffer) edebug-previous-value point-info) + (sit-for arg) + (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))) + ;; Joe Wells, here is a start at your idea of adding a buffer to the internal ;; display list. Still need to use this list in edebug--display. @@ -3743,7 +3778,8 @@ Return the result of the last expression." (if edebug-unwrap-results (setq previous-value (edebug-unwrap* previous-value))) - (setq edebug-previous-result + (setq edebug-previous-value previous-value + edebug-previous-result (concat "Result: " (edebug-safe-prin1-to-string previous-value) (eval-expression-print-format previous-value)))) @@ -3785,6 +3821,8 @@ this is the prefix key.)" (values--store-value value) (concat (edebug-safe-prin1-to-string value) (eval-expression-print-format value))))) + ;; Provide a defined previous value also in case of an error. + (setq edebug-previous-value (if errored nil value)) (cond (errored (message "Error: %s" errored)) @@ -3901,9 +3939,9 @@ be installed in `emacs-lisp-mode-map'.") ;; views "w" #'edebug-where - "v" #'edebug-view-outside ; maybe obsolete?? + "v" #'edebug-view-outside "p" #'edebug-bounce-point - "P" #'edebug-view-outside ; same as v + "P" #'edebug-bounce-to-previous-value "W" #'edebug-toggle-save-windows ;; misc @@ -4517,6 +4555,7 @@ It is removed when you hit any char." ("Views" ["Where am I?" edebug-where t] ["Bounce to Current Point" edebug-bounce-point t] + ["Bounce to Previous Value" edebug-bounce-to-previous-value t] ["View Outside Windows" edebug-view-outside t] ["Previous Result" edebug-previous-result t] ["Show Backtrace" edebug-pop-to-backtrace t] diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index 24981bb63cf..4e63732554f 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -126,6 +126,16 @@ !start!(with-current-buffer (get-buffer-create "*edebug-test-code-buffer*") !body!(format "current-buffer: %s" (current-buffer)))) +(defun edebug-test-code-bounce-point () + !start!(with-current-buffer (get-buffer-create "*edebug-test-code-buffer*") + (erase-buffer) + (insert "123\n567\n9ab\n") + (narrow-to-region 5 9) + (goto-char 6)!goto-char! + (push-mark 1)!push-mark! + (set-mark nil)!clear-mark! + (+ 1)!1! (+ 6)!6! (+ 10)!10!)) + (defun edebug-test-code-use-destructuring-bind () (let ((two 2) (three 3)) (cl-destructuring-bind (x . y) (cons two three) (+ x!x! y!y!)))) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 7daacea7925..4550f25f798 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -302,6 +302,29 @@ Then clear edebug-tests' saved messages." edebug-tests-messages)) (setq edebug-tests-messages "")) +(defvar edebug-tests-bounce-outside-buffer nil + "Outside buffer observed while bouncing.") +(defvar edebug-tests-bounce-outside-point nil + "Outside point observed while bouncing.") +(defvar edebug-tests-bounce-outside-mark nil + "Outside mark observed while bouncing.") + +(defun edebug-tests-bounce-record-outside-environment (&rest _) + "Record outside buffer, point, and mark while bouncing." + (setq edebug-tests-bounce-outside-buffer (current-buffer) + edebug-tests-bounce-outside-point (point) + edebug-tests-bounce-outside-mark (mark))) + +(defun edebug-tests-should-have-bounced-to (buffer-or-name point mark message) + "Require that a previous bounce bounced to BUFFER-OR-NAME, POINT, and MARK. +Ensure that the message generated by that bounce equals MESSAGE." + (should (equal edebug-tests-bounce-outside-buffer + (get-buffer buffer-or-name))) + (should (equal edebug-tests-bounce-outside-point point)) + (should (equal edebug-tests-bounce-outside-mark mark)) + (should (string-match-p (concat (regexp-quote message) "$") + edebug-tests-messages))) + (defun edebug-tests-locate-def (def-name) "Search for a definition of DEF-NAME from the start of the current buffer. Place point at the end of DEF-NAME in the buffer." @@ -419,9 +442,9 @@ test and possibly others should be updated." (verify-keybinding "\C-x\C-e" 'edebug-eval-last-sexp) (verify-keybinding "E" 'edebug-visit-eval-list) (verify-keybinding "w" 'edebug-where) - (verify-keybinding "v" 'edebug-view-outside) ;; maybe obsolete?? + (verify-keybinding "v" 'edebug-view-outside) (verify-keybinding "p" 'edebug-bounce-point) - (verify-keybinding "P" 'edebug-view-outside) ;; same as v + (verify-keybinding "P" 'edebug-bounce-to-previous-value) (verify-keybinding "W" 'edebug-toggle-save-windows) (verify-keybinding "?" 'edebug-help) (verify-keybinding "d" 'edebug-pop-to-backtrace) @@ -703,6 +726,95 @@ test and possibly others should be updated." edebug-tests-messages)) "g" (should (equal edebug-tests-@-result '(0 1)))))) +(ert-deftest edebug-tests-bounce-point () + "Edebug can bounce point." + (unwind-protect + (cl-letf* (((symbol-function 'sit-for) + #'edebug-tests-bounce-record-outside-environment)) + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "bounce-point" nil t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at + "bounce-point" "start") + (goto-char (edebug-tests-get-stop-point "bounce-point" "goto-char")) + "h" (edebug-tests-should-be-at + "bounce-point" "goto-char") + "p" (edebug-tests-should-have-bounced-to + "*edebug-test-code-buffer*" 6 nil + "Current buffer: *edebug-test-code-buffer* Point: 6 Mark: ") + "SPC SPC" (edebug-tests-should-be-at + "bounce-point" "push-mark") + "p" (edebug-tests-should-have-bounced-to + "*edebug-test-code-buffer*" 6 1 + "Current buffer: *edebug-test-code-buffer* Point: 6 Mark: 1") + "g"))) + (when (get-buffer "*edebug-test-code-buffer*") + (kill-buffer "*edebug-test-code-buffer*")))) + +(ert-deftest edebug-tests-bounce-to-previous-value () + "Edebug can bounce to previous value." + (unwind-protect + (cl-letf* (((symbol-function 'sit-for) + #'edebug-tests-bounce-record-outside-environment)) + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "bounce-point" nil t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at + "bounce-point" "start") + (goto-char (edebug-tests-get-stop-point "bounce-point" "clear-mark")) + "h" (edebug-tests-should-be-at + "bounce-point" "clear-mark") + ;; Bounce to previous values seen while single-stepping. + "SPC SPC" (edebug-tests-should-be-at "bounce-point" "1") + "P" (edebug-tests-should-have-bounced-to + "*edebug-test-code-buffer*" 5 nil + "Current buffer: *edebug-test-code-buffer* Point: 1 (< Point min: 5)") + "SPC SPC" (edebug-tests-should-be-at "bounce-point" "6") + "P" (edebug-tests-should-have-bounced-to + "*edebug-test-code-buffer*" 6 nil + "Current buffer: *edebug-test-code-buffer* Point: 6") + "SPC SPC" (edebug-tests-should-be-at "bounce-point" "10") + "P" (edebug-tests-should-have-bounced-to + "*edebug-test-code-buffer*" 9 nil + "Current buffer: *edebug-test-code-buffer* Point: 10 (> Point max: 9)") + ;; Bounce to previous value obtained through evaluation. + "e 7 RET" + "P" (edebug-tests-should-have-bounced-to + "*edebug-test-code-buffer*" 7 nil + "Current buffer: *edebug-test-code-buffer* Point: 7") + "g"))) + (when (get-buffer "*edebug-test-code-buffer*") + (kill-buffer "*edebug-test-code-buffer*")))) + +(ert-deftest edebug-tests-bounce-to-previous-non-position () + "Edebug does not bounce to previous non-position." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "fac" '(1) t) + (let* ((debug-on-error nil) + (edebug-on-error nil) + error-message + (command-error-function (lambda (&rest args) + (setq error-message (cadar args))))) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "fac" "start") + ;; Bounce to previous non-position seen while single-stepping. + "SPC SPC SPC" + (edebug-tests-should-match-result-in-messages "t") + "P" (should (string-match-p "Previous value not a number or marker" + error-message)) + ;; The error stopped the keyboard macro. Start it again. + (should-not executing-kbd-macro) + (setq executing-kbd-macro t + error-message nil) + ;; Bounce to previous non-position obtained through evaluation. + "e nil RET" + "P" (should (string-match-p "Previous value not a number or marker" + error-message)) + (should-not executing-kbd-macro) + (setq executing-kbd-macro t + error-message nil) + "g")))) + (ert-deftest edebug-tests-step-into-function () "Edebug can step into a function." (edebug-tests-with-normal-env @@ -838,20 +950,23 @@ test and possibly others should be updated." (ert-deftest edebug-tests-evaluation-of-current-buffer-bug-19611 () "Edebug can evaluate `current-buffer' in correct context. (Bug#19611)." - (edebug-tests-with-normal-env - (edebug-tests-setup-@ "current-buffer" nil t) - (edebug-tests-run-kbd-macro - "@" (edebug-tests-should-be-at - "current-buffer" "start") - "SPC SPC SPC" (edebug-tests-should-be-at - "current-buffer" "body") - "e (current-buffer) RET" - ;; Edebug just prints the result without "Result:" - (should (string-match-p - (regexp-quote "*edebug-test-code-buffer*") - edebug-tests-messages)) - "g" (should (equal edebug-tests-@-result - "current-buffer: *edebug-test-code-buffer*"))))) + (unwind-protect + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "current-buffer" nil t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at + "current-buffer" "start") + "SPC SPC SPC" (edebug-tests-should-be-at + "current-buffer" "body") + "e (current-buffer) RET" + ;; Edebug just prints the result without "Result:" + (should (string-match-p + (regexp-quote "*edebug-test-code-buffer*") + edebug-tests-messages)) + "g" (should (equal edebug-tests-@-result + "current-buffer: *edebug-test-code-buffer*")))) + (when (get-buffer "*edebug-test-code-buffer*") + (kill-buffer "*edebug-test-code-buffer*")))) (ert-deftest edebug-tests-trivial-backquote () "Edebug can instrument a trivial backquote expression (Bug#23651)." From 98cd122776e0adddfdc5cd5f23df43c56df35647 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 30 Aug 2025 12:35:18 +0300 Subject: [PATCH 126/158] ; * doc/lispref/edebug.texi (Edebug Views): Fix wording of last change. --- doc/lispref/edebug.texi | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 97909e2bb55..2f5e4d27c46 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -691,13 +691,10 @@ before returning to Edebug. With a prefix argument @var{n}, pause for @findex edebug-bounce-to-previous-value @item P Temporarily display the outside current buffer with the outside point -corresponding to the previous value -(@code{edebug-bounce-to-previous-value}). The previous value is what -Edebug has evaluated before its last stop point or what you have -evaluated in the context outside of Edebug, for example, with -@kbd{C-x C-e}. This command pauses for one second before returning to -Edebug. With a prefix argument @var{n}, it pauses for @var{n} seconds -instead. +corresponding to the previously-evaluated value +(@code{edebug-bounce-to-previous-value}), pausing for one second +before returning to Edebug. With a prefix argument @var{n}, pause for +@var{n} seconds instead. @findex edebug-where @item w @@ -735,7 +732,10 @@ and you would like to know where @code{beg} and @code{end} are located in the outside buffer. Then you could either evaluate these, for example, with @kbd{C-x C-e}, or step over them with @kbd{n}, and immediately after that press @kbd{P}, to bounce to the position you have -previously evaluated. +previously evaluated. The previous value for the purpose of the @kbd{P} +command is what Edebug has evaluated before its last stop point or what +you have evaluated in the context outside of Edebug, for example, with +@kbd{C-x C-e}. After moving point, you may wish to jump back to the stop point. You can do that with @kbd{w} from a source code buffer. You can jump From 8d301906e1f53b366316754d1f3ff2ad7f0f673c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sergio=20Pastor=20P=C3=A9rez?= Date: Sun, 24 Aug 2025 20:27:06 +0200 Subject: [PATCH 127/158] bug#79241: Fix incorrect handling of overlays in `vertical-motion' * src/indent.c (vertical-motion): If iterator is inside an overlay, reset it to the beginning of line before trying to reach goal column. This prevents point from being stuck at the beginning of overlay strings during upward motions. Copyright-paperwork-exempt: yes --- src/indent.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/indent.c b/src/indent.c index b4f3c349dc5..95228b26825 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2506,6 +2506,9 @@ buffer, whether or not it is currently displayed in some window. */) an addition to the hscroll amount. */ if (!NILP (lcols)) { + if (it.method == GET_FROM_STRING && !NILP (it.from_overlay)) + reseat_at_previous_visible_line_start(&it); + move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X); /* If we find ourselves in the middle of an overlay string which includes a newline after current string position, From 4ab16d701ecda72d8ed74cf0a5f0f63dfeeb087d Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Sat, 30 Aug 2025 11:19:05 +0100 Subject: [PATCH 128/158] Eglot: escape literal % characters in URIs Escape literal % characters in Eglot URIs Otherwise, a literal % in a file-name will be interpreted (by the language server) as if it were a part of a percent-encoded sequence. See Bug#78984 for context on why `url-path-allowed-chars' cannot be changed to escape literal % characters. * lisp/progmodes/eglot.el (eglot--uri-path-allowed-chars): Escape %, remove the redundant variable definition. * test/lisp/progmodes/eglot-tests.el (eglot-test-path-to-uri-escape): test it. --- lisp/progmodes/eglot.el | 7 +------ test/lisp/progmodes/eglot-tests.el | 4 ++++ 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 29e6c269fdf..ee76d2fd5e4 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -675,6 +675,7 @@ This can be useful when using docker to run a language server.") (defconst eglot--uri-path-allowed-chars (let ((vec (copy-sequence url-path-allowed-chars))) (aset vec ?: nil) ;; see github#639 + (aset vec ?% nil) ;; see bug#78984 vec) "Like `url-path-allowed-chars' but more restrictive.") @@ -2008,12 +2009,6 @@ If optional MARKER, return a marker instead" ;;; More helpers -(defconst eglot--uri-path-allowed-chars - (let ((vec (copy-sequence url-path-allowed-chars))) - (aset vec ?: nil) ;; see github#639 - vec) - "Like `url-path-allowed-chars' but more restrictive.") - (defun eglot--snippet-expansion-fn () "Compute a function to expand snippets. Doubles as an indicator of snippet support." diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 7fd4f0f0491..b01b7d269ec 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -1469,6 +1469,10 @@ GUESSED-MAJOR-MODES-SYM are bound to the useful return values of (should (string-suffix-p "c%3A/Users/Foo/bar.lisp" (eglot-path-to-uri "c:/Users/Foo/bar.lisp")))) +(ert-deftest eglot-test-path-to-uri-escape () + (should (equal "file:///path/with%20%25%20funny%20%3F%20characters" + (eglot-path-to-uri "/path/with % funny ? characters")))) + (ert-deftest eglot-test-same-server-multi-mode () "Check single LSP instance manages multiple modes in same project." (skip-unless (executable-find "clangd")) From 467c75893cb3178db71f788eadaf1dd1ac70c093 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 30 Aug 2025 13:22:05 +0300 Subject: [PATCH 129/158] ; Fix defcustom type * lisp/files.el (lock-file-name-transforms): Fix the 'defcustom' type. (Bug#79322) --- lisp/files.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 3e85244e4e9..bd229673d8d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -555,9 +555,13 @@ if different users access the same file, using different lock file settings; if accessing files on a shared file system from different hosts, using a transform that puts the lock files on a local file system." :group 'files - :type '(repeat (list (regexp :tag "Regexp") + :type `(repeat (list (regexp :tag "Regexp") (string :tag "Replacement") - (boolean :tag "Uniquify"))) + (choice + (const :tag "Uniquify" t) + ,@(mapcar (lambda (algo) + (list 'const algo)) + (secure-hash-algorithms))))) :version "28.1") (defcustom remote-file-name-inhibit-locks nil From 53f5a07bebbf9fc880de88c8624ce3ed974b48ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sat, 30 Aug 2025 11:43:41 +0100 Subject: [PATCH 130/158] Eglot: fix likely off-by-1 in LabelOffsetSupport feature (bug#79259) This feature was tweaked and last tested with a 2019 edition of the 'ccls' LSP. The spec does not clearly specify this number to be 0-indexed, but it would make sense that it would be so. So there's not need to 1+ - correct the numbers at all before using them in substring. This would fix the Haskell server use of this feature (which is bug#79259) * lisp/progmodes/eglot.el (eglot--sig-info): Fix likely off-by-1. --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index ee76d2fd5e4..475b5e13f1b 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3718,7 +3718,7 @@ for which LSP on-type-formatting should be requested." (let ((case-fold-search nil)) (and (search-forward parlabel (line-end-position) t) (list (match-beginning 0) (match-end 0)))) - (mapcar #'1+ (append parlabel nil))))) + (list (aref parlabel 0) (aref parlabel 1))))) (if (and beg end) (add-face-text-property beg end From 14d20bff06a8832fb2ea465931e49caac5f4bc5c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 20 Aug 2025 11:26:39 +0100 Subject: [PATCH 131/158] Document C-x v M D and C-x v M L in the manual * doc/emacs/emacs.texi (Merge Bases): * doc/emacs/vc1-xtra.texi (Merge Bases): New node. --- doc/emacs/emacs.texi | 1 + doc/emacs/maintaining.texi | 2 +- doc/emacs/vc1-xtra.texi | 71 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 73 insertions(+), 1 deletion(-) diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index b373dc092f8..4b625f99f52 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -868,6 +868,7 @@ Miscellaneous Commands and Features of VC * Change Logs and VC:: Generating a change log file from log entries. * VC Delete/Rename:: Deleting and renaming version-controlled files. * Revision Tags:: Symbolic names for revisions. +* Merge Bases:: The most recent revision existing on both branches. * Other Working Trees:: Multiple sets of workfiles. * Version Headers:: Inserting version control headers into working files. * Editing VC Commands:: Editing the VC shell commands that Emacs will run. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 3de00fe8684..5801604204c 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1815,7 +1815,7 @@ and so on, depending on the number of existing branches at that point. @kindex C-x v b c @findex vc-create-branch This procedure will not work for distributed version control systems -like git or Mercurial. For those systems you should use the command +like Git or Mercurial. For those systems you should use the command @code{vc-create-branch} (@w{@kbd{C-x v b c @var{branch-name} @key{RET}}}) instead. diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 72e660a2def..8830b93c91a 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -14,6 +14,7 @@ * Change Logs and VC:: Generating a change log file from log entries. * VC Delete/Rename:: Deleting and renaming version-controlled files. * Revision Tags:: Symbolic names for revisions. +* Merge Bases:: The most recent revision existing on both branches. * Other Working Trees:: Multiple sets of workfiles. * Version Headers:: Inserting version control headers into working files. * Editing VC Commands:: Editing the VC shell commands that Emacs will run. @@ -227,6 +228,76 @@ an old tag, the renamed file is retrieved under its new name, which is not the name that the makefile expects. So the program won't really work as retrieved. +@node Merge Bases +@subsubsection Merge Bases +@cindex merge bases + +@table @kbd +@item C-x v M D +Report diffs of changes on a branch since it diverged from another +(@code{vc-diff-mergebase}). + +@item C-x v M L +Display log messages for revisions on a branch since it diverged from +another (@code{vc-log-mergebase}). +@end table + +@c This definition is possibly dVCS-specific -- can revisions exist on +@c more than one branch for older VCS? This needs thinking through if +@c any of our centalized VCS gain support for these commands. +The @dfn{merge base} of two branches is the most recent revision that +exists on both branches. If neither of the branches were ever merged +into the other (@pxref{Merging}), then the merge base is the revision +that the older of the two branches was at when the newer branch was +created from it (@pxref{Creating Branches}). If one of the branches was +ever merged into the other, then the merge base is the most recent merge +point. + +With this understood, we can generalize the concept of a merge base from +branches to any two revisions. The merge base of two revisions is the +most recent revision that can be found in the revision history of both +of the two revisions.@footnote{In fact the concept generalizes to any +number of revisions, but Emacs's commands for merge bases work with only +two, so we limit ourselves to that.} + +The commands described in this section are currently implemented only +for decentralized version control systems (@pxref{VCS Repositories}). + +@kindex C-x v M D +@findex vc-diff-mergebase +@kindex C-x v M L +@findex vc-log-mergebase +Merge bases are useful to make certain comparisons between branches, and +Emacs provides two commands for doing so. Each of @kbd{C-x v M D} +(@code{vc-diff-mergebase}) and @kbd{C-x v M L} (@code{vc-log-mergebase}) +prompts for two branches, finds their merge base, and then compares that +merge base with the second of the two branches. The commands report +diffs and display change history, respectively. + +The typical use case for these commands is when one of the branches was +originally created from the other and you or a collaborator have made +merges of one of the branches into the other at least once. Then you +can use these commands to see what changes on one branch have not yet +been merged into the other. + +Call the branch which has the changes you are interested in the ``source +branch'' and the branch into which these changes have not yet been +merged the ``target branch''. Specify the target branch when prompted +for the ``older revision'' and the source branch when prompted for the +``newer revision''.@footnote{The concept of merge bases generalizes from +branches to any two revisions. The merge base of two revisions is the +most recent revision that can be found in the revision history of both +of the two revisions. @kbd{C-x v M D} and @kbd{C-x v M L} accept any +two revisions, not just branches. Comparing two branches is the same as +comparing the revisions at the ends of the branches. + +(In fact the concept generalizes to any number of revisions, but Emacs's +commands for merge bases work with only two, so we limit ourselves to +that.)} Then @kbd{C-x v M D} shows you a preview of what would change +on the target branch if you were to merge the source branch into it, and +@kbd{C-x v M L} shows you a log of the changes on the source branch not +yet merged into the target branch. + @node Other Working Trees @subsubsection Multiple Working Trees for One Repository From 29e673a77b148f0c215af161342c123ba30e509c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 17 Aug 2025 15:05:55 +0100 Subject: [PATCH 132/158] New commands for outgoing diffs including uncommitted changes * lisp/vc/vc.el (vc-root-diff-outgoing-base) (vc-diff-outgoing-base): New commands (bug#62940). * lisp/vc/vc-hooks.el (vc-prefix-map): Bind them. * doc/emacs/vc1-xtra.texi (Outgoing Base Diffs): * etc/NEWS: Document them. * doc/emacs/emacs.texi (Outgoing Base Diffs): New node. --- doc/emacs/emacs.texi | 1 + doc/emacs/vc1-xtra.texi | 85 +++++++++++++++++++++++++++++++++++++++++ etc/NEWS | 8 ++++ lisp/vc/vc-hooks.el | 2 + lisp/vc/vc.el | 71 ++++++++++++++++++++++++++++++++++ 5 files changed, 167 insertions(+) diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 4b625f99f52..b32c704bd12 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -869,6 +869,7 @@ Miscellaneous Commands and Features of VC * VC Delete/Rename:: Deleting and renaming version-controlled files. * Revision Tags:: Symbolic names for revisions. * Merge Bases:: The most recent revision existing on both branches. +* Outgoing Base Diffs:: Diffs including all outstanding changes on a branch. * Other Working Trees:: Multiple sets of workfiles. * Version Headers:: Inserting version control headers into working files. * Editing VC Commands:: Editing the VC shell commands that Emacs will run. diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 8830b93c91a..c96f21f0c83 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -15,6 +15,7 @@ * VC Delete/Rename:: Deleting and renaming version-controlled files. * Revision Tags:: Symbolic names for revisions. * Merge Bases:: The most recent revision existing on both branches. +* Outgoing Base Diffs:: Diffs including all outstanding changes on a branch. * Other Working Trees:: Multiple sets of workfiles. * Version Headers:: Inserting version control headers into working files. * Editing VC Commands:: Editing the VC shell commands that Emacs will run. @@ -298,6 +299,90 @@ on the target branch if you were to merge the source branch into it, and @kbd{C-x v M L} shows you a log of the changes on the source branch not yet merged into the target branch. +@node Outgoing Base Diffs +@subsubsection Commands for diffs including all outstanding changes +@cindex outstanding changes + +@table @kbd +@item C-x v B = +Display diffs of changes to the VC fileset since the merge base of this +branch and its upstream counterpart (@code{vc-diff-outgoing-base}). + +@item C-x v B D +Display all changes since the merge base of this branch and its upstream +counterpart (@code{vc-root-diff-outgoing-base}). +@end table + +For decentralized version control systems (@pxref{VCS Repositories}), +these commands provide specialized versions of @kbd{C-x v M D} (see +@pxref{Merge Bases}) which also take into account the state of upstream +repositories. These commands are useful both when working on a single +branch and when developing features on a separate branch +(@pxref{Branches}). These two cases involve using the commands +differently, and so we will describe them separately. + +First, consider working on a single branch. @dfn{Outstanding changes} +are those which you haven't yet pushed upstream. This includes both +unpushed commits and uncommitted changes in your working tree. In many +cases the reason these changes are not pushed yet is that they are not +finished: the changes committed so far don't make sense in isolation. + +@kindex C-x v B = +@findex vc-diff-outgoing-base +@kindex C-x v B D +@findex vc-root-diff-outgoing-base +Type @kbd{C-x v B D} (@code{vc-root-diff-outgoing-base}) to display a +summary of all these changes, committed and uncommitted. This summary +is in the form of a diff of what committing and pushing (@pxref{Pulling +/ Pushing}) all these changes would do to the upstream repository. You +can use @kbd{C-x v B =} (@code{vc-diff-outgoing-base}) instead to limit +the display of changes to the current VC fileset. (The difference +between @w{@kbd{C-x v B D}} and @w{@kbd{C-x v B =}} is like the +difference between @kbd{C-x v D} and @kbd{C-x v =} (@pxref{Old +Revisions}).)@footnote{Another point of comparison is that these +commands are like @w{@kbd{C-x v O =}} (@code{vc-fileset-diff-outgoing}) +and @kbd{C-x v O D} (@code{vc-root-diff-outgoing}) except that they +include uncommitted changes in the reported diffs. Like those other +commands, you can use a prefix argument to specify a particular upstream +location.} + +Second, consider developing a feature on a separate branch. Call this +the @dfn{feature branch},@footnote{Many version control workflows +involve developing new features on isolated branches. However, the term +``feature branch'' is usually reserved for a particular kind of isolated +branch, one that other branches are repeatedly merged into. + +That doesn't matter to this explanation, so we use ``feature branch'' to +refer to the separate branch used for developing the feature even though +whether it is really a feature branch depends on other aspects of the +branching workflow in use.} and call the branch from which the feature +branch was originally created the @dfn{trunk} or @dfn{development +trunk}. + +In this case, outstanding changes is a more specific notion than just +unpushed and uncommitted changes on the feature branch. You're not +finished sharing changes with your collaborators until they have been +merged into the trunk, and pushed. Therefore, in this example, +outstanding changes are those which haven't yet been integrated into the +upstream repository's development trunk. That means committed changes +on the feature branch that haven't yet been merged into the trunk, plus +uncommitted changes. + +@cindex outgoing base, version control +The @dfn{outgoing base} is the upstream location for which the changes +are destined once they are no longer outstanding. In this case, that's +the upstream version of the trunk, to which you and your collaborators +push finished work. + +To display a summary of outgoing changes in this multi-branch example, +supply a prefix argument, by typing @w{@kbd{C-u C-x v B =}} or +@w{@kbd{C-u C-x v B D}}. When prompted, enter the outgoing base. +Exactly what you must supply here depends on the name of your +development trunk and the version control system in use. For example, +with Git, usually you will enter @kbd{origin/master}. We hope to +improve these commands such that no prefix argument is required in the +multi-branch case, too. + @node Other Working Trees @subsubsection Multiple Working Trees for One Repository diff --git a/etc/NEWS b/etc/NEWS index c9f30dc7ef7..3dc0e0a7677 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2173,6 +2173,14 @@ include were committed and will be pushed. 'vc-diff-incoming' and 'vc-diff-outgoing' are similar but limited to the current VC fileset. ++++ +*** New commands to report diffs of outstanding changes. +'C-x v B =' ('vc-diff-outgoing-base') and 'C-x v B D' +('vc-root-diff-outgoing-base') report diffs of changes since the merge +base with the remote branch, including uncommitted changes. +They are useful to view all outstanding (unmerged, unpushed) changes on +the current branch. + +++ *** New user option 'vc-use-incoming-outgoing-prefixes'. If this is customized to non-nil, 'C-x v I' and 'C-x v O' become prefix diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index cfca7b4662e..999bf279fba 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -952,6 +952,8 @@ In the latter case, VC mode is deactivated for this buffer." "O" #'vc-log-outgoing "M L" #'vc-log-mergebase "M D" #'vc-diff-mergebase + "B =" #'vc-diff-outgoing-base + "B D" #'vc-root-diff-outgoing-base "m" #'vc-merge "r" #'vc-retrieve-tag "s" #'vc-create-tag diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 9634b06a40e..9d0445fb50a 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2575,6 +2575,9 @@ When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. When called interactively with a prefix argument, prompt for REMOTE-LOCATION. In some version control systems REMOTE-LOCATION can be a remote branch name. +This command is like `vc-root-diff-outgoing-base' except that it does +not include uncommitted changes. + See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." (interactive (list (vc--maybe-read-remote-location))) @@ -2589,6 +2592,9 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION. In some version control systems REMOTE-LOCATION can be a remote branch name. When called from Lisp optional argument FILESET overrides the VC fileset. +This command is like `vc-diff-outgoing-base' except that it does not +include uncommitted changes. + See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." ;; For this command, for distributed VCS, we want to ignore @@ -2629,6 +2635,71 @@ global binding." (car fileset)) (called-interactively-p 'interactive)))) +;; For the following two commands, the default meaning for +;; REMOTE-LOCATION may become dependent on whether we are on a +;; shorter-lived or longer-lived ("trunk") branch. If we are on the +;; trunk then it will always be the place `vc-push' would push to. If +;; we are on a shorter-lived branch, it may instead become the remote +;; trunk branch from which the shorter-lived branch was branched. That +;; way you can use these commands to get a summary of all unmerged work +;; outstanding on the short-lived branch. +;; +;; The obstacle to doing this is that VC lacks any distinction between +;; shorter-lived and trunk branches. But we all work with both of +;; these, for almost any VCS workflow. E.g. modern workflows which +;; eschew traditional feature branches still have a long-lived trunk +;; plus shorter-lived local branches for merge requests or patch series. +;; --spwhitton + +;;;###autoload +(defun vc-root-diff-outgoing-base (&optional remote-location) + "Report diff of all changes since the merge base with REMOTE-LOCATION. +The merge base with REMOTE-LOCATION means the common ancestor of the +working revision and REMOTE-LOCATION. +Uncommitted changes are included in the diff. + +When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. +This default meaning for REMOTE-LOCATION may change in a future release +of Emacs. + +When called interactively with a prefix argument, prompt for +REMOTE-LOCATION. In some version control systems, REMOTE-LOCATION can +be a remote branch name. + +This command is like `vc-root-diff-outgoing' except that it includes +uncommitted changes." + (interactive (list (vc--maybe-read-remote-location))) + (vc--with-backend-in-rootdir "VC root-diff" + (vc-diff-outgoing-base remote-location `(,backend (,rootdir))))) + +;;;###autoload +(defun vc-diff-outgoing-base (&optional remote-location fileset) + "Report changes to VC fileset since the merge base with REMOTE-LOCATION. + +The merge base with REMOTE-LOCATION means the common ancestor of the +working revision and REMOTE-LOCATION. +Uncommitted changes are included in the diff. + +When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. +This default meaning for REMOTE-LOCATION may change in a future release +of Emacs. + +When called interactively with a prefix argument, prompt for +REMOTE-LOCATION. In some version control systems, REMOTE-LOCATION can +be a remote branch name. + +This command is like to `vc-fileset-diff-outgoing' except that it +includes uncommitted changes." + (interactive (list (vc--maybe-read-remote-location) nil)) + (let* ((fileset (or fileset (vc-deduce-fileset t))) + (backend (car fileset)) + (incoming (vc--incoming-revision backend + (or remote-location "")))) + (vc-diff-internal vc-allow-async-diff fileset + (vc-call-backend backend 'mergebase incoming) + nil + (called-interactively-p 'interactive)))) + (declare-function ediff-load-version-control "ediff" (&optional silent)) (declare-function ediff-vc-internal "ediff-vers" (rev1 rev2 &optional startup-hooks)) From 73aac05cfd78acf583d1fb6220f6796390246455 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 30 Aug 2025 13:45:07 +0300 Subject: [PATCH 133/158] Fix "C-u C-h C-n" * lisp/help.el (view-emacs-news): Widen the buffer before re-narrowing it again to a different version. (Bug#79324) --- lisp/help.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/help.el b/lisp/help.el index e6c5ea54812..4ba99868c4a 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -624,6 +624,7 @@ With argument, display info only for the selected version." (t (format "NEWS.%d" vn)))) res) (find-file (expand-file-name file data-directory)) + (widen) ; In case we already are visiting that NEWS file (emacs-news-view-mode) (goto-char (point-min)) (when (stringp version) From b610f36d44dda3beb5cf2b8b65bfb0d005afed5c Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Thu, 28 Aug 2025 15:04:39 -0400 Subject: [PATCH 134/158] Document and test 'let-alist' support for indexing * etc/NEWS: Announce 'let-alist' support for indexing. * test/lisp/emacs-lisp/let-alist-tests.el (let-alist-numbers): Add a test for 'let-alist's support for indexing. * doc/lispref/lists.texi (Association Lists): Document indexing with 'let-alist'. (Bug#66509) --- doc/lispref/lists.texi | 13 +++++++++++++ etc/NEWS | 6 ++++++ test/lisp/emacs-lisp/let-alist-tests.el | 11 +++++++++++ 3 files changed, 30 insertions(+) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 37a07421e94..81edcc63d5b 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1934,6 +1934,19 @@ Nested association lists is supported: Nesting @code{let-alist} inside each other is allowed, but the code in the inner @code{let-alist} can't access the variables bound by the outer @code{let-alist}. + +Indexing into lists is also supported: + +@lisp +(setq colors '((rose . red) (lily . (yellow pink)))) +(let-alist colors .lily.1) + @result{} pink +@end lisp + +Note that forms like @samp{.0} or @samp{.3} are interpreted as numbers +rather than as symbols, so they won't be bound to the corresponding +values in ALIST. + @end defmac @node Property Lists diff --git a/etc/NEWS b/etc/NEWS index 3dc0e0a7677..8a139cb03ca 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2854,6 +2854,12 @@ function 'load-path-filter-cache-directory-files', calling 'load' will cache the directories it scans and their files, and the following lookups should be faster. ++++ +** 'let-alist' supports indexing into lists. +The macro 'let-alist' now interprets symbols containing numbers as list +indices. For example, '.key.0' looks up 'key' in the alist and then +returns its first element. + ** Lexical binding --- diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el index 988b05b488c..b23178f5467 100644 --- a/test/lisp/emacs-lisp/let-alist-tests.el +++ b/test/lisp/emacs-lisp/let-alist-tests.el @@ -100,4 +100,15 @@ See Bug#24641." `[,(+ .a) ,(+ .a .b .b)]) [1 5]))) +(ert-deftest let-alist-numbers () + "Check that .num indexes into lists." + (should (equal + (let-alist + '(((a . val1) (b . (nil val2))) + (c . (val3))) + (list .0 .0.a .0.b.1 .c.0)) + ;; .0 is interpreted as a number, so we can't use `let-alist' + ;; to do indexing alone. Everything else works though. + '(0.0 val1 val2 val3)))) + ;;; let-alist-tests.el ends here From 8a284cbbc588d19d48ffbd159dfa506da468e351 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 30 Aug 2025 15:54:32 +0100 Subject: [PATCH 135/158] ; Fix `(emacs)Merge Bases' Intended to be included in previous commit. --- doc/emacs/vc1-xtra.texi | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index c96f21f0c83..41058aefce5 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -247,20 +247,13 @@ another (@code{vc-log-mergebase}). @c more than one branch for older VCS? This needs thinking through if @c any of our centalized VCS gain support for these commands. The @dfn{merge base} of two branches is the most recent revision that -exists on both branches. If neither of the branches were ever merged +exists on both branches. If neither of the branches was ever merged into the other (@pxref{Merging}), then the merge base is the revision that the older of the two branches was at when the newer branch was created from it (@pxref{Creating Branches}). If one of the branches was ever merged into the other, then the merge base is the most recent merge point. -With this understood, we can generalize the concept of a merge base from -branches to any two revisions. The merge base of two revisions is the -most recent revision that can be found in the revision history of both -of the two revisions.@footnote{In fact the concept generalizes to any -number of revisions, but Emacs's commands for merge bases work with only -two, so we limit ourselves to that.} - The commands described in this section are currently implemented only for decentralized version control systems (@pxref{VCS Repositories}). From b73d92c8b124d2da03bf1206f15c320cbc5a1bd8 Mon Sep 17 00:00:00 2001 From: Jeremy Bryant Date: Fri, 29 Aug 2025 22:41:40 +0100 Subject: [PATCH 136/158] * lisp/saveplace.el (save-places-to-alist): Add doc string. Replace previous comment and simplify wording by refering to the function 'save-place-to-alist' being called on all buffers. (Bug#79340) --- lisp/saveplace.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 1f36196408a..51df1edeaa7 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -406,8 +406,8 @@ may have changed) back to `save-place-alist'." (file-error (message "Saving places: can't write %s" file))))))) (defun save-places-to-alist () - ;; go through buffer-list, saving places to alist if save-place-mode - ;; is non-nil, deleting them from alist if it is nil. + "Save all buffer filenames and positions to `save-place-alist'. +See `save-place-to-alist'." (let ((buf-list (buffer-list))) (while buf-list ;; put this into a save-excursion in case someone is counting on From 32d3c859f07a684ce1712f3a66d377ca94a829af Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 30 Aug 2025 19:50:22 +0300 Subject: [PATCH 137/158] Fix EOL decoding in files extracted from ZIP archives * lisp/arc-mode.el (archive-set-buffer-as-visiting-file): Don't lose EOL conversion determined by 'decode-coding-region' from the extracted file's data. (Bug#79316) --- lisp/arc-mode.el | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 8f6c71a4b74..0c5d3475aa6 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1067,8 +1067,19 @@ using `make-temp-file', and the generated name is returned." (setq coding (coding-system-change-text-conversion coding 'raw-text))) (unless (memq coding '(nil no-conversion)) + ;; If CODING specifies a certain EOL conversion, reset that, to + ;; force 'decode-coding-region' below determine EOL conversion + ;; from the file's data... + (if (numberp (coding-system-eol-type coding)) + (setq coding (coding-system-change-eol-conversion coding nil))) (decode-coding-region (point-min) (point-max) coding) - (setq last-coding-system-used coding)) + ;; ...then augment CODING with the actual EOL conversion + ;; determined from the file's data. + (let ((eol-type (coding-system-eol-type last-coding-system-used))) + (if (numberp eol-type) + (setq last-coding-system-used + (coding-system-change-eol-conversion coding eol-type)) + (setq last-coding-system-used coding)))) (set-buffer-modified-p nil) (kill-local-variable 'buffer-file-coding-system) (after-insert-file-set-coding (- (point-max) (point-min)))))) From 98fbaacac23fd0de591092800a7565605ad67df1 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Fri, 29 Aug 2025 17:00:47 -0400 Subject: [PATCH 138/158] Allow entering the debugger on error in emacsclient connections * lisp/server.el (server--process-filter-1): Use 'condition-case-unless-debug'. (Bug#65897) --- lisp/server.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/server.el b/lisp/server.el index 4415c45971e..70299d52f18 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1232,7 +1232,7 @@ The following commands are accepted by the client: (when prev (setq string (concat prev string)) (process-put proc 'previous-string nil))) - (condition-case err + (condition-case-unless-debug err (progn (server-add-client proc) ;; Send our pid From 8c663618ce884cccf989d7834f822b7384ee5e83 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 31 Aug 2025 09:54:17 +0300 Subject: [PATCH 139/158] ; * etc/NEWS: Document the change that fixed bug#65897. --- etc/NEWS | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 8a139cb03ca..09ef1d64647 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -614,6 +614,14 @@ To use the ':foreground' or current text color ensure the 'fill' attribute in the SVG is set to 'currentcolor', or set the image spec's ':css' value to 'svg {fill: currentcolor;}'. +--- +** Errors signaled by 'emacsclient' connections can now enter the debugger. +If 'debug-on-error' is non-nil, errors signaled by Lisp programs +executed due to 'emacsclient' connections will now enter the Lisp +debugger and show the backtrace. If 'debug-on-error' is nil, these +errors will be sent to 'emacsclient', as before, and will be displayed +on the terminal from which 'emacsclient' was invoked. + * Editing Changes in Emacs 31.1 From 11dc1420e449dd936e31d77fe445cb7abac88fb8 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 31 Aug 2025 16:32:48 +0100 Subject: [PATCH 140/158] * lisp/vc/vc.el (vc-revert): Tighten up save-some-buffers predicate. --- lisp/vc/vc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 9d0445fb50a..76ba024c209 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3667,7 +3667,8 @@ to the working revision (except for keyword expansion)." (when (or (not files) (memq (buffer-file-name) files)) (vc-buffer-sync nil)) (save-some-buffers nil (lambda () - (member (buffer-file-name) files))) + (and-let* ((n (buffer-file-name))) + (member n files)))) (let (needs-save) (dolist (file files) (let ((buf (get-file-buffer file))) From 0cd0aaa14fc4b2279d3d8bb8afe0aaa647c8f272 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 31 Aug 2025 16:37:11 +0100 Subject: [PATCH 141/158] vc-revert: Fix calling vc-buffer-sync (bug#79319) * lisp/vc/vc.el (vc-revert): Don't call vc-buffer-sync on a non-file-visiting buffer (bug#79319). Don't try to use memq to compare strings. --- lisp/vc/vc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 76ba024c209..229ec112bed 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3664,7 +3664,8 @@ to the working revision (except for keyword expansion)." ;; If any of the files is visited by the current buffer, make sure ;; buffer is saved. If the user says `no', abort since we cannot ;; show the changes and ask for confirmation to discard them. - (when (or (not files) (memq (buffer-file-name) files)) + (when-let* ((n (buffer-file-name)) + ((or (not files) (member n files)))) (vc-buffer-sync nil)) (save-some-buffers nil (lambda () (and-let* ((n (buffer-file-name))) From 07adb8b59dee772b56612b90acd19e1a5a456628 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 31 Aug 2025 20:30:18 +0300 Subject: [PATCH 142/158] * doc/emacs/modes.texi (Choosing Modes): Document 'treesit-enabled-modes'. --- doc/emacs/modes.texi | 8 ++++++++ etc/NEWS | 1 + 2 files changed, 9 insertions(+) diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index c3008a48b04..4a9d753bf6f 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -507,6 +507,14 @@ predictable behavior, we recommend that you always customize this variable overrides any remapping that Emacs might decide to perform internally. +@vindex treesit-enabled-modes + For extra convenience of enabling major modes based on the tree-sitter, +the user option @code{treesit-enabled-modes} supports the value @code{t} +that enables all available tree-sitter based modes, or a list of mode +names to enable like @code{c-ts-mode}. After customizing this option, +it adds the corresponding mappings to @code{major-mode-remap-alist} such +as remapping from @code{c-mode} to @code{c-ts-mode}. + @findex normal-mode If you have changed the major mode of a buffer, you can return to the major mode Emacs would have chosen automatically, by typing diff --git a/etc/NEWS b/etc/NEWS index 09ef1d64647..4bf5f1dee9c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -769,6 +769,7 @@ the default UI you get, i.e., when 'register-use-preview' is 'traditional'. ** Tree-sitter ++++ *** New user option 'treesit-enabled-modes'. You can customize it either to t to enable all available ts-modes, or to select a list of ts-modes to enable. Depending on customization, From 1ba75cc6fc57e27c489d49f9fba0f7d6788e030b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 31 Aug 2025 21:23:05 +0300 Subject: [PATCH 143/158] New user option 'tab-line-define-keys' * lisp/tab-line.el (tab-line-define-keys): New defcustom. (tab-line--define-keys, tab-line--undefine-keys): New functions that explicitly bind commands from 'tab-line-mode-map' to 'ctl-x-map'. (tab-line-mode-map): Leave this keymap empty by default to avoid breaking 'ctl-x-map' (bug#79323). (global-tab-line-mode): Call either 'tab-line--define-keys' or 'tab-line--undefine-keys'. --- etc/NEWS | 6 +++++ lisp/tab-line.el | 59 +++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 57 insertions(+), 8 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 4bf5f1dee9c..02a556a557d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -434,6 +434,12 @@ docstring for arguments passed to a help-text function. When non-nil, it truncates the tab bar, and therefore prevents wrapping and resizing the tab bar to more than one line. +--- +*** New user option 'tab-line-define-keys'. +When t, the default, it redefines window buffer switching keys +such as 'C-x ' and 'C-x ' to tab-line specific variants +for switching tabs. + --- *** New command 'tab-line-move-tab-forward' ('C-x M-'). Together with the new command 'tab-line-move-tab-backward' diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 7caae8bc2c1..fbf7f79eda8 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -1277,14 +1277,54 @@ However, return the correct mouse position list if EVENT is a (event-start event))) +(defcustom tab-line-define-keys t + "Define specific tab-line key bindings. +If t, the default, key mappings for switching and moving tabs +are defined. If nil, do not define any key mappings." + :type 'boolean + :initialize #'custom-initialize-default + :set (lambda (sym val) + (tab-line--undefine-keys) + (set-default sym val) + ;; Enable the new keybindings + (tab-line--define-keys)) + :group 'tab-line + :version "31.1") + +(defun tab-line--define-keys () + "Install key bindings to switch between tabs if so configured." + (when tab-line-define-keys + (when (eq (keymap-lookup ctl-x-map "") 'previous-buffer) + (keymap-set ctl-x-map "" #'tab-line-switch-to-prev-tab)) + (when (eq (keymap-lookup ctl-x-map "C-") 'previous-buffer) + (keymap-set ctl-x-map "C-" #'tab-line-switch-to-prev-tab)) + (unless (keymap-lookup ctl-x-map "M-") + (keymap-set ctl-x-map "M-" #'tab-line-move-tab-backward)) + (when (eq (keymap-lookup ctl-x-map "") 'next-buffer) + (keymap-set ctl-x-map "" #'tab-line-switch-to-next-tab)) + (when (eq (keymap-lookup ctl-x-map "C-") 'next-buffer) + (keymap-set ctl-x-map "C-" #'tab-line-switch-to-next-tab)) + (unless (keymap-lookup ctl-x-map "M-") + (keymap-set ctl-x-map "M-" #'tab-line-move-tab-forward)))) + +(defun tab-line--undefine-keys () + "Uninstall key bindings previously bound by `tab-line--define-keys'." + (when tab-line-define-keys + (when (eq (keymap-lookup ctl-x-map "") 'tab-line-switch-to-prev-tab) + (keymap-set ctl-x-map "" #'previous-buffer)) + (when (eq (keymap-lookup ctl-x-map "C-") 'tab-line-switch-to-prev-tab) + (keymap-set ctl-x-map "C-" #'previous-buffer)) + (when (eq (keymap-lookup ctl-x-map "M-") 'tab-line-move-tab-backward) + (keymap-set ctl-x-map "M-" nil)) + (when (eq (keymap-lookup ctl-x-map "") 'tab-line-switch-to-next-tab) + (keymap-set ctl-x-map "" #'next-buffer)) + (when (eq (keymap-lookup ctl-x-map "C-") 'tab-line-switch-to-next-tab) + (keymap-set ctl-x-map "C-" #'next-buffer)) + (when (eq (keymap-lookup ctl-x-map "M-") 'tab-line-move-tab-forward) + (keymap-set ctl-x-map "M-" nil)))) + (defvar-keymap tab-line-mode-map - :doc "Keymap for keys of `tab-line-mode'." - "C-x " #'tab-line-switch-to-prev-tab - "C-x C-" #'tab-line-switch-to-prev-tab - "C-x M-" #'tab-line-move-tab-backward - "C-x " #'tab-line-switch-to-next-tab - "C-x C-" #'tab-line-switch-to-next-tab - "C-x M-" #'tab-line-move-tab-forward) + :doc "Keymap for keys of `tab-line-mode'.") (defvar-keymap tab-line-switch-repeat-map :doc "Keymap to repeat tab/buffer cycling. Used in `repeat-mode'." @@ -1374,7 +1414,10 @@ of `tab-line-exclude', are exempt from `tab-line-mode'." (define-globalized-minor-mode global-tab-line-mode tab-line-mode tab-line-mode--turn-on :group 'tab-line - :version "27.1") + :version "27.1" + (if global-tab-line-mode + (tab-line--define-keys) + (tab-line--undefine-keys))) (global-set-key [tab-line down-mouse-3] 'tab-line-context-menu) From 3c94ae5a37eac0191fe5d8bd85164b190ac10244 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 1 Sep 2025 00:57:44 -0400 Subject: [PATCH 144/158] (completion-file-name-table): Refine last fix * lisp/minibuffer.el (completion-file-name-table): Don't hardcode Tramp knowledge here. --- lisp/minibuffer.el | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 64eb5d93fe6..914958a08a4 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3523,14 +3523,12 @@ same as `substitute-in-file-name'." (let ((comp ()) (pred (if (and (eq pred 'file-directory-p) - (not (string-match-p - (or (bound-and-true-p - tramp-completion-file-name-regexp) - (rx unmatchable)) - string))) + ;; File-name-handlers don't necessarily follow + ;; that convention (bug#79236). + (not (find-file-name-handler + realdir 'file-name-all-completions))) ;; Brute-force speed up for directory checking: ;; Discard strings which don't end in a slash. - ;; Unless it is a Tramp construct like "/ssh:". (lambda (s) (let ((len (length s))) (and (> len 0) (eq (aref s (1- len)) ?/)))) From fa256f11ed75b6bcf4c34443d970101cb239022e Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 1 Sep 2025 09:32:40 +0100 Subject: [PATCH 145/158] VC outgoing commands for Git: Don't unconditionally fetch * lisp/vc/vc-bzr.el (vc-bzr-incoming-revision): * lisp/vc/vc-hg.el (vc-hg-incoming-revision): * lisp/vc/vc.el (vc-diff-incoming, vc--incoming-revision): New REFRESH optional argument. (vc-default-log-incoming): Pass it. * lisp/vc/vc-git.el (vc-git-incoming-revision): New REFRESH optional argument. When nil, use cached info (bug#62940). --- lisp/vc/vc-bzr.el | 2 +- lisp/vc/vc-git.el | 29 +++++++++++++++-------------- lisp/vc/vc-hg.el | 2 +- lisp/vc/vc.el | 14 +++++++++----- 4 files changed, 26 insertions(+), 21 deletions(-) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index f345a1b2779..fcec13cf24e 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -822,7 +822,7 @@ If LIMIT is non-nil, show no more than this many entries." (list "--theirs-only" (and (not (string-empty-p remote-location)) remote-location)))) -(defun vc-bzr-incoming-revision (remote-location) +(defun vc-bzr-incoming-revision (remote-location &optional _refresh) (with-temp-buffer (vc-bzr-command "missing" t 1 nil "--log-format=long" "--show-ids" diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index b5da03764d1..99203402d88 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -70,7 +70,7 @@ ;; - get-change-comment (files rev) OK ;; HISTORY FUNCTIONS ;; * print-log (files buffer &optional shortlog start-revision limit) OK -;; * incoming-revision (remote-location) OK +;; * incoming-revision (remote-location &optional refresh) OK ;; - log-search (buffer pattern) OK ;; - log-view-mode () OK ;; - show-log-entry (revision) OK @@ -1605,19 +1605,20 @@ If LIMIT is a non-empty string, use it as a base revision." start-revision)) '("--"))))))) -(defun vc-git-incoming-revision (remote-location) - (vc-git-command nil 0 nil "fetch" - (and (not (string-empty-p remote-location)) - ;; Extract remote from "remote/branch". - (replace-regexp-in-string "/.*" "" - remote-location))) - (ignore-errors ; in order to return nil if no such branch - (with-output-to-string - (vc-git-command standard-output 0 nil - "log" "--max-count=1" "--pretty=format:%H" - (if (string-empty-p remote-location) - "@{upstream}" - remote-location))))) +(defun vc-git-incoming-revision (remote-location &optional refresh) + (let ((rev (if (string-empty-p remote-location) + "@{upstream}" + remote-location))) + (when (or refresh (null (vc-git--rev-parse rev))) + (vc-git-command nil 0 nil "fetch" + (and (not (string-empty-p remote-location)) + ;; Extract remote from "remote/branch". + (replace-regexp-in-string "/.*" "" + remote-location)))) + (ignore-errors ; in order to return nil if no such branch + (with-output-to-string + (vc-git-command standard-output 0 nil + "log" "--max-count=1" "--pretty=format:%H" rev))))) (defun vc-git-log-search (buffer pattern) "Search the log of changes for PATTERN and output results into BUFFER. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 550d13f9adc..c867da5d34f 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1531,7 +1531,7 @@ This runs the command \"hg summary\"." (nreverse result)) "\n")))) -(defun vc-hg-incoming-revision (remote-location) +(defun vc-hg-incoming-revision (remote-location &optional _refresh) (let* ((remote-location (if (string-empty-p remote-location) "default" remote-location)) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 229ec112bed..3349231df92 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -408,13 +408,16 @@ ;; received when performing a pull operation from REMOTE-LOCATION. ;; Deprecated: implement incoming-revision and mergebase instead. ;; -;; * incoming-revision (remote-location) +;; * incoming-revision (remote-location &optional refresh) ;; ;; Return revision at the head of the branch at REMOTE-LOCATION. ;; If there is no such branch there, return nil. (Should signal an ;; error, not return nil, in the case that fetching data fails.) ;; For a distributed VCS, should also fetch that revision into local ;; storage for operating on by subsequent calls into the backend. +;; The backend may rely on cached information from a previous fetch +;; from REMOTE-LOCATION unless REFRESH is non-nil, which means that +;; the most up-to-date information possible is required. ;; ;; - log-search (buffer pattern) ;; @@ -2562,7 +2565,8 @@ global binding." (let* ((fileset (or fileset (vc-deduce-fileset t))) (backend (car fileset)) (incoming (vc--incoming-revision backend - (or remote-location "")))) + (or remote-location "") + 'refresh))) (vc-diff-internal vc-allow-async-diff fileset (vc-call-backend backend 'mergebase incoming) incoming @@ -3548,8 +3552,8 @@ The command prompts for the branch whose change log to show." (read-string "Remote location/branch (empty for default): " nil 'vc-remote-location-history))) -(defun vc--incoming-revision (backend remote-location) - (or (vc-call-backend backend 'incoming-revision remote-location) +(defun vc--incoming-revision (backend remote-location &optional refresh) + (or (vc-call-backend backend 'incoming-revision remote-location refresh) (user-error "No incoming revision -- local-only branch?"))) ;;;###autoload @@ -3565,7 +3569,7 @@ In some version control systems REMOTE-LOCATION can be a remote branch name." (defun vc-default-log-incoming (_backend buffer remote-location) (vc--with-backend-in-rootdir "" - (let ((incoming (vc--incoming-revision backend remote-location))) + (let ((incoming (vc--incoming-revision backend remote-location 'refresh))) (vc-call-backend backend 'print-log (list rootdir) buffer t incoming (vc-call-backend backend 'mergebase incoming))))) From 66ef930ebea4618c1dac71a09495766476ced1d6 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 1 Sep 2025 09:41:40 +0100 Subject: [PATCH 146/158] Rename arg REMOTE-LOCATION -> UPSTREAM-LOCATION * lisp/vc/vc-bzr.el (vc-bzr-log-incoming) (vc-bzr-incoming-revision, vc-bzr-log-outgoing): * lisp/vc/vc-git.el (vc-git-incoming-revision): * lisp/vc/vc-hg.el (vc-hg-incoming-revision): * lisp/vc/vc.el (vc-root-diff-incoming, vc-diff-incoming) (vc-root-diff-outgoing, vc-diff-outgoing) (vc-root-diff-outgoing-base, vc-diff-outgoing-base) (vc-incoming-outgoing-internal, vc-remote-location-history) (vc--incoming-revision, vc-log-incoming, vc-default-log-incoming) (vc-log-outgoing, vc-default-log-outgoing): Rename arguments REMOTE-LOCATION -> UPSTREAM-LOCATION. Adjust strings. (vc--maybe-read-remote-location): Rename ... (vc--maybe-read-upstream-location): ... to this. --- lisp/vc/vc-bzr.el | 18 +-- lisp/vc/vc-git.el | 12 +- lisp/vc/vc-hg.el | 10 +- lisp/vc/vc.el | 181 ++++++++++++++++-------------- test/lisp/vc/vc-tests/vc-tests.el | 4 +- 5 files changed, 117 insertions(+), 108 deletions(-) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index fcec13cf24e..df8005309ce 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -817,27 +817,27 @@ If LIMIT is non-nil, show no more than this many entries." (buffer-substring (match-end 0) (point-max))))) ;; FIXME: Implement `vc-bzr-mergebase' and then delete this. -(defun vc-bzr-log-incoming (buffer remote-location) +(defun vc-bzr-log-incoming (buffer upstream-location) (apply #'vc-bzr-command "missing" buffer 'async nil - (list "--theirs-only" (and (not (string-empty-p remote-location)) - remote-location)))) + (list "--theirs-only" (and (not (string-empty-p upstream-location)) + upstream-location)))) -(defun vc-bzr-incoming-revision (remote-location &optional _refresh) +(defun vc-bzr-incoming-revision (upstream-location &optional _refresh) (with-temp-buffer (vc-bzr-command "missing" t 1 nil "--log-format=long" "--show-ids" "--theirs-only" "-r-1.." - (and (not (string-empty-p remote-location)) - remote-location)) + (and (not (string-empty-p upstream-location)) + upstream-location)) (goto-char (point-min)) (and (re-search-forward "^revision-id: " nil t) (buffer-substring (point) (pos-eol))))) ;; FIXME: Implement `vc-bzr-mergebase' and then delete this. -(defun vc-bzr-log-outgoing (buffer remote-location) +(defun vc-bzr-log-outgoing (buffer upstream-location) (apply #'vc-bzr-command "missing" buffer 'async nil - (list "--mine-only" (and (not (string-empty-p remote-location)) - remote-location)))) + (list "--mine-only" (and (not (string-empty-p upstream-location)) + upstream-location)))) (defun vc-bzr-show-log-entry (revision) "Find entry for patch name REVISION in bzr change log buffer." diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 99203402d88..5e2f0e5bb20 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -70,7 +70,7 @@ ;; - get-change-comment (files rev) OK ;; HISTORY FUNCTIONS ;; * print-log (files buffer &optional shortlog start-revision limit) OK -;; * incoming-revision (remote-location &optional refresh) OK +;; * incoming-revision (upstream-location &optional refresh) OK ;; - log-search (buffer pattern) OK ;; - log-view-mode () OK ;; - show-log-entry (revision) OK @@ -1605,16 +1605,16 @@ If LIMIT is a non-empty string, use it as a base revision." start-revision)) '("--"))))))) -(defun vc-git-incoming-revision (remote-location &optional refresh) - (let ((rev (if (string-empty-p remote-location) +(defun vc-git-incoming-revision (upstream-location &optional refresh) + (let ((rev (if (string-empty-p upstream-location) "@{upstream}" - remote-location))) + upstream-location))) (when (or refresh (null (vc-git--rev-parse rev))) (vc-git-command nil 0 nil "fetch" - (and (not (string-empty-p remote-location)) + (and (not (string-empty-p upstream-location)) ;; Extract remote from "remote/branch". (replace-regexp-in-string "/.*" "" - remote-location)))) + upstream-location)))) (ignore-errors ; in order to return nil if no such branch (with-output-to-string (vc-git-command standard-output 0 nil diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index c867da5d34f..32725f6b5fb 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1531,19 +1531,19 @@ This runs the command \"hg summary\"." (nreverse result)) "\n")))) -(defun vc-hg-incoming-revision (remote-location &optional _refresh) - (let* ((remote-location (if (string-empty-p remote-location) +(defun vc-hg-incoming-revision (upstream-location &optional _refresh) + (let* ((upstream-location (if (string-empty-p upstream-location) "default" - remote-location)) + upstream-location)) ;; Use 'hg identify' like this, and not 'hg incoming', because ;; this will give a sensible answer regardless of whether the ;; incoming revision has been pulled yet. (rev (with-output-to-string (vc-hg-command standard-output 0 nil "identify" "--id" - remote-location "--template={node}")))) + upstream-location "--template={node}")))) (condition-case _ (vc-hg-command nil 0 nil "log" "-r" rev) ;; We don't have the revision locally. Pull it. - (error (vc-hg-command nil 0 nil "pull" remote-location))) + (error (vc-hg-command nil 0 nil "pull" upstream-location))) rev)) (defun vc-hg-mergebase (rev1 &optional rev2) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 3349231df92..8b918654242 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -396,27 +396,27 @@ ;; revision shown, rather than the working revision, which is normally ;; the case). Not all backends support this. ;; -;; - log-outgoing (buffer remote-location) (DEPRECATED) +;; - log-outgoing (buffer upstream-location) (DEPRECATED) ;; ;; Insert in BUFFER the revision log for the changes that will be -;; sent when performing a push operation to REMOTE-LOCATION. +;; sent when performing a push operation to UPSTREAM-LOCATION. ;; Deprecated: implement incoming-revision and mergebase instead. ;; -;; - log-incoming (buffer remote-location) (DEPRECATED) +;; - log-incoming (buffer upstream-location) (DEPRECATED) ;; ;; Insert in BUFFER the revision log for the changes that will be -;; received when performing a pull operation from REMOTE-LOCATION. +;; received when performing a pull operation from UPSTREAM-LOCATION. ;; Deprecated: implement incoming-revision and mergebase instead. ;; -;; * incoming-revision (remote-location &optional refresh) +;; * incoming-revision (upstream-location &optional refresh) ;; -;; Return revision at the head of the branch at REMOTE-LOCATION. +;; Return revision at the head of the branch at UPSTREAM-LOCATION. ;; If there is no such branch there, return nil. (Should signal an ;; error, not return nil, in the case that fetching data fails.) ;; For a distributed VCS, should also fetch that revision into local ;; storage for operating on by subsequent calls into the backend. ;; The backend may rely on cached information from a previous fetch -;; from REMOTE-LOCATION unless REFRESH is non-nil, which means that +;; from UPSTREAM-LOCATION unless REFRESH is non-nil, which means that ;; the most up-to-date information possible is required. ;; ;; - log-search (buffer pattern) @@ -2539,33 +2539,36 @@ The merge base is a common ancestor between REV1 and REV2 revisions." (called-interactively-p 'interactive))))) ;;;###autoload -(defun vc-root-diff-incoming (&optional remote-location) - "Report diff of all changes that would be pulled from REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name. +(defun vc-root-diff-incoming (&optional upstream-location) + "Report diff of all changes that would be pulled from UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull +from. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name. See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." - (interactive (list (vc--maybe-read-remote-location))) + (interactive (list (vc--maybe-read-upstream-location))) (vc--with-backend-in-rootdir "VC root-diff" - (vc-diff-incoming remote-location `(,backend (,rootdir))))) + (vc-diff-incoming upstream-location `(,backend (,rootdir))))) ;;;###autoload -(defun vc-diff-incoming (&optional remote-location fileset) - "Report changes to VC fileset that would be pulled from REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name. -When called from Lisp optional argument FILESET overrides the VC fileset. +(defun vc-diff-incoming (&optional upstream-location fileset) + "Report changes to VC fileset that would be pulled from UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull +from. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name. +When called from Lisp optional argument FILESET overrides the VC +fileset. See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." - (interactive (list (vc--maybe-read-remote-location) nil)) + (interactive (list (vc--maybe-read-upstream-location) nil)) (let* ((fileset (or fileset (vc-deduce-fileset t))) (backend (car fileset)) (incoming (vc--incoming-revision backend - (or remote-location "") + (or upstream-location "") 'refresh))) (vc-diff-internal vc-allow-async-diff fileset (vc-call-backend backend 'mergebase incoming) @@ -2573,28 +2576,31 @@ global binding." (called-interactively-p 'interactive)))) ;;;###autoload -(defun vc-root-diff-outgoing (&optional remote-location) - "Report diff of all changes that would be pushed to REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name. +(defun vc-root-diff-outgoing (&optional upstream-location) + "Report diff of all changes that would be pushed to UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push +to. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name. This command is like `vc-root-diff-outgoing-base' except that it does not include uncommitted changes. See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." - (interactive (list (vc--maybe-read-remote-location))) + (interactive (list (vc--maybe-read-upstream-location))) (vc--with-backend-in-rootdir "VC root-diff" - (vc-diff-outgoing remote-location `(,backend (,rootdir))))) + (vc-diff-outgoing upstream-location `(,backend (,rootdir))))) ;;;###autoload -(defun vc-diff-outgoing (&optional remote-location fileset) - "Report changes to VC fileset that would be pushed to REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name. -When called from Lisp optional argument FILESET overrides the VC fileset. +(defun vc-diff-outgoing (&optional upstream-location fileset) + "Report changes to VC fileset that would be pushed to UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push +to. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name. +When called from Lisp optional argument FILESET overrides the VC +fileset. This command is like `vc-diff-outgoing-base' except that it does not include uncommitted changes. @@ -2606,11 +2612,11 @@ global binding." ;; for those VCS is to make a comparison between locally committed ;; changes and remote committed changes. ;; (Hence why we don't call `vc-buffer-sync-fileset'.) - (interactive (list (vc--maybe-read-remote-location))) + (interactive (list (vc--maybe-read-upstream-location))) (let* ((fileset (or fileset (vc-deduce-fileset t))) (backend (car fileset)) (incoming (vc--incoming-revision backend - (or remote-location "")))) + (or upstream-location "")))) (vc-diff-internal vc-allow-async-diff fileset (vc-call-backend backend 'mergebase incoming) ;; FIXME: In order to exclude uncommitted @@ -2640,7 +2646,7 @@ global binding." (called-interactively-p 'interactive)))) ;; For the following two commands, the default meaning for -;; REMOTE-LOCATION may become dependent on whether we are on a +;; UPSTREAM-LOCATION may become dependent on whether we are on a ;; shorter-lived or longer-lived ("trunk") branch. If we are on the ;; trunk then it will always be the place `vc-push' would push to. If ;; we are on a shorter-lived branch, it may instead become the remote @@ -2656,49 +2662,49 @@ global binding." ;; --spwhitton ;;;###autoload -(defun vc-root-diff-outgoing-base (&optional remote-location) - "Report diff of all changes since the merge base with REMOTE-LOCATION. -The merge base with REMOTE-LOCATION means the common ancestor of the -working revision and REMOTE-LOCATION. +(defun vc-root-diff-outgoing-base (&optional upstream-location) + "Report diff of all changes since the merge base with UPSTREAM-LOCATION. +The merge base with UPSTREAM-LOCATION means the common ancestor of the +working revision and UPSTREAM-LOCATION. Uncommitted changes are included in the diff. -When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. -This default meaning for REMOTE-LOCATION may change in a future release -of Emacs. +When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push +to. This default meaning for UPSTREAM-LOCATION may change in a future +release of Emacs. When called interactively with a prefix argument, prompt for -REMOTE-LOCATION. In some version control systems, REMOTE-LOCATION can -be a remote branch name. +UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION +can be a remote branch name. This command is like `vc-root-diff-outgoing' except that it includes uncommitted changes." - (interactive (list (vc--maybe-read-remote-location))) + (interactive (list (vc--maybe-read-upstream-location))) (vc--with-backend-in-rootdir "VC root-diff" - (vc-diff-outgoing-base remote-location `(,backend (,rootdir))))) + (vc-diff-outgoing-base upstream-location `(,backend (,rootdir))))) ;;;###autoload -(defun vc-diff-outgoing-base (&optional remote-location fileset) - "Report changes to VC fileset since the merge base with REMOTE-LOCATION. +(defun vc-diff-outgoing-base (&optional upstream-location fileset) + "Report changes to VC fileset since the merge base with UPSTREAM-LOCATION. -The merge base with REMOTE-LOCATION means the common ancestor of the -working revision and REMOTE-LOCATION. +The merge base with UPSTREAM-LOCATION means the common ancestor of the +working revision and UPSTREAM-LOCATION. Uncommitted changes are included in the diff. -When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. -This default meaning for REMOTE-LOCATION may change in a future release -of Emacs. +When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push +to. This default meaning for UPSTREAM-LOCATION may change in a future +release of Emacs. When called interactively with a prefix argument, prompt for -REMOTE-LOCATION. In some version control systems, REMOTE-LOCATION can -be a remote branch name. +UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION +can be a remote branch name. This command is like to `vc-fileset-diff-outgoing' except that it includes uncommitted changes." - (interactive (list (vc--maybe-read-remote-location) nil)) + (interactive (list (vc--maybe-read-upstream-location) nil)) (let* ((fileset (or fileset (vc-deduce-fileset t))) (backend (car fileset)) (incoming (vc--incoming-revision backend - (or remote-location "")))) + (or upstream-location "")))) (vc-diff-internal vc-allow-async-diff fileset (vc-call-backend backend 'mergebase incoming) nil @@ -3442,15 +3448,15 @@ Each function runs in the log output buffer without args.") (set-buffer-modified-p nil) (run-hooks 'vc-log-finish-functions))))) -(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type) +(defun vc-incoming-outgoing-internal (backend upstream-location buffer-name type) (vc-log-internal-common backend buffer-name nil type (lambda (bk buf type-arg _files) - (vc-call-backend bk type-arg buf remote-location)) + (vc-call-backend bk type-arg buf upstream-location)) (lambda (_bk _files-arg _ret) nil) nil ;; Don't move point. (lambda (_ignore-auto _noconfirm) - (vc-incoming-outgoing-internal backend remote-location buffer-name type)))) + (vc-incoming-outgoing-internal backend upstream-location buffer-name type)))) ;;;###autoload (defun vc-print-log (&optional working-revision limit) @@ -3544,50 +3550,53 @@ The command prompts for the branch whose change log to show." (list rootdir) branch t (when (> vc-log-show-limit 0) vc-log-show-limit)))) +;; FIXME: Consider renaming to `vc-upstream-location-history'. (defvar vc-remote-location-history nil - "History for remote locations for VC incoming and outgoing commands.") + "History of upstream locations for VC incoming and outgoing commands.") -(defun vc--maybe-read-remote-location () +(defun vc--maybe-read-upstream-location () (and current-prefix-arg - (read-string "Remote location/branch (empty for default): " nil + (read-string "Upstream location/branch (empty for default): " nil 'vc-remote-location-history))) -(defun vc--incoming-revision (backend remote-location &optional refresh) - (or (vc-call-backend backend 'incoming-revision remote-location refresh) +(defun vc--incoming-revision (backend upstream-location &optional refresh) + (or (vc-call-backend backend 'incoming-revision upstream-location refresh) (user-error "No incoming revision -- local-only branch?"))) ;;;###autoload -(defun vc-log-incoming (&optional remote-location) - "Show log of changes that will be received with pull from REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name." - (interactive (list (vc--maybe-read-remote-location))) +(defun vc-log-incoming (&optional upstream-location) + "Show log of changes that will be received with pull from UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull +from. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name." + (interactive (list (vc--maybe-read-upstream-location))) (vc--with-backend-in-rootdir "VC root-log" - (vc-incoming-outgoing-internal backend (or remote-location "") + (vc-incoming-outgoing-internal backend (or upstream-location "") "*vc-incoming*" 'log-incoming))) -(defun vc-default-log-incoming (_backend buffer remote-location) +(defun vc-default-log-incoming (_backend buffer upstream-location) (vc--with-backend-in-rootdir "" - (let ((incoming (vc--incoming-revision backend remote-location 'refresh))) + (let ((incoming (vc--incoming-revision backend upstream-location 'refresh))) (vc-call-backend backend 'print-log (list rootdir) buffer t incoming (vc-call-backend backend 'mergebase incoming))))) ;;;###autoload -(defun vc-log-outgoing (&optional remote-location) - "Show log of changes that will be sent with a push operation to REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name." - (interactive (list (vc--maybe-read-remote-location))) +(defun vc-log-outgoing (&optional upstream-location) + "Show log of changes that will be sent with a push to UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push +to. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name." + (interactive (list (vc--maybe-read-upstream-location))) (vc--with-backend-in-rootdir "VC root-log" - (vc-incoming-outgoing-internal backend (or remote-location "") + (vc-incoming-outgoing-internal backend (or upstream-location "") "*vc-outgoing*" 'log-outgoing))) -(defun vc-default-log-outgoing (_backend buffer remote-location) +(defun vc-default-log-outgoing (_backend buffer upstream-location) (vc--with-backend-in-rootdir "" - (let ((incoming (vc--incoming-revision backend remote-location))) + (let ((incoming (vc--incoming-revision backend upstream-location))) (vc-call-backend backend 'print-log (list rootdir) buffer t "" (vc-call-backend backend 'mergebase incoming))))) diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index 02be0e722e4..c9e2a4cac09 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -73,8 +73,8 @@ ;; HISTORY FUNCTIONS ;; ;; * print-log (files buffer &optional shortlog start-revision limit) -;; - log-outgoing (backend remote-location) -;; - log-incoming (backend remote-location) +;; - log-outgoing (backend upstream-location) +;; - log-incoming (backend upstream-location) ;; - log-view-mode () ;; - show-log-entry (revision) ;; - comment-history (file) From 7c6de4fe73334e45deb4954bfe56e43808471eca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 31 Aug 2025 19:05:36 +0200 Subject: [PATCH 147/158] * lisp/emacs-lisp/bytecomp.el (featurep): Safer comp-time evaluation --- lisp/emacs-lisp/bytecomp.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f48be896ca5..45a11af9a74 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5881,11 +5881,11 @@ and corresponding effects." ;;; Core compiler macros. (put 'featurep 'compiler-macro - (lambda (form feature &rest _ignore) + (lambda (form feature &rest rest) ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so ;; we can safely optimize away this test. - (if (member feature '('xemacs 'sxemacs 'emacs)) - (eval form) + (if (and (member feature '('xemacs 'sxemacs 'emacs)) (not rest)) + (featurep feature) form))) ;; Report comma operator used outside of backquote. From bbc9ed387193efb57b5dd0179057a343ef16b006 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 1 Sep 2025 12:51:15 +0200 Subject: [PATCH 148/158] * src/data.c (Fash): Speed up when argument and result are fixnums. --- src/data.c | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/data.c b/src/data.c index b8a48203bcf..202ab0a2a36 100644 --- a/src/data.c +++ b/src/data.c @@ -3523,10 +3523,10 @@ discarding bits. */) CHECK_INTEGER (value); CHECK_INTEGER (count); + if (BASE_EQ (value, make_fixnum (0))) + return value; if (! FIXNUMP (count)) { - if (BASE_EQ (value, make_fixnum (0))) - return value; if (mpz_sgn (*xbignum_val (count)) < 0) { EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value) @@ -3536,30 +3536,38 @@ discarding bits. */) overflow_error (); } - if (XFIXNUM (count) <= 0) + EMACS_INT c = XFIXNUM (count); + if (c <= 0) { - if (XFIXNUM (count) == 0) + if (c == 0) return value; if ((EMACS_INT) -1 >> 1 == -1 && FIXNUMP (value)) { - EMACS_INT shift = -XFIXNUM (count); + EMACS_INT shift = -c; EMACS_INT result = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift : XFIXNUM (value) < 0 ? -1 : 0); return make_fixnum (result); } } + else if (FIXNUMP (value)) + { + EMACS_INT v = XFIXNUM (value); + if (stdc_leading_zeros (v < 0 ? ~v : v) - c + >= EMACS_INT_WIDTH - FIXNUM_BITS + 1) + return make_fixnum (v << c); + } mpz_t const *zval = bignum_integer (&mpz[0], value); - if (XFIXNUM (count) < 0) + if (c < 0) { - if (TYPE_MAXIMUM (mp_bitcnt_t) < - XFIXNUM (count)) + if (TYPE_MAXIMUM (mp_bitcnt_t) < -c) return make_fixnum (mpz_sgn (*zval) < 0 ? -1 : 0); - mpz_fdiv_q_2exp (mpz[0], *zval, - XFIXNUM (count)); + mpz_fdiv_q_2exp (mpz[0], *zval, -c); } else - emacs_mpz_mul_2exp (mpz[0], *zval, XFIXNUM (count)); + emacs_mpz_mul_2exp (mpz[0], *zval, c); return make_integer_mpz (); } From 985657e5158b1eacf4d4d53bff5e3e0ca1e98af1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 1 Sep 2025 15:13:58 +0200 Subject: [PATCH 149/158] ; * src/data.c (Fash): GCC argument signedness quibble --- src/data.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/data.c b/src/data.c index 202ab0a2a36..5b3c9792ea0 100644 --- a/src/data.c +++ b/src/data.c @@ -3554,7 +3554,7 @@ discarding bits. */) else if (FIXNUMP (value)) { EMACS_INT v = XFIXNUM (value); - if (stdc_leading_zeros (v < 0 ? ~v : v) - c + if (stdc_leading_zeros ((EMACS_UINT)(v < 0 ? ~v : v)) - c >= EMACS_INT_WIDTH - FIXNUM_BITS + 1) return make_fixnum (v << c); } From 838e8e4140a36d070695575c24b34fe2b3092299 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 1 Sep 2025 15:27:57 +0100 Subject: [PATCH 150/158] New project-find-matching-buffer-function for diff-mode * lisp/vc/diff-mode.el (project-root): Declare. (diff-find-matching-buffer): New function. (diff-mode): Use it. * doc/emacs/vc1-xtra.texi (Other Working Trees): Document 'C-x v w w' in diff-mode buffers. --- doc/emacs/maintaining.texi | 2 +- doc/emacs/vc1-xtra.texi | 10 ++++++++++ lisp/vc/diff-mode.el | 23 +++++++++++++++++++++++ 3 files changed, 34 insertions(+), 1 deletion(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 5801604204c..62311e583b2 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -516,7 +516,7 @@ following subsections. You can use @kbd{C-x v v} either in a file-visiting buffer, in a Dired buffer, or in a VC Directory buffer; in the latter two cases the command operates on the fileset consisting of the marked files. You can also use @kbd{C-x v v}, in a buffer with -patches under Diff Mode (@pxref{Diff Mode}), in which case the command +patches under Diff mode (@pxref{Diff Mode}), in which case the command operates on the files whose diffs are shown in the buffer. Note that VC filesets are distinct from the named filesets used diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 41058aefce5..f235ccfa5fb 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -473,6 +473,16 @@ do and do not exist. In other words, the file or directory the current buffer visits probably exists in other working trees too, and this command lets you switch to those versions of the file. +@kbd{C-x v w w} also works in Diff mode (@pxref{Diff Mode}). Instead of +switching to a different buffer, the command changes the default +directory of the Diff mode buffer to the corresponding directory under +another working tree. This is useful with Diff mode buffers generated +by VC commands, such as @kbd{C-x v =} and @kbd{C-x v D} (@pxref{Old +Revisions}). You can use @kbd{C-x v w w} and then standard Diff mode +commands like @w{@kbd{C-c C-a}} (@code{diff-apply-hunk}) and @kbd{C-c +RET C-a} (@code{diff-apply-buffer}) to apply hunks from one working tree +to another. + @kindex C-x v w s @findex vc-working-tree-switch-project An alternative way to switch between working trees is @kbd{C-x v w s} diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 965ab861e05..c33263f5f4a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1642,6 +1642,7 @@ In read-only buffers the following bindings are also available: (add-hook 'font-lock-mode-hook #'diff--font-lock-cleanup nil 'local) (setq-local imenu-generic-expression diff-imenu-generic-expression) + (setq-local project-find-matching-buffer-function #'diff-find-matching-buffer) ;; These are not perfect. They would be better done separately for ;; context diffs and unidiffs. ;; (setq-local paragraph-start @@ -3358,6 +3359,28 @@ hunk text is not found in the source file." ) str) +(declare-function project-root "project") + +(defun diff-find-matching-buffer (current-project mirror-project) + "Change default directory to matching one under another project. +CURRENT-PROJECT is the project instance for the current project. +MIRROR-PROJECT is the project instance for the project to visit. +A matching directory has the same name relative to the project root. +If a matching directory does not exist in the other project, it is an +error (this avoids invalidating the relative file names in Diff mode +file headers). + +This function is intended to be used as the value of +`project-find-matching-buffer-function' in Diff mode buffers." + (let* ((mirror-root (project-root mirror-project)) + (relative-name (file-relative-name default-directory + (project-root current-project))) + (mirror-name (expand-file-name relative-name mirror-root))) + (if (file-directory-p mirror-name) + (message "Default directory changed to `%s'" + (setq default-directory mirror-name)) + (user-error "`%s' not found in `%s'" relative-name mirror-root)))) + ;;; Support for converting a diff to diff3 markers via `wiggle'. ;; Wiggle can be found at https://neil.brown.name/wiggle/ or in your nearest From 9c21c112770949b23829d2f3ad319d6b0fb9d089 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 1 Sep 2025 17:35:38 +0300 Subject: [PATCH 151/158] ; Improve documentation of 'treesit-enabled-modes' * lisp/treesit.el (treesit-enabled-modes): Doc fix. * doc/emacs/modes.texi (Choosing Modes): Extend and improve wording of a recently-added text. --- doc/emacs/modes.texi | 23 +++++++++++++++++------ lisp/treesit.el | 16 +++++++++++----- 2 files changed, 28 insertions(+), 11 deletions(-) diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index 4a9d753bf6f..b5049ccbd01 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -508,12 +508,23 @@ this variable overrides any remapping that Emacs might decide to perform internally. @vindex treesit-enabled-modes - For extra convenience of enabling major modes based on the tree-sitter, -the user option @code{treesit-enabled-modes} supports the value @code{t} -that enables all available tree-sitter based modes, or a list of mode -names to enable like @code{c-ts-mode}. After customizing this option, -it adds the corresponding mappings to @code{major-mode-remap-alist} such -as remapping from @code{c-mode} to @code{c-ts-mode}. + As a convenience feature for enabling major modes based on the +tree-sitter library (@pxref{Parsing Program Source,,, elisp, The Emacs +Lisp Reference Manual}), you can customize the user option +@code{treesit-enabled-modes} to selectively enable or disable +tree-sitter based modes: if the value is @code{t}, that enables all the +available tree-sitter based modes; if it is a list of mode names, that +enables only those modes. Customizing this option adds the +corresponding mappings to @code{major-mode-remap-alist} such as +remapping from @code{c-mode} to @code{c-ts-mode} (if you enable the +latter). By default, this option's value is @code{nil}, so no +tree-sitter based modes are enabled. + +Enabling a tree-stter based mode means that visiting files in the +corresponding programming language will automatically turn on that mode, +instead of any non-tree-sitter based modes for the same language. For +example, if you enable @code{c-ts-mode}, visiting C source files will +turn on @code{c-ts-mode} instead of @code{c-mode}. @findex normal-mode If you have changed the major mode of a buffer, you can return to diff --git a/lisp/treesit.el b/lisp/treesit.el index 218f4c7b36e..36d6c875d45 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -5404,13 +5404,19 @@ Tree-sitter grammar for `%s' is missing; install it?" ;;;###autoload (defcustom treesit-enabled-modes nil - "Specify what treesit modes to enable by default. + "Specify which tree-sitter based major modes to enable by default. The value can be either a list of ts-modes to enable, -or t to enable all ts-modes." +or t to enable all ts-modes. The value nil (the default) +means not to enable any tree-sitter based modes. + +Enabling a tree-stter based mode means that visiting files in the +corresponding programming language will automatically turn on that +mode, instead of any non-tree-sitter based modes for the same +language." :type `(choice - (const :tag "Disable all automatic associations" nil) - (const :tag "Enable all available ts-modes" t) - (set :tag "List of enabled ts-modes" + (const :tag "Disable all tree-sitter modes" nil) + (const :tag "Enable all available tree-sitter modes" t) + (set :tag "Enable specific tree-sitter modes" ,@(when (treesit-available-p) (sort (mapcar (lambda (m) `(function-item ,m)) (seq-uniq (mapcar #'cdr treesit-major-mode-remap-alist))))))) From b52ccb997d598caa321141c0abb553d3b3803eee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 1 Sep 2025 16:50:10 +0200 Subject: [PATCH 152/158] ; * lisp/emacs-lisp/bytecomp.el (featurep): mistake in last change --- lisp/emacs-lisp/bytecomp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 45a11af9a74..4fc56ae4b5d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5885,7 +5885,7 @@ and corresponding effects." ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so ;; we can safely optimize away this test. (if (and (member feature '('xemacs 'sxemacs 'emacs)) (not rest)) - (featurep feature) + (featurep (cadr feature)) form))) ;; Report comma operator used outside of backquote. From d2532a4ef0a1c037075b8a9d44b2dbdce372ef25 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Fri, 22 Aug 2025 15:05:12 +0200 Subject: [PATCH 153/158] Add new library 'timeout' * lisp/emacs-lisp/timeout.el: Add the file. * etc/NEWS: Mention the library. See https://mail.gnu.org/archive/html/emacs-devel/2025-07/msg00520.html. --- etc/NEWS | 6 + lisp/emacs-lisp/timeout.el | 243 +++++++++++++++++++++++++++++++++++++ 2 files changed, 249 insertions(+) create mode 100644 lisp/emacs-lisp/timeout.el diff --git a/etc/NEWS b/etc/NEWS index 02a556a557d..630d03a1fa0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2729,6 +2729,12 @@ enabled for files named "go.work". ** New package 'lua-mode'. The 'lua-mode' package from Non-GNU ELPA is now included in Emacs. +** New library 'timeout'. +This library that provides higher order functions to throttle or +debounce Elisp functions. This is useful for corraling over-eager code +that is slow and blocks Emacs or does not provide customization options +to limit how often it runs. + * Incompatible Lisp Changes in Emacs 31.1 diff --git a/lisp/emacs-lisp/timeout.el b/lisp/emacs-lisp/timeout.el new file mode 100644 index 00000000000..c949e7a912e --- /dev/null +++ b/lisp/emacs-lisp/timeout.el @@ -0,0 +1,243 @@ +;;; timeout.el --- Throttle or debounce Elisp functions -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Free Software Foundation, Inc. + +;; Author: Karthik Chikmagalur +;; Maintainer: Karthik Chikmagalur +;; Keywords: convenience, extensions +;; Version: 2.0 +;; Package-Requires: ((emacs "24.4")) +;; URL: https://github.com/karthink/timeout + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; timeout is a small Elisp library that provides higher order functions to +;; throttle or debounce Elisp functions. This is useful for corralling +;; over-eager code that: +;; (i) is slow and blocks Emacs, and +;; (ii) does not provide customization options to limit how often it runs, +;; +;; To throttle a function FUNC to run no more than once every 2 seconds, run +;; (timeout-throttle 'func 2.0) +;; +;; To debounce a function FUNC to run after a delay of 0.3 seconds, run +;; (timeout-debounce 'func 0.3) +;; +;; To create a new throttled or debounced version of FUNC instead, run +;; +;; (timeout-throttled-func 'func 2.0) +;; (timeout-debounced-func 'func 0.3) +;; +;; You can bind this via `defalias': +;; +;; (defalias 'throttled-func (timeout-throttled-func 'func 2.0)) +;; +;; The interactive spec and documentation of FUNC is carried over to the new +;; function. + +;;; Code: + +(require 'nadvice) + +(defun timeout--throttle-advice (&optional timeout) + "Return a function that throttles its argument function. + +TIMEOUT defaults to 1 second. + +When FUNC does not run because of the throttle, the result from the +previous successful call is returned. + +This is intended for use as function advice." + (let ((throttle-timer) + (timeout (or timeout 1.0)) + (result)) + (lambda (orig-fn &rest args) + "Throttle calls to this function." + (prog1 result + (unless (and throttle-timer (timerp throttle-timer)) + (setq result (apply orig-fn args)) + (setq throttle-timer + (run-with-timer + timeout nil + (lambda () + (cancel-timer throttle-timer) + (setq throttle-timer nil))))))))) + +(defun timeout--debounce-advice (&optional delay default) + "Return a function that debounces its argument function. + +DELAY defaults to 0.50 seconds. The function returns immediately with +value DEFAULT when called the first time. On future invocations, the +result from the previous call is returned. + +This is intended for use as function advice." + (let ((debounce-timer nil) + (delay (or delay 0.50))) + (lambda (orig-fn &rest args) + "Debounce calls to this function." + (prog1 default + (if (timerp debounce-timer) + (timer-set-idle-time debounce-timer delay) + (setq debounce-timer + (run-with-idle-timer + delay nil + (lambda (buf) + (cancel-timer debounce-timer) + (setq debounce-timer nil) + (setq default + (if (buffer-live-p buf) + (with-current-buffer buf + (apply orig-fn args)) + (apply orig-fn args)))) + (current-buffer)))))))) + +(defun timeout-debounce (func &optional delay default) + "Debounce FUNC by making it run DELAY seconds after it is called. + +This advises FUNC, when called (interactively or from code), to +run after DELAY seconds. If FUNC is called again within this time, +the timer is reset. + +DELAY defaults to 0.5 seconds. Using a delay of 0 removes any +debounce advice. + +The function returns immediately with value DEFAULT when called the +first time. On future invocations, the result from the previous call is +returned." + (if (and delay (= delay 0)) + (advice-remove func 'debounce) + (advice-add func :around (timeout--debounce-advice delay default) + '((name . debounce) + (depth . -99))))) + +(defun timeout-throttle (func &optional throttle) + "Make FUNC run no more frequently than once every THROTTLE seconds. + +THROTTLE defaults to 1 second. Using a throttle of 0 removes any +throttle advice. + +When FUNC does not run because of the throttle, the result from the +previous successful call is returned." + (if (and throttle (= throttle 0)) + (advice-remove func 'throttle) + (advice-add func :around (timeout--throttle-advice throttle) + '((name . throttle) + (depth . -98))))) + +(defun timeout-throttled-func (func &optional throttle) + "Return a throttled version of function FUNC. + +The throttled function runs no more frequently than once every THROTTLE +seconds. THROTTLE defaults to 1 second. + +When FUNC does not run because of the throttle, the result from the +previous successful call is returned." + (let ((throttle-timer nil) + (throttle (or throttle 1)) + (result)) + (if (commandp func) + ;; INTERACTIVE version + (lambda (&rest args) + (:documentation + (concat + (documentation func) + (format "\n\nThrottle calls to this function by %f seconds" throttle))) + (interactive (advice-eval-interactive-spec + (cadr (interactive-form func)))) + (prog1 result + (unless (and throttle-timer (timerp throttle-timer)) + (setq result (apply func args)) + (setq throttle-timer + (run-with-timer + throttle nil + (lambda () + (cancel-timer throttle-timer) + (setq throttle-timer nil))))))) + ;; NON-INTERACTIVE version + (lambda (&rest args) + (:documentation + (concat + (documentation func) + (format "\n\nThrottle calls to this function by %f seconds" throttle))) + (prog1 result + (unless (and throttle-timer (timerp throttle-timer)) + (setq result (apply func args)) + (setq throttle-timer + (run-with-timer + throttle nil + (lambda () + (cancel-timer throttle-timer) + (setq throttle-timer nil)))))))))) + +(defun timeout-debounced-func (func &optional delay default) + "Return a debounced version of function FUNC. + +The debounced function runs DELAY seconds after it is called. DELAY +defaults to 0.5 seconds. + +The function returns immediately with value DEFAULT when called the +first time. On future invocations, the result from the previous call is +returned." + (let ((debounce-timer nil) + (delay (or delay 0.50))) + (if (commandp func) + ;; INTERACTIVE version + (lambda (&rest args) + (:documentation + (concat + (documentation func) + (format "\n\nDebounce calls to this function by %f seconds" delay))) + (interactive (advice-eval-interactive-spec + (cadr (interactive-form func)))) + (prog1 default + (if (timerp debounce-timer) + (timer-set-idle-time debounce-timer delay) + (setq debounce-timer + (run-with-idle-timer + delay nil + (lambda (buf) + (cancel-timer debounce-timer) + (setq debounce-timer nil) + (setq default + (if (buffer-live-p buf) + (with-current-buffer buf + (apply func args)) + (apply func args)))) + (current-buffer)))))) + ;; NON-INTERACTIVE version + (lambda (&rest args) + (:documentation + (concat + (documentation func) + (format "\n\nDebounce calls to this function by %f seconds" delay))) + (prog1 default + (if (timerp debounce-timer) + (timer-set-idle-time debounce-timer delay) + (setq debounce-timer + (run-with-idle-timer + delay nil + (lambda (buf) + (cancel-timer debounce-timer) + (setq debounce-timer nil) + (setq default + (if (buffer-live-p buf) + (with-current-buffer buf + (apply func args)) + (apply func args)))) + (current-buffer))))))))) + +(provide 'timeout) +;;; timeout.el ends here From b953dc679c53d8ae26770762bcb2601389146768 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Mon, 1 Sep 2025 11:43:25 -0400 Subject: [PATCH 154/158] Revert "Avoid duplicating strings in pcm--merge-completions" Revert "Avoid duplicating strings in pcm--merge-completions", commit b511c38bba5354ff21c697e4d27279bf73e4d3cf. It broke existing behavior, now covered by tests adding in this commit. * lisp/minibuffer.el (completion-pcm--merge-completions): * test/lisp/minibuffer-tests.el (completion-pcm-test-anydelim): (completion-pcm-bug4219): --- lisp/minibuffer.el | 39 +++++++++++++++++++++-------------- test/lisp/minibuffer-tests.el | 15 ++++++++++++++ 2 files changed, 39 insertions(+), 15 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 914958a08a4..e26da9ee28b 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4625,35 +4625,38 @@ the same set of elements." (cond ((null (cdr strs)) (list (car strs))) (t - (let ((re (concat - (completion-pcm--pattern->regex pattern 'group) - ;; The implicit trailing `any' is greedy. - "\\([^z-a]*\\)")) + (let ((re (completion-pcm--pattern->regex pattern 'group)) (ccs ())) ;Chopped completions. - ;; First match each string against PATTERN as a regex and extract - ;; the text matched by each wildcard. + ;; First chop each string into the parts corresponding to each + ;; non-constant element of `pattern', using regexp-matching. (let ((case-fold-search completion-ignore-case)) (dolist (str strs) (unless (string-match re str) (error "Internal error: %s doesn't match %s" str re)) (let ((chopped ()) + (last 0) (i 1) next) - (while (setq next (match-string i str)) - (push next chopped) + (while (setq next (match-end i)) + (push (substring str last next) chopped) + (setq last next) (setq i (1+ i))) + ;; Add the text corresponding to the implicit trailing `any'. + (push (substring str last) chopped) (push (nreverse chopped) ccs)))) - ;; Then for each of those wildcards, extract the commonality between them. + ;; Then for each of those non-constant elements, extract the + ;; commonality between them. (let ((res ()) + (fixed "") ;; Accumulate each stretch of wildcards, and process them as a unit. (wildcards ())) ;; Make the implicit trailing `any' explicit. (dolist (elem (append pattern '(any))) (if (stringp elem) (progn - (push elem res) + (setq fixed (concat fixed elem)) (setq wildcards nil)) (let ((comps ())) (push elem wildcards) @@ -4664,13 +4667,18 @@ the same set of elements." ;; different capitalizations in different parts. ;; In practice, it doesn't seem to make any difference. (setq ccs (nreverse ccs)) - (let* ((prefix (try-completion "" comps)) - (unique (or (and (eq prefix t) (setq prefix "")) + ;; FIXED is a prefix of all of COMPS. Try to grow that prefix. + (let* ((prefix (try-completion fixed comps)) + (unique (or (and (eq prefix t) (setq prefix fixed)) (and (stringp prefix) ;; If PREFIX is equal to all of COMPS, ;; then PREFIX is a unique completion. (seq-every-p - (lambda (comp) (= (length prefix) (length comp))) + ;; PREFIX is still a prefix of all of + ;; COMPS, so if COMP is the same length, + ;; they're equal. + (lambda (comp) + (= (length prefix) (length comp))) comps))))) ;; If there's only one completion, `elem' is not useful ;; any more: it can only match the empty string. @@ -4685,7 +4693,7 @@ the same set of elements." ;; `prefix' only wants to include the fixed part before the ;; wildcard, not the result of growing that fixed part. (when (seq-some (lambda (elem) (eq elem 'prefix)) wildcards) - (setq prefix "")) + (setq prefix fixed)) (push prefix res) ;; Push all the wildcards in this stretch, to preserve `point' and ;; `star' wildcards before ELEM. @@ -4709,7 +4717,8 @@ the same set of elements." (unless (equal suffix "") (push suffix res)))) ;; We pushed these wildcards on RES, so we're done with them. - (setq wildcards nil)))))) + (setq wildcards nil)) + (setq fixed ""))))) ;; We return it in reverse order. res))))) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 99753f31330..de1a98c8189 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -332,6 +332,21 @@ "" '("fooxbar" "fooybar") nil 0) '("foobar" . 3)))) +(ert-deftest completion-pcm-test-anydelim () + ;; After each delimiter is a special wildcard which matches any + ;; sequence of delimiters. + (should (equal (completion-pcm-try-completion + "-x" '("-_.x" "-__x") nil 2) + '("-_x" . 3)))) + +(ert-deftest completion-pcm-bug4219 () + ;; With `completion-ignore-case', try-completion should change the + ;; case of existing text when the completions have different casing. + (should (equal + (let ((completion-ignore-case t)) + (completion-pcm-try-completion "a" '("ABC" "ABD") nil 1)) + '("AB" . 2)))) + (ert-deftest completion-substring-test-1 () ;; One third of a match! (should (equal From cc1a1a984a4989d2561bdd4ecb1a7e0d3ceb5f5d Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 2 Sep 2025 09:23:42 +0100 Subject: [PATCH 155/158] ; * etc/NEWS: Copyedit. --- etc/NEWS | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 630d03a1fa0..66a5b0a9eed 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2727,13 +2727,12 @@ files. If tree-sitter is properly set-up by the user, it can be enabled for files named "go.work". ** New package 'lua-mode'. -The 'lua-mode' package from Non-GNU ELPA is now included in Emacs. +The 'lua-mode' package from NonGNU ELPA is now included in Emacs. ** New library 'timeout'. -This library that provides higher order functions to throttle or -debounce Elisp functions. This is useful for corraling over-eager code -that is slow and blocks Emacs or does not provide customization options -to limit how often it runs. +This library provides functions to throttle or debounce Emacs Lisp +functions. This is useful for corralling overeager code that is slow +and blocks Emacs, or does not provide ways to limit how often it runs. * Incompatible Lisp Changes in Emacs 31.1 From 6ad8745833c2cc722cc73fd86ac63cd4741d2b2b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 2 Sep 2025 12:09:17 +0200 Subject: [PATCH 156/158] Extend tramp-test26-interactive-file-name-completion * lisp/net/tramp.el (tramp-get-completion-methods): Use `tramp-compat-seq-keep'. * test/lisp/net/tramp-tests.el (completions-max-height): Declare. (tramp-test26-interactive-file-name-completion): Extend test. --- lisp/net/tramp.el | 2 +- test/lisp/net/tramp-tests.el | 142 ++++++++++++++++++++++------------- 2 files changed, 89 insertions(+), 55 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c7450bc015d..9bf1b4ae6c3 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3261,7 +3261,7 @@ remote host and localname (filename on remote host)." (defun tramp-get-completion-methods (partial-method &optional multi-hop) "Return all method completions for PARTIAL-METHOD. If MULTI-HOP is non-nil, return only multi-hop capable methods." - (mapcar + (tramp-compat-seq-keep (lambda (method) (and method (string-prefix-p (or partial-method "") method) (or (not multi-hop) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 892e4ef519c..8c230f43cf3 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -91,6 +91,9 @@ (defvar tramp-remote-process-environment) (defvar tramp-use-connection-share) +;; Declared in Emacs 29.1. +(defvar completions-max-height) + ;; Declared in Emacs 30.1. (defvar project-mode-line) (defvar remote-file-name-access-timeout) @@ -5002,30 +5005,33 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp--test-deftest-with-ls tramp-test26-file-name-completion) -;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, Bug#54042 -;; and Bug#60505. +;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, +;; Bug#54042, Bug#60505 and Bug#79236. (ert-deftest tramp-test26-interactive-file-name-completion () "Check interactive completion with different `completion-styles'." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - ;; (when (get-buffer trace-buffer) (kill-buffer trace-buffer)) - ;; (dolist (elt (append - ;; (mapcar - ;; #'intern (all-completions "tramp-" obarray #'functionp)) - ;; tramp-trace-functions)) - ;; (unless (get elt 'tramp-suppress-trace) - ;; (trace-function-background elt))) - ;; (trace-function-background #'completion-file-name-table) - ;; (trace-function-background #'read-file-name) - ;; Method, user and host name in completion mode. - (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) - (user (file-remote-p ert-remote-temporary-file-directory 'user)) - (host (file-remote-p ert-remote-temporary-file-directory 'host)) - (hop (file-remote-p ert-remote-temporary-file-directory 'hop)) - (orig-syntax tramp-syntax) - (non-essential t) - (inhibit-message (not (ignore-errors (edebug-mode))))) + (let* (;; Set this to `t' if you want to run all tests. + (expensive nil) ;(tramp--test-expensive-test-p)) + ;; Set this to `t' if you want to see the traces. + (tramp-trace nil) + (method (file-remote-p ert-remote-temporary-file-directory 'method)) + (user (file-remote-p ert-remote-temporary-file-directory 'user)) + (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (hop (and expensive + (file-remote-p ert-remote-temporary-file-directory 'hop))) + ;; All multi-hop capable methods. + (method-list + (and hop (sort (mapcar + (lambda (x) + (substring x (length tramp-prefix-format))) + (tramp-get-completion-methods "" t))))) + (orig-syntax tramp-syntax) + (non-essential t) + (inhibit-message + (and (not tramp-trace) (not (ignore-errors (edebug-mode)))))) ;; `file-remote-p' returns as host the string "host#port", which ;; isn't useful. (when (and (stringp host) @@ -5034,6 +5040,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." host)) (setq host (replace-match "" nil nil host))) + (when tramp-trace + (when (get-buffer trace-buffer) (kill-buffer trace-buffer)) + (dolist + (elt (mapcar #'intern (all-completions "tramp-" obarray #'functionp))) + (unless (get elt 'tramp-suppress-trace) + (trace-function-background elt))) + (trace-function-background #'completion-file-name-table) + (trace-function-background #'read-file-name)) + (unwind-protect (dolist (syntax (if (tramp--test-expensive-test-p) (tramp-syntax-values) `(,orig-syntax))) @@ -5045,21 +5060,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (dolist (style - (if (tramp--test-expensive-test-p) - ;; FIXME: It doesn't work for `initials' and - ;; `shorthand' completion styles. Should it? - ;; `orderless' passes the tests, but it is an ELPA package. - ;; What about `company' backends, `consult', `cider', `helm'? + (if expensive + ;; `initials' uses "/" as separator, it doesn't apply here. + ;; `shorthand' is about symbols, it doesn't apply here. `(emacs21 emacs22 basic partial-completion substring ;; FIXME: `flex' is not compatible with IPv6 hosts. - ,@(unless (string-match-p tramp-ipv6-regexp host) '(flex))) + ,@(unless (string-match-p tramp-ipv6-regexp host) '(flex)) + ;; `orderless' is an ELPA package. + ;; What about `company' backends, `consult', + ;; `cider', `helm'? + orderless) '(basic))) (when (assoc style completion-styles-alist) (let* (;; Force the real minibuffer in batch mode. (executing-kbd-macro noninteractive) - ;; FIXME: Is this TRT for test? - (minibuffer-completing-file-name t) (confirm-nonexistent-file-or-buffer nil) (completion-styles `(,style)) completion-category-defaults @@ -5072,6 +5087,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." `(any ,(string-replace ":" "" completion-pcm-word-delimiters)))) + ;; Don't truncate in *Completions* buffer. + (completions-max-height most-positive-fixnum) ;; This is needed for the `simplified' syntax. (tramp-default-method method) (method-string @@ -5097,7 +5114,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Needed for host name completion. (default-user (file-remote-p - (concat tramp-prefix-format hop method-string host-string) + (concat + tramp-prefix-format hop method-string host-string) 'user)) (default-user-string (unless (tramp-string-empty-or-nil-p default-user) @@ -5107,8 +5125,18 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (dolist (test-and-result ;; These are triples of strings (TEST-STRING - ;; RESULT-CHECK COMPLETION-CHECK). + ;; RESULT-CHECK COMPLETION-CHECK). If + ;; COMPLETION-CHECK is a list, it is the complete + ;; result the contents of *Completions* shall be + ;; checked with. (append + ;; Complete hop. + (unless (tramp-string-empty-or-nil-p hop) + `((,(concat tramp-prefix-format hop) + ,(concat tramp-prefix-format hop) + ,(if (string-empty-p tramp-method-regexp) + (or default-user-string host-string) + method-list)))) ;; Complete method name. (unless (string-empty-p tramp-method-regexp) `((,(concat @@ -5127,7 +5155,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." tramp-prefix-format hop method-string user-string) ,user-string))) ;; Complete host name. - (unless (tramp-string-empty-or-nil-p host) + (unless (tramp-string-empty-or-nil-p host-string) `((,(concat tramp-prefix-format hop method-string ipv6-prefix @@ -5138,8 +5166,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." default-user-string host-string) ,host-string))) ;; Complete user and host name. - (unless (or (tramp-string-empty-or-nil-p user) - (tramp-string-empty-or-nil-p host)) + (unless (or (tramp-string-empty-or-nil-p user-string) + (tramp-string-empty-or-nil-p host-string)) `((,(concat tramp-prefix-format hop method-string user-string ipv6-prefix @@ -5152,8 +5180,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (dolist (predicate - (if (and (tramp--test-expensive-test-p) - (tramp--test-emacs31-p)) + (if (and expensive (tramp--test-emacs31-p)) ;; `nil' will be expanded to `file-exists-p'. ;; `read-directory-name' uses `file-directory-p'. ;; `file-directory-p' works since Emacs 31. @@ -5161,8 +5188,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." '(file-exists-p file-directory-p) '(nil))) (ignore-errors (kill-buffer "*Completions*")) - ;; (when (get-buffer trace-buffer) - ;; (kill-buffer trace-buffer)) + (when tramp-trace + (when (get-buffer trace-buffer) + (kill-buffer trace-buffer))) (discard-input) (setq test (car test-and-result) unread-command-events @@ -5186,11 +5214,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." eos)) result)) (progn - ;; (tramp--test-message - ;; (concat - ;; "syntax: %s style: %s predicate: %s " - ;; "test: %s result: %s") - ;; syntax style predicate test result) + (when tramp-trace + (tramp--test-message + (concat + "syntax: %s style: %s predicate: %s " + "test: %s result: %s") + syntax style predicate test result)) (should (string-prefix-p (cadr test-and-result) result))) @@ -5212,16 +5241,22 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (point) (point-max)) (rx (any "\r\n\t ")) 'omit))) - ;; (tramp--test-message - ;; (concat - ;; "syntax: %s style: %s predicate: %s test: %s " - ;; "result: %s completions: %S") - ;; syntax style predicate test result completions) - (should - (member (caddr test-and-result) completions))))))))) + (when tramp-trace + (tramp--test-message + (concat + "syntax: %s style: %s predicate: %s test: %s " + "result: %s completions: %S") + syntax style predicate test result completions)) + (if (stringp (caddr test-and-result)) + (should + (member (caddr test-and-result) completions)) + (should + (equal + (caddr test-and-result) (sort completions))))))))))) ;; Cleanup. - ;; (untrace-all) + (when tramp-trace + (untrace-all)) (tramp-change-syntax orig-syntax) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))) @@ -8879,15 +8914,12 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * tramp-set-file-uid-gid ;; * Work on skipped tests. Make a comment, when it is impossible. -;; * Use `skip-when' starting with Emacs 30.1. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for "ftp". ;; * In `tramp-test26-file-name-completion', check also user, domain, ;; port and hop. -;; * In `tramp-test26-interactive-file-name-completion', check `flex', -;; `initials' and `shorthand' completion styles. Should -;; `minibuffer-completing-file-name' and `completion-pcm--delim-wild-regex' -;; be bound? Check also domain, port and hop. +;; * In `tramp-test26-interactive-file-name-completion', should +;; `completion-pcm--delim-wild-regex' be bound? Check also domain and port. ;; * Check, why a process filter t doesn't work in ;; `tramp-test29-start-file-process' and ;; `tramp-test30-make-process'. @@ -8899,6 +8931,8 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Check, why direct async processes do not work for ;; `tramp-test45-asynchronous-requests'. +;; Use `skip-when' starting with Emacs 30.1. + ;; Starting with Emacs 29, use `ert-with-temp-file' and ;; `ert-with-temp-directory'. From 45c5b636ced1924e627217ff5e19097e27d9caa4 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Fri, 29 Aug 2025 18:19:49 -0400 Subject: [PATCH 157/158] Add 'elisp-flymake-byte-compile-executable' defcustom The correct Emacs executable to use for 'elisp-flymake-byte-compile' is not necessarily the running Emacs. For example, when editing trunk with Emacs 30, various Lisp changes will cause spurious flymake warnings. Add 'elisp-flymake-byte-compile-executable' to allow customizing this. * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile-executable) (elisp-flymake-byte-compile--executable): Add. (Bug#79342) (elisp-flymake-byte-compile): Invoke 'elisp-flymake-byte-compile--executable'. * etc/NEWS: Announce the change. --- etc/NEWS | 7 +++++++ lisp/progmodes/elisp-mode.el | 33 ++++++++++++++++++++++++++++++++- 2 files changed, 39 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 66a5b0a9eed..0f39b78f892 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2586,6 +2586,13 @@ The tabulated listings produced by 'flymake-show-buffer-diagnostics' and 'flymake-show-project-diagnostics' now automatically adjust their column widths based on content, optimizing display space and readability. +*** New user option 'elisp-flymake-byte-compile-executable'. +This allows customizing the Emacs executable used for Flymake byte +compilation in emacs-lisp-mode. This option should be set when editing +Lisp code which will run with a different Emacs version than the running +Emacs, such as code from an older or newer version of Emacs. This will +provide more accurate warnings from byte compilation. + ** SQLite +++ diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index aa2daf6820a..a22b2145f52 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -2281,6 +2281,37 @@ directory of the buffer being compiled, and nothing else.") (defvar bytecomp--inhibit-lexical-cookie-warning) +(defcustom elisp-flymake-byte-compile-executable nil + "The Emacs executable to use for Flymake byte compilation. + +If non-nil, this should be an absolute or relative file name of an Emacs +executable. If it's a relative file name, it should be relative to the +root directory of the project containing the file being compiled, as +determined by `project-current'. + +If nil, or the file named by this does not exist, the running Emacs is +used via variable `invocation-directory'." + :type 'file + :group 'lisp + :version "31.1") + +(declare-function project-root "project" (project)) +(defun elisp-flymake-byte-compile--executable () + "Return absolute file name of the Emacs executable for flymake byte-compilation." + (let ((filename + (cond + ((file-name-absolute-p elisp-flymake-byte-compile-executable) + elisp-flymake-byte-compile-executable) + ((stringp elisp-flymake-byte-compile-executable) + (when-let* ((pr (project-current))) + (file-name-concat (project-root pr) + elisp-flymake-byte-compile-executable)))))) + (if (file-executable-p filename) + filename + (when elisp-flymake-byte-compile-executable + (message "No such elisp-flymake-byte-compile-executable %s" filename)) + (expand-file-name invocation-name invocation-directory)))) + ;;;###autoload (defun elisp-flymake-byte-compile (report-fn &rest _args) "A Flymake backend for elisp byte compilation. @@ -2316,7 +2347,7 @@ current buffer state and calls REPORT-FN when done." (make-process :name "elisp-flymake-byte-compile" :buffer output-buffer - :command `(,(expand-file-name invocation-name invocation-directory) + :command `(,(elisp-flymake-byte-compile--executable) "-Q" "--batch" ;; "--eval" "(setq load-prefer-newer t)" ; for testing From a6dd36e9b1cf7cabb7848c4fa557015762ce0d6c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 2 Sep 2025 14:05:14 +0300 Subject: [PATCH 158/158] ; Fix last change * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile-executable): Doc fix. --- lisp/progmodes/elisp-mode.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index a22b2145f52..89b73eff552 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -2285,12 +2285,13 @@ directory of the buffer being compiled, and nothing else.") "The Emacs executable to use for Flymake byte compilation. If non-nil, this should be an absolute or relative file name of an Emacs -executable. If it's a relative file name, it should be relative to the -root directory of the project containing the file being compiled, as -determined by `project-current'. +executable to use for byte compilation by Flymake. If it's a relative +file name, it should be relative to the root directory of the project +containing the file being compiled, as determined by `project-current'. -If nil, or the file named by this does not exist, the running Emacs is -used via variable `invocation-directory'." +If nil, or if the file named by this does not exist, Flymake will +use the same executable as the running Emacs, as specified by the +variables `invocation-name' and `invocation-directory'." :type 'file :group 'lisp :version "31.1")