diff --git a/admin/tree-sitter/compat-template.html b/admin/tree-sitter/compat-template.html index 23b5b55d7b3..3f8163567af 100644 --- a/admin/tree-sitter/compat-template.html +++ b/admin/tree-sitter/compat-template.html @@ -16,24 +16,26 @@ font-weight: bold; } table { + display: inline-block; margin: auto; } + table caption { + font-weight: bold; + } table td { padding: 0.5rem 1rem; width: 10rem; word-break: break-all; } - .head { + .latest { background: lightgreen; }

Emacs tree-sitter grammar compatibility

-

This is an auto-generated report of the last compatible version for each grammar in each Emacs version. A green background on the version indicates that the Emacs version is compatible with the latest commit in the upstream grammar repo.

+

This is an auto-generated report of the last compatible version for each grammar in each Emacs version. A green background on the version indicates that the Emacs version is compatible with the latest commit/tag in the upstream grammar repo.

This report is generated on ___REPLACE_TIME___.

- ___REPLACE_TABLE___ -
diff --git a/admin/tree-sitter/treesit-admin.el b/admin/tree-sitter/treesit-admin.el index 1bb8b927e5c..2be6fe42f27 100644 --- a/admin/tree-sitter/treesit-admin.el +++ b/admin/tree-sitter/treesit-admin.el @@ -134,11 +134,21 @@ This is done by `require'ing all of the features that extend it." "Return a copy of treesit-language-source-alist, with any revisions removed." (mapcar (lambda (source) - (if (nthcdr 2 source) - (let ((unversioned-source (copy-sequence source))) - (setcar (nthcdr 2 unversioned-source) nil) - unversioned-source) - source)) + (cond ((or (memq :revision source) + (memq :commit source)) + (when (memq :revision source) + (let ((unversioned-source (copy-sequence source))) + (setcar (cdr (memq :revision unversioned-source)) nil) + unversioned-source)) + (when (memq :commit source) + (let ((unversioned-source (copy-sequence source))) + (setcar (cdr (memq :commit unversioned-source)) nil) + unversioned-source))) + ((nthcdr 2 source) + (let ((unversioned-source (copy-sequence source))) + (setcar (nthcdr 2 unversioned-source) nil) + unversioned-source)) + (t source))) (treesit-admin--populated-treesit-language-source-alist))) (defun treesit-admin--verify-major-mode-queries (modes source-alist grammar-dir) @@ -315,21 +325,25 @@ Return non-nil if all queries are valid, nil otherwise." settings))))) (defun treesit-admin--find-latest-compatible-revision - (mode language source-alist grammar-dir &optional emacs-executable) + (mode language source-alist grammar-dir revision-type + &optional emacs-executable) "Find the latest revision for LANGUAGE that's compatible with MODE. MODE, LANGUAGE, SOURCE-ALIST, GRAMMAR-DIR are the same as in `treesit-admin--verify-major-mode-queries'. +REVISION-TYPE is `commit' or `tag', to inspect all or only tagged commits +respectively. + By default, use the Emacs executable that spawned the current Emacs session to validate grammars, but if EMACS-EXECUTABLE is non-nil, use it instead. Return a plist of the form - (:version VERSION :head-version HEAD-VERSION :timestamp TIMESTAMP). + (:version VERSION :latest-version LATEST-VERSION :timestamp TIMESTAMP). -HEAD-VERSION is the version of the HEAD, VERSION is the latest +LATEST-VERSION is the most-recent version, VERSION is the most-recent compatible version. TIMESTAMP is the commit date of VERSION in UNIX epoch format." (let ((treesit-extra-load-path (list grammar-dir)) @@ -340,53 +354,97 @@ epoch format." (emacs-executable (or emacs-executable (expand-file-name invocation-name invocation-directory))) - head-version version exit-code timestamp) + latest-version version exit-code timestamp) (when (not recipe) (signal 'treesit-error `("Cannot find recipe" ,language))) - (pcase-let ((`(,url ,revision ,source-dir ,cc ,c++ ,commit) - recipe)) + (let ((url (pop recipe)) + revision source-dir cc c++ commit copy-queries) + + ;; Process the keywords. + (while (keywordp (car recipe)) + (pcase (pop recipe) + (:revision (setq revision (pop recipe))) + (:source-dir (setq source-dir (pop recipe))) + (:cc (setq cc (pop recipe))) + (:c++ (setq c++ (pop recipe))) + (:commit (setq commit (pop recipe))) + (:copy-queries (setq copy-queries (pop recipe))))) + + ;; Old positional convention for backward-compatibility. + (unless revision (setq revision (nth 0 recipe))) + (unless source-dir (setq source-dir (nth 1 recipe))) + (unless cc (setq cc (nth 2 recipe))) + (unless c++ (setq c++ (nth 3 recipe))) + (unless commit (setq commit (nth 4 recipe))) + (with-temp-buffer (treesit--git-clone-repo url revision workdir) (when commit (treesit--git-checkout-branch workdir commit)) - (setq head-version (treesit--language-git-revision workdir)) - (treesit--build-grammar - workdir grammar-dir language source-dir cc c++) - (while (not (eq exit-code 0)) - (unless (null exit-code) - (treesit--git-checkout-branch workdir "HEAD~") + (cond + ((eq revision-type 'tag) + (cl-dolist (tag (treesit--language-git-version-tags workdir)) + (unless latest-version + (setq latest-version tag)) + (treesit--git-checkout-branch workdir tag) (treesit--build-grammar - workdir grammar-dir language source-dir cc c++)) - (setq version (treesit--language-git-revision workdir)) - (setq timestamp (treesit--language-git-timestamp workdir)) - (message "Validateing version %s" version) - (setq exit-code - (call-process - emacs-executable nil t nil - "-Q" "--batch" - "--eval" (prin1-to-string - `(let ((treesit-extra-load-path - '(,grammar-dir))) - (load ,treesit-admin-file-name) - (if (treesit-admin--validate-mode-lang - ',mode ',language) - (kill-emacs 0) - (kill-emacs -1))))))))) - (list :version version :head-version head-version :timestamp timestamp))) + workdir grammar-dir language source-dir cc c++) + (setq timestamp (treesit--language-git-timestamp workdir)) + (setq exit-code + (treesit-admin--validate-grammar + emacs-executable mode grammar-dir language tag)) + (when (eq exit-code 0) + (setq version tag) + (cl-return)))) + ((eq revision-type 'commit) + (setq latest-version (treesit--language-git-revision workdir)) + (treesit--build-grammar + workdir grammar-dir language source-dir cc c++) + (while (not (eq exit-code 0)) + (unless (null exit-code) + (treesit--git-checkout-branch workdir "HEAD~") + (treesit--build-grammar + workdir grammar-dir language source-dir cc c++)) + (setq version (treesit--language-git-revision workdir)) + (setq timestamp (treesit--language-git-timestamp workdir)) + (setq exit-code + (treesit-admin--validate-grammar + emacs-executable mode grammar-dir language version))))))) + (list :version version + :latest-version latest-version + :timestamp timestamp))) + +(defun treesit-admin--validate-grammar + (emacs-executable mode grammar-dir language version) +"Validate VERSION of LANGUAGE in GRAMMAR-DIR for MODE with EMACS-EXECUTABLE." + (message "Validating version %s" version) + (call-process + emacs-executable nil t nil + "-Q" "--batch" + "--eval" (prin1-to-string + `(let ((treesit-extra-load-path + '(,grammar-dir))) + (load ,treesit-admin-file-name) + (if (treesit-admin--validate-mode-lang + ',mode ',language) + (kill-emacs 0) + (kill-emacs -1)))))) (defun treesit-admin--last-compatible-grammar-for-modes - (modes source-alist grammar-dir &optional emacs-executable) + (modes source-alist grammar-dir revision-type &optional emacs-executable) "Generate an alist listing latest compatible grammar versions. MODES, SOURCE-ALIST, GRAMMAR-DIR are the same as `treesit-admin--verify-major-mode-queries'. If EMACS-EXECUTABLE is non-nil, use it for validating queries. +REVISION-TYPE is as for `treesit-admin--find-latest-compatible-revision'. + Return an alist of an alist of a plist: - ((MODE . ((LANG . (:version VERSION :head-VERSION HEAD-VERSION)) ...)) ...) + ((MODE . ((LANG . (:version VERSION :latest-version LATEST-VERSION)) ...)) ...) -VERSION and HEAD-VERSION in the plist are the same as in +VERSION and LATEST-VERSION in the plist are the same as in `treesit-admin--find-latest-compatible-revision'." (mapcar (lambda (mode) @@ -395,7 +453,7 @@ VERSION and HEAD-VERSION in the plist are the same as in (lambda (language) (cons language (treesit-admin--find-latest-compatible-revision - mode language source-alist grammar-dir + mode language source-alist grammar-dir revision-type emacs-executable))) (treesit-admin--mode-languages mode)))) modes)) @@ -410,74 +468,83 @@ us from eager compiling a compiled query that's already lazily compiled). EMACS-EXECUTABLES is a list of Emacs executables to check for." - (let ((tables - (mapcar - (lambda (emacs) - (cons (with-temp-buffer - (call-process emacs nil t nil - "-Q" "--batch" - "--eval" "(princ emacs-version)") - (buffer-string)) - (treesit-admin--last-compatible-grammar-for-modes - modes - (treesit-admin--unversioned-treesit-language-source-alist) - "/tmp/treesit-grammar" - emacs))) - emacs-executables)) - (database (make-hash-table :test #'equal)) - languages) - (dolist (table tables) - (dolist (mode-entry (cdr table)) - (dolist (language-entry (cdr mode-entry)) - (let* ((lang (car language-entry)) - (plist (cdr language-entry)) - ;; KEY = (LANG . EMACS-VERSION) - (key (cons lang (car table))) - (existing-plist (gethash key database))) - (push lang languages) - ;; If there are two major modes that uses LANG, and they - ;; have different compatible versions, use the older - ;; version. - (when (or (not existing-plist) - (< (plist-get plist :timestamp) - (plist-get existing-plist :timestamp))) - (puthash key plist database)))))) - (setq languages (cl-sort (cl-remove-duplicates languages) - (lambda (a b) - (string< (symbol-name a) (symbol-name b))))) - ;; Compose HTML table. - (with-temp-buffer - (insert "Language") - (dolist (emacs-version (mapcar #'car tables)) - (insert (format "%s" emacs-version))) - (insert "\n") - (dolist (lang languages) - (insert "") - (insert (format "%s" lang)) + (with-temp-buffer + (dolist (revision-type (list 'tag 'commit)) + (let ((tables + (mapcar + (lambda (emacs) + (cons (with-temp-buffer + (call-process emacs nil t nil + "-Q" "--batch" + "--eval" "(princ emacs-version)") + (buffer-string)) + (treesit-admin--last-compatible-grammar-for-modes + modes + (treesit-admin--unversioned-treesit-language-source-alist) + "/tmp/treesit-grammar" + revision-type + emacs))) + emacs-executables)) + (database (make-hash-table :test #'equal)) + languages) + (dolist (table tables) + (dolist (mode-entry (cdr table)) + (dolist (language-entry (cdr mode-entry)) + (let* ((lang (car language-entry)) + (plist (cdr language-entry)) + ;; KEY = (LANG . EMACS-VERSION) + (key (cons lang (car table))) + (existing-plist (gethash key database))) + (push lang languages) + ;; If there are two major modes that uses LANG, and they + ;; have different compatible versions, use the older + ;; version. + (when (or (not existing-plist) + (< (plist-get plist :timestamp) + (plist-get existing-plist :timestamp))) + (puthash key plist database)))))) + (setq languages (cl-sort (cl-remove-duplicates languages) + (lambda (a b) + (string< (symbol-name a) (symbol-name b))))) + ;; Compose HTML table. + (insert "" + "\n") + (insert "") (dolist (emacs-version (mapcar #'car tables)) - (let* ((key (cons lang emacs-version)) - (plist (gethash key database)) - (version (plist-get plist :version)) - (head-version (plist-get plist :head-version)) - (classname - (if (equal version head-version) "head" ""))) - (if (not plist) - (insert "") - (insert (format "" - classname version))))) - (insert "\n")) + (insert (format "" emacs-version))) + (insert "\n") + (dolist (lang languages) + (insert (format "" + (nth 1 (assoc lang treesit-language-source-alist)) + lang)) + (dolist (emacs-version (mapcar #'car tables)) + (let* ((key (cons lang emacs-version)) + (plist (gethash key database)) + (version (plist-get plist :version)) + (latest-version (plist-get plist :latest-version)) + (classname + (if (equal version latest-version) "latest" ""))) + (if (not plist) + (insert "") + (insert (format "" + classname version))))) + (insert "\n")) + (insert "
" + (cond ((eq revision-type 'tag) "Tagged") + ((eq revision-type 'commit) "All")) + " commits
Language%s
%s
%s%s
\n"))) - ;; Compose table with template and write to out file. - (let ((time (current-time-string nil t)) - (table-text (buffer-string))) - (erase-buffer) - (insert-file-contents treesit-admin--compat-template-file-name) - (goto-char (point-min)) - (search-forward "___REPLACE_TIME___") - (replace-match (format "%s UTC" time) t) - (search-forward "___REPLACE_TABLE___") - (replace-match table-text t) - (write-region (point-min) (point-max) out-file))))) + ;; Compose table with template and write to out file. + (let ((time (current-time-string nil t)) + (table-text (buffer-string))) + (erase-buffer) + (insert-file-contents treesit-admin--compat-template-file-name) + (goto-char (point-min)) + (search-forward "___REPLACE_TIME___") + (replace-match (format "%s UTC" time) t) + (search-forward "___REPLACE_TABLE___") + (replace-match table-text t) + (write-region (point-min) (point-max) out-file)))) (provide 'treesit-admin) diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog index 2e34fc0d84c..0c751f95703 100755 --- a/build-aux/gitlog-to-changelog +++ b/build-aux/gitlog-to-changelog @@ -35,7 +35,7 @@ eval 'exec perl -wSx "$0" "$@"' if 0; -my $VERSION = '2024-07-17 02:20'; # UTC +my $VERSION = '2025-06-10 02:43'; # UTC # The definition above must lie within the first 8 lines in order # for the Emacs time-stamp write hook (at end) to update it. # If you change this file with Emacs, please let the write hook @@ -544,7 +544,7 @@ sub git_dir_option($) # eval: (add-hook 'before-save-hook 'time-stamp nil t) # time-stamp-line-limit: 50 # time-stamp-start: "my $VERSION = '" -# time-stamp-format: "%:y-%02m-%02d %02H:%02M" +# time-stamp-format: "%Y-%02m-%02d %02H:%02M" # time-stamp-time-zone: "UTC0" # time-stamp-end: "'; # UTC" # End: diff --git a/build-aux/install-sh b/build-aux/install-sh index 8a76989bbc4..1d8d9669646 100755 --- a/build-aux/install-sh +++ b/build-aux/install-sh @@ -1,7 +1,7 @@ #!/bin/sh # install - install a program, script, or datafile -scriptversion=2024-12-03.03; # UTC +scriptversion=2025-06-18.21; # UTC # This originates from X11R5 (mit/util/scripts/install.sh), which was # later released in X11R6 (xc/config/util/install.sh) with the @@ -535,7 +535,7 @@ done # Local variables: # eval: (add-hook 'before-save-hook 'time-stamp nil t) # time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-format: "%Y-%02m-%02d.%02H" # time-stamp-time-zone: "UTC0" # time-stamp-end: "; # UTC" # End: diff --git a/build-aux/move-if-change b/build-aux/move-if-change index 0674f34fcef..90b8152ad84 100755 --- a/build-aux/move-if-change +++ b/build-aux/move-if-change @@ -2,7 +2,7 @@ # Like mv $1 $2, but if the files are the same, just delete $1. # Status is zero if successful, nonzero otherwise. -VERSION='2024-07-04 10:56'; # UTC +VERSION='2025-06-10 02:42'; # UTC # The definition above must lie within the first 8 lines in order # for the Emacs time-stamp write hook (at end) to update it. # If you change this file with Emacs, please let the write hook @@ -78,7 +78,7 @@ fi ## Local Variables: ## eval: (add-hook 'before-save-hook 'time-stamp nil t) ## time-stamp-start: "VERSION='" -## time-stamp-format: "%:y-%02m-%02d %02H:%02M" +## time-stamp-format: "%Y-%02m-%02d %02H:%02M" ## time-stamp-time-zone: "UTC0" ## time-stamp-end: "'; # UTC" ## End: diff --git a/build-aux/update-copyright b/build-aux/update-copyright index 124c7d2e423..592bd8b2695 100755 --- a/build-aux/update-copyright +++ b/build-aux/update-copyright @@ -138,7 +138,7 @@ eval 'exec perl -wSx -0777 -pi "$0" "$@"' if 0; -my $VERSION = '2025-01-01.07:36'; # UTC +my $VERSION = '2025-06-10.02:42'; # UTC # The definition above must lie within the first 8 lines in order # for the Emacs time-stamp write hook (at end) to update it. # If you change this file with Emacs, please let the write hook @@ -301,7 +301,7 @@ if (!$found) # eval: (add-hook 'before-save-hook 'time-stamp nil t) # time-stamp-line-limit: 200 # time-stamp-start: "my $VERSION = '" -# time-stamp-format: "%:y-%02m-%02d.%02H:%02M" +# time-stamp-format: "%Y-%02m-%02d.%02H:%02M" # time-stamp-time-zone: "UTC0" # time-stamp-end: "'; # UTC" # End: diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 044f3f352fd..895f19453e4 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -558,7 +558,7 @@ cannot find a system to register under, it prompts for a repository type, creates a new repository, and registers the VC fileset with it. You can also specify the system explicitly, see @ref{Advanced C-x v v}. Note that registering the files doesn't commit them; you must -invoke @w{@kbd{C-x v v}} again to commit, see below. +invoke @w{@kbd{C-x v v}} again to commit; see the next point. @item If every file in the VC fileset has been either newly-added or @@ -566,6 +566,29 @@ modified, commit the changed files. To do this, Emacs pops up a @file{*vc-log*} buffer; type the desired log entry for the changes, followed by @kbd{C-c C-c} to commit. @xref{Log Buffer}. +If @kbd{C-x v v} is invoked from a buffer under Diff mode, the command +treats the buffer as holding a set of patches for one or more files. It +then applies the changes to the respective files and commits the changes +after popping up the @file{*vc-log*} buffer to allow you to type a +suitable commit log message. + +Once you type @kbd{C-x v v}, the fileset or patches cannot be changed +without first cancelling the commit by typing @kbd{C-c C-k} in the +@file{*vc-log*} buffer. For example, if you change which files are +marked in the @file{*vc-dir*} buffer after Emacs has already popped up +the @file{*vc-log*} buffer, the old fileset will remain in effect for +this commit. (This is in contrast to changes made to the +@emph{contents} of files in the fileset when not committing patches: all +such changes will be included in the commit even if they are made after +Emacs has popped up the @file{*vc-log*} buffer.) + +When you cancel a commit, Emacs saves your log message. This means that +if you need to adjust the fileset or patches, it is easy to restart the +commit operation again: type @w{@kbd{C-c C-k C-x v v M-p}}. Here +@kbd{C-c C-k} cancels the commit, @kbd{C-x v v} initiates another with +the new fileset or patches, and finally @kbd{M-p} recalls your previous +log message. + With modern decentralized version control systems (Git, Mercurial, etc.), the changes are committed locally and not automatically propagated to the upstream repository (which is usually on a remote @@ -595,12 +618,6 @@ changes. In addition, locking is possible with RCS even in this mode: @kbd{C-x v v} with an unmodified file locks the file, just as it does with RCS in its normal locking mode (@pxref{VC With A Locking VCS}). - If @kbd{C-x v v} is invoked from a buffer under Diff Mode, the -command assumes the buffer holds a set of patches for one or more -files. It then applies the changes to the respective files and -commits the changes after popping up the @file{*vc-log*} buffer to -allow you to type a suitable commit log message. - @node VC With A Locking VCS @subsubsection Basic Version Control with Locking @@ -1044,12 +1061,36 @@ Display the change history for another branch (@code{vc-print-branch-log}). @item C-x v I -Display the changes that a ``pull'' operation will retrieve -(@code{vc-log-incoming}). +Display log entries for the changes that a ``pull'' operation will +retrieve (@code{vc-log-incoming}). + +@vindex vc-use-incoming-outgoing-prefixes +If you customize @code{vc-use-incoming-outgoing-prefixes} to +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. + +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 C-x v O -Display the changes that will be sent by the next ``push'' operation -(@code{vc-log-outgoing}). +Display log entries for the changes that will be sent by the next +``push'' operation (@code{vc-log-outgoing}). + +If you customize @code{vc-use-incoming-outgoing-prefixes} to +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 +operation. This command 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. + +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 C-x v h Display the history of changes made in the region of file visited by diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 80bfb1a103d..88b7bfc7049 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -997,6 +997,10 @@ from. For example, if you use bash, the file sent to it is @file{~/.emacs_bash}. If this file is not found, Emacs tries with @file{~/.emacs.d/init_@var{shellname}.sh}. + You can enable colorized output for many commands by customizing the +variable @code{comint-terminfo-terminal} to the value +@samp{"dumb-emacs-ansi"} (@pxref{Shell Options}). + To specify a coding system for the shell, you can use the command @kbd{C-x @key{RET} c} immediately before @kbd{M-x shell}. You can also change the coding system for a running subshell by typing @@ -1639,13 +1643,15 @@ underlying shell, of course. @vindex system-uses-terminfo @vindex TERM@r{, environment variable, in sub-shell} Comint mode sets the @env{TERM} environment variable to a safe default -value, but this value disables some useful features. For example, -color is disabled in applications that use @env{TERM} to determine if -color is supported. Therefore, Emacs provides an option -@code{comint-terminfo-terminal} to let you choose a terminal with more -advanced features, as defined in your system's terminfo database. -Emacs will use this option as the value for @env{TERM} so long as -@code{system-uses-terminfo} is non-@code{nil}. +value, but this disables some useful features. For example, colorized +output is disabled in applications that use @env{TERM} to determine +whether color is supported. If the terminfo database on your system +contains a definition for the @samp{"dumb-emacs-ansi"} terminal type (as +all recent versions of terminfo do), you can enable advanced terminal +features, including color, by customizing the option +@code{comint-terminfo-terminal} to @samp{"dumb-emacs-ansi"}. Emacs will +use @code{comint-terminfo-terminal} as the value for @env{TERM} so long +as @code{system-uses-terminfo} is non-@code{nil}. Both @code{comint-terminfo-terminal} and @code{system-uses-terminfo} can be declared as connection-local variables to adjust these options diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 182efff7afb..c29beea3b08 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -333,9 +333,9 @@ it depends on uninstallable packages. The package is installed. @item new -Equivalent to @samp{available}, except that the package became newly -available on the package archive after your last invocation of -@kbd{M-x list-packages}. +Equivalent to @samp{available}, except that the package was added to the +package archive since your previous invocation of @w{@kbd{M-x +list-packages}}. @item obsolete The package is an outdated installed version; in addition to this diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 5635171f5cf..d8a7e0fc25e 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -600,12 +600,15 @@ can also call @kbd{M-x fill-region} to specifically fill the text in the region. @findex fill-region-as-paragraph +@vindex fill-region-as-paragraph-function @kbd{M-q} and @code{fill-region} use the usual Emacs criteria for finding paragraph boundaries (@pxref{Paragraphs}). For more control, -you can use @kbd{M-x fill-region-as-paragraph}, which refills -everything between point and mark as a single paragraph. This command -deletes any blank lines within the region, so separate blocks of text -end up combined into one block. +you can use @kbd{M-x fill-region-as-paragraph}, which refills everything +between point and mark as a single paragraph. The behavior of this +command is controlled by the variable +@code{fill-region-as-paragraph-function}. By default, it deletes any +blank lines within the region, so separate blocks of text end up +combined into one block. @cindex justification A numeric argument to @kbd{M-q} tells it to @dfn{justify} the text @@ -699,8 +702,9 @@ a new paragraph. To specify a fill prefix for the current buffer, move to a line that starts with the desired prefix, put point at the end of the prefix, and type @w{@kbd{C-x .}}@: (@code{set-fill-prefix}). (That's a period -after the @kbd{C-x}.) To turn off the fill prefix, specify an empty -prefix: type @w{@kbd{C-x .}}@: with point at the beginning of a line. +after the @kbd{C-x}.) To turn off the fill prefix, either type +@w{@kbd{C-u C-x .}}@: or specify an empty prefix: type @w{@kbd{C-x .}}@: +with point at the beginning of a line. When a fill prefix is in effect, the fill commands remove the fill prefix from each line of the paragraph before filling, and insert it diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index 4a35fd54f66..d0ad1ee8547 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -588,6 +588,16 @@ can be controlled by customizing the options (@pxref{Temporary Displays,,Temporary Displays, elisp, The Emacs Lisp Reference Manual}), and cannot exceed the size of the containing frame. +@cindex warning buffer, display +@vindex warning-display-at-bottom + Buffers showing warnings (such as byte-compilation warnings, +@pxref{Compilation Functions,, Byte Compilation Functions, elisp, The +Emacs Lisp Reference Manual}) are also by default shown in a window at +the bottom of the selected frame. You can control this using the +variable @code{warning-display-at-bottom}: if set to @code{nil}, Emacs +will use the normal logic of @code{display-buffer} (@pxref{Window +Choice}) instead, and you can customize that via +@code{display-buffer-alist}. @node Window Convenience @section Convenience Features for Window Handling diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 48d6e85195b..25ef83935c1 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -933,6 +933,18 @@ won't appear at all. These variables are used by users to control what happens when a Lisp program reports a warning. +@defopt warning-display-at-bottom +This user option controls the window in which the warnings buffer is +shown. By default, the value is @code{t}, and Emacs displays the +warnings buffer in a window at the bottom of the selected frame, +creating a new window there if needed. If customized to @code{nil}, the +warnings buffer will be shown using the default rules of +@code{display-buffer} (@pxref{Choosing Window}); in that case the +@code{warning} category can be used in @code{display-buffer-alist} to +customize how @code{display-buffer} will display these buffers +(@pxref{Buffer Display Action Alists}). +@end defopt + @defopt warning-minimum-level This user option specifies the minimum severity level that should be shown immediately to the user, by popping the warnings buffer in some diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index b1fb7b6430d..ea6e07e05fb 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1146,15 +1146,16 @@ the @code{call-interactively} function. @xref{Interactive Call}. @cindex mapping functions A @dfn{mapping function} applies a given function (@emph{not} a -special form or macro) to each element of a list or other collection. +special form or macro) to each element of a sequence, such as a list or +a vector or a string (@pxref{Sequences Arrays Vectors}). Emacs Lisp has several such functions; this section describes @code{mapcar}, @code{mapc}, @code{mapconcat}, and @code{mapcan}, which -map over a list. @xref{Definition of mapatoms}, for the function +map over sequences. @xref{Definition of mapatoms}, for the function @code{mapatoms} which maps over the symbols in an obarray. @xref{Definition of maphash}, for the function @code{maphash} which maps over key/value associations in a hash table. - These mapping functions do not allow char-tables because a char-table + These mapping functions do not work on char-tables because a char-table is a sparse array whose nominal range of indices is very large. To map over a char-table in a way that deals properly with its sparse nature, use the function @code{map-char-table} (@pxref{Char-Tables}). diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 8eeddf20b12..1591cbd7be0 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -93,6 +93,11 @@ if requested by environment variables such as @env{LANG}. @item It does some basic parsing of the command-line arguments. +@item +It loads the library @file{site-start}, if it exists. This is not +done if the options @samp{-Q} or @samp{--no-site-file} were specified. +@cindex @file{site-start.el} + @item It loads your early init file (@pxref{Early Init File,,, emacs, The GNU Emacs Manual}). This is not done if the options @samp{-q}, @@ -150,11 +155,6 @@ rather than build-time, context. @c @item @c It registers the colors available for tty frames. -@item -It loads the library @file{site-start}, if it exists. This is not -done if the options @samp{-Q} or @samp{--no-site-file} were specified. -@cindex @file{site-start.el} - @item It loads your init file (@pxref{Init File}). This is not done if the options @samp{-q}, @samp{-Q}, or @samp{--batch} were specified. If @@ -432,9 +432,9 @@ loading of this file with the option @samp{--no-site-file}. @defopt site-run-file This variable specifies the site-customization file to load before the -user's init file. Its normal value is @code{"site-start"}. The only -way you can change it with real effect is to do so before dumping -Emacs. +user's early init file and regular init file. Its normal value is +@code{"site-start"}. The only way you can change it with real effect is +to do so before dumping Emacs. @c So why even mention it here. I imagine it is almost never changed. @end defopt diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index e55e0edee71..2f9d2bc423c 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -573,6 +573,17 @@ symbol, rather than a lambda function. This function returns the list of @var{parser}'s notifier functions. @end defun +A lisp program can also choose to force a parser to reparse and get the +changed regions immediately with @code{treesit-parser-changed-regions}. + +@defun treesit-parser-changed-regions parser +This function force @var{parser} to reparse, and return the affected +regions: a list of @w{@code{(@var{start} . @var{end})}}. If the parser +has nothing new to reparse, or the affected regions are empty, +@code{nil} is returned. +@end defun + + @heading Substitute parser for another language @cindex remap language grammar, tree-sitter @cindex replace language grammar, tree-sitter diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 75b2b1c3d60..b01df8512b7 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -1737,7 +1737,12 @@ described above. @deffn Command fill-region-as-paragraph start end &optional justify nosqueeze squeeze-after This command considers a region of text as a single paragraph and fills -it. If the region was made up of many paragraphs, the blank lines +it. The behavior of this command is controlled by the variable +@code{fill-region-as-paragraph-function}, with the default +implementation being @code{fill-region-as-paragraph-default}, which is +described in detail below. + +If the region was made up of many paragraphs, the blank lines between paragraphs are removed. This function justifies as well as filling when @var{justify} is non-@code{nil}. @@ -1841,6 +1846,15 @@ paragraphs actually moved. The default value of this variable is Manual}. @end defvar +@defvar fill-region-as-paragraph-function +This variable provides a way to override how functions like +@code{fill-paragraph} and @code{fill-region} fill text. Its value +should be a function, which should accept the arguments defined by +@code{fill-region-as-paragraph} and return the fill prefix used for +filling. The default value of this variable is +@code{fill-region-as-paragraph-default}. +@end defvar + @defvar use-hard-newlines If this variable is non-@code{nil}, the filling functions do not delete newlines that have the @code{hard} text property. These hard @@ -3986,10 +4000,13 @@ These properties are obsolete; please use This special property records a list of functions that react to cursor motion. Each function in the list is called, just before redisplay, with 3 arguments: the affected window, the previous known position of -the cursor, and one of the symbols @code{entered} or @code{left}, -depending on whether the cursor is entering the text that has this -property or leaving it. The functions are called only when the minor -mode @code{cursor-sensor-mode} is turned on. +the cursor, and a symbol indicating the direction of the movement. +The movement can be @code{entered} or @code{left}, depending on whether +the cursor is entering the text that has this property or leaving it, or +@code{moved} when the cursor moved within that text. +Other values for the direction should be ignored. +The functions are called only when the minor mode +@code{cursor-sensor-mode} is turned on. When the variable @code{cursor-sensor-inhibit} is non-@code{nil}, the @code{cursor-sensor-functions} property is ignored. diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index 3a7c3815fb1..3d9ebf08073 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -257,7 +257,7 @@ calling this. Ordinarily a single waiting thread is woken by @code{condition-notify}; but if @var{all} is not @code{nil}, then all threads waiting on @var{cond} are notified. -@code{condition-notify} releases the associated mutex while waiting. +@code{condition-notify} releases the associated mutex. This allows other threads to acquire the mutex in order to wait on the condition. @c why bother? diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 62909fc99f1..85e94f0f91d 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -438,7 +438,6 @@ Starting Gnus * Finding the News:: Choosing a method for getting news. * The Server is Down:: How can I read my mail then? * Child Gnusae:: You can have more than one Gnus active at a time. -* Fetching a Group:: Starting Gnus just to read a group. * New Groups:: What is Gnus supposed to do with new groups? * Changing Servers:: You may want to move from one server to another. * Startup Files:: Those pesky startup files---@file{.newsrc}. @@ -661,7 +660,7 @@ Getting News * NNTP:: Reading news from an @acronym{NNTP} server. * News Spool:: Reading news from the local spool. -@acronym{NNTP} +NNTP * Direct Functions:: Connecting directly to the server. * Indirect Functions:: Connecting indirectly to the server. @@ -731,8 +730,8 @@ Document Groups Virtual Groups -* Selection Groups:: Articles selected from many places. -* Combined Groups:: Combining multiple groups. +* Selection Groups:: Combining articles from many groups. +* Combined Groups:: Combining multiple groups. Email Based Diary @@ -838,9 +837,11 @@ Various * Mode Lines:: Displaying information in the mode lines. * Highlighting and Menus:: Making buffers look all nice and cozy. * Daemons:: Gnus can do things behind your back. +* Notifications:: Setting up desktop notifications. * Undo:: Some actions can be undone. * Predicate Specifiers:: Specifying predicates. * Moderation:: What to do if you're a moderator. +* Fetching a Group:: Starting Gnus just to read a group. * Image Enhancements:: Emacs can display images. * Fuzzy Matching:: What's the big fuzz? * Thwarting Email Spam:: Simple ways to avoid unsolicited commercial email. @@ -22683,6 +22684,7 @@ For instance, @code{nnir-notmuch-program} is now * Mode Lines:: Displaying information in the mode lines. * Highlighting and Menus:: Making buffers look all nice and cozy. * Daemons:: Gnus can do things behind your back. +* Notifications:: Setting up desktop notifications. * Undo:: Some actions can be undone. * Predicate Specifiers:: Specifying predicates. * Moderation:: What to do if you're a moderator. @@ -23732,6 +23734,36 @@ functions that scan all news and mail from all servers every two seconds is a sure-fire way of getting booted off any respectable system. So behave. +@node Notifications +@section Notifications +@cindex notifications, desktop +@cindex desktop notifications + +Gnus provides the @code{gnus-notifications} package that, combined with +a @code{gnus-demon} handler, can be used to notify you when fresh news +or mails arrive via desktop notifications. Here's a basic configuration +to put in your @file{~/.gnus.el} file: + +@lisp +(require 'gnus-notifications) +(add-hook 'gnus-after-getting-new-news-hook #'gnus-notifications) +(gnus-demon-add-handler #'gnus-demon-scan-news 15 3) ;every 15 minutes +@end lisp + +@noindent +The above will produce notifications for new arrivals when the +@code{gnus-after-getting-new-news-hook} hook runs, which is triggered +after retrieving news and mails with the @code{gnus-demon-scan-news} +procedure. The demon handler is configured to scan news every fifteen +minutes, once Emacs has been idle for three minutes. + +@quotation Important +@code{gnus-notifications} will only emit notifications for groups whose +level is equal or lower than @var{gnus-notifications-minimum-level}, +which defaults to @code{1}, so make sure to set the level of the groups +you want to be notified for to @code{1}, or adjust the value of +@var{gnus-notifications-minimum-level} to your needs. +@end quotation @node Undo @section Undo diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 3ebea93cb1d..3907525cf56 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2025-03-22.08} +\def\texinfoversion{2025-06-18.21} % % Copyright 1985, 1986, 1988, 1990-2025 Free Software Foundation, Inc. % @@ -9419,6 +9419,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \expandafter\xdef\csname floatlist\iffloattype\endcsname{\the\toks0 {\safexrefname}}% \fi + \ignorespaces % ignore ends of line in aux file } % If working on a large document in chapters, it is convenient to diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 7e3238d70de..a6e305534aa 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.8.0-pre +@set trampver 2.8.0 @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 28.1 diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index 3bb8beddcd3..fe7f81c7930 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -31,7 +31,7 @@ General Public License for more details. @finalout @titlepage @title Transient User and Developer Manual -@subtitle for version 0.9.1 +@subtitle for version 0.9.3 @author Jonas Bernoulli @page @vskip 0pt plus 1filll @@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive tutorial, available at @uref{https://github.com/positron-solutions/transient-showcase}. @noindent -This manual is for Transient version 0.9.1. +This manual is for Transient version 0.9.3. @insertcopying @end ifnottex @@ -3033,6 +3033,14 @@ the transient menu, you will be able to yank it in another buffer. #'transient--do-stay) @end lisp +Copying the region while not seeing the region is a bit fiddly, so a +dedicated command, @code{transient-copy-menu-text}, was added. You have to +add a binding for this command in @code{transient-map}. + +@lisp +(keymap-set transient-map "C-c C-w" #'transient-copy-menu-text) +@end lisp + @anchor{How can I autoload prefix and suffix commands?} @appendixsec How can I autoload prefix and suffix commands? diff --git a/etc/NEWS b/etc/NEWS index 0c66ac38105..f4e64c0851f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -61,6 +61,13 @@ OS selection instead of terminal-specific keybindings. You can keep the old behavior by putting '(xterm-mouse-mode -1)' in your init file. ++++ +** 'site-start.el' is now loaded before the user's early init file. +Previously, the order was early-init.el, site-start.el and then the +user's regular init file, but now site-start.el comes first. This +allows site administrators to customize things that can normally only be +done from early-init.el, such as adding to 'package-directory-list'. + * Changes in Emacs 31.1 @@ -386,12 +393,12 @@ docstring for arguments passed to a help-text function. --- *** New command 'tab-line-move-tab-forward' ('C-x M-'). Together with the new command 'tab-line-move-tab-backward' -('C-x M-') it can be used to move the current tab +('C-x M-'), it can be used to move the current tab on the tab line to a different position. --- *** New command 'tab-line-close-other-tabs'. -It's bound to the tab's context menu item "Close other tabs". +It is bound to the tab's context menu item "Close other tabs". ** Project @@ -425,6 +432,19 @@ invoked standalone or from the 'project-switch-commands' dispatch menu. This user option describes projects that should always be skipped by 'project-remember-project'. +--- +*** New user option 'project-prune-zombie-projects'. +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. + +By default this is set to 'project-prune-zombies-default' function +which removes all non-remote projects. + --- *** New command 'project-save-some-buffers' bound to 'C-x p C-x s'. This is like 'C-x s', but only for this project's buffers. @@ -557,12 +577,24 @@ This option, if non-nil, makes 'delete-pair' push a mark at the end of the region enclosed by the deleted delimiters. This makes it easy to act on that region. For example, we can highlight it using 'C-x C-x'. +** Electric Pair mode + +++ -** Electric Pair mode can now pair multiple delimiters at once. +*** Electric Pair mode can now pair multiple delimiters at once. You can now insert or wrap text with multiple sets of parentheses and other matching delimiters at once with Electric Pair mode, by providing a prefix argument when inserting one of the delimiters. +--- +*** Electric Pair mode now supports multi-character paired delimiters. +'electric-pair-pairs' and 'electric-pair-text-pairs' now allow using +strings for multi-character paired delimiters. + +To use this, add a list to both electric pair user options: '("/*" . "*/")'. + +You can also specify to insert an extra space after the first string +pair: '("/*" " */" t)'. + +++ ** You can now use 'M-~' during 'C-x s' ('save-some-buffers'). Typing 'M-~' while saving some buffers means not to save the buffer and @@ -587,15 +619,24 @@ The new command 'fill-paragraph-semlf' fills a paragraph of text using "semantic linefeeds", whereby a newline is inserted after every sentence. The new command 'fill-region-as-paragraph-semlf' fills a region of text using semantic linefeeds as if the region were a single -paragraph. +paragraph. You can set the variable 'fill-region-as-paragraph-function' +to the value 'fill-region-as-paragraph-semlf' to enable functions like +'fill-paragraph' and 'fill-region' to fill text using "semantic +linefeeds". + ++++ +** 'C-u C-x .' clears the fill prefix. +You can now use 'C-u C-x .' to clear the fill prefix, similarly to how +you could already use 'C-u C-x C-n' to clear the goal column. * Changes in Specialized Modes and Packages in Emacs 31.1 ** Register + *** The "*Register Preview*" buffer shows only suitable registers. That was already the case for the "fancy" UI but is now also true in -the default UI you get, i.e. when 'register-use-preview' is 'traditional'. +the default UI you get, i.e., when 'register-use-preview' is 'traditional'. ** Tree-sitter @@ -604,6 +645,10 @@ It controls the automatic installation of tree-sitter grammar libraries needed for tree-sitter based modes, if these grammar libraries are not available when such modes are turned on. +*** 'treesit-language-source-alist' supports keywords. +The language and URL are mandatory, but remaining data can use keywords: +'(json "https://github.com/tree-sitter/tree-sitter-json" :commit "4d770d3")'. + *** The file treesit-x.el defines a number of simple tree-sitter modes. Using the new macro 'define-treesit-generic-mode', generic modes are defined including, but not limited to, 'gitattributes-generic-ts-mode'. @@ -716,19 +761,19 @@ Users can customize this variable to add simple custom indentation rules for tree-sitter major modes. +++ -*** New variable 'treesit-languages-require-line-column-tracking' +*** New variable 'treesit-languages-require-line-column-tracking'. Now Emacs can optionally track line and column numbers for buffer edits and send that information to tree-sitter parsers. Parsers of languages in this list will receive line and column information. This is only needed for very few languages. So far only Haskell is known to need it. +++ -*** New function 'treesit-tracking-line-column-p' +*** New function 'treesit-tracking-line-column-p'. New function to check if a buffer is tracking line and column for buffer edits. +++ -*** New function 'treesit-parser-tracking-line-column-p' +*** New function 'treesit-parser-tracking-line-column-p'. New function to check if a parser is receiving line and column information. @@ -908,7 +953,8 @@ are discarded, which matches the behavior of physical terminals and other terminal emulators. Control sequences and escape sequences are still processed correctly regardless of margin position. -** Smerge +--- +** SMerge *** New command 'smerge-extend' extends a conflict over surrounding lines. @@ -917,6 +963,19 @@ When used inside a refined chunk, it jumps to the matching position in the "other" side of the refinement: if you're in the new text, it jumps to the corresponding position in the old text and vice versa. +*** New user option 'smerge-refine-shadow-cursor'. +When 'smerge-refine' shows the conflict diffs at word granularity, a +"shadow cursor" is now displayed in the "lower" version when point +is in the "upper" version, and vice versa. The "shadow cursor" is +just the character corresponding to the position where +'smerge-refine-exchange-point' would jump, shown in a new distinct +face 'smerge-refine-shadow-cursor', by default a box face. + +** Cursor Sensor mode + ++++ +*** New direction 'moved' used when the cursor moved within the active area. + ** Image Dired *** 'image-dired-show-all-from-dir' takes the same first argument as 'dired'. @@ -955,7 +1014,7 @@ Emacs 25.1), and gnudoit (obsolete since Emacs 25.1). ** CL-Lib +++ -*** Derived types (i.e. 'cl-deftype') can now be used as method specializers, +*** Derived types (i.e. 'cl-deftype') can now be used as method specializers. As part of this new support, the new function 'cl-types-of' returns the list of types to which a value belongs. @@ -1028,6 +1087,15 @@ compatible. 'recentf-save-list' can print a message when saving the recentf list. The new option, if set to nil, suppresses this message. +--- +*** New user option 'recentf-suppress-open-file-help'. +By default, invoking 'recentf-open-files' displays a message saying what +action clicking or typing 'RET' on the item at point executes, and tabbing +between items in the "*Open Recent*" buffer likewise displays such +messages. To suppress these messages, customize the user option +'recentf-suppress-open-file-help' to non-nil. The default value of this +option is nil. + ** Saveplace --- @@ -1293,7 +1361,7 @@ HTML 'doctype' declaration to have context-type "text/html". +++ *** 'eww-switch-to-buffer' falls back to 'eww'. -When there is no EWW buffers, 'eww-switch-to-buffer' falls back to +When there is no EWW buffer, 'eww-switch-to-buffer' falls back to calling 'eww'. ** CC mode @@ -1307,7 +1375,7 @@ alist element is indented as though it were the 'cdr'. +++ *** Enums now have their own syntactic symbols. The new symbols 'enum-open', 'enum-close', 'enum-intro' and -'enum-entry' are used in the analysis of enum constructs. Previously +'enum-entry' are used in the analysis of enum constructs. Previously, they were given 'brace-list-open', etc. These are fully described in the "(ccmode) Enum Symbols" node of the CC mode manual. @@ -1458,6 +1526,9 @@ can be used in parallel. Example: on both remote hosts "host1" and This feature is experimental. +--- +*** Implementation of filesystem notifications for connection method "smb". + ** Diff --- @@ -1815,11 +1886,38 @@ file removal. --- *** New user option 'vc-dir-hide-up-to-date-on-revert'. -If you customize this variable to non-nil, the 'g' command to refresh +If you customize this option to non-nil, the 'g' command to refresh the VC Directory buffer also has the effect of the 'x' command. That is, typing 'g' refreshes the buffer and also hides items in the 'up-to-date' and 'ignored' states. +--- +*** New user option 'vc-dir-save-some-buffers-on-revert'. +If you customize this option to non-nil, Emacs will offer to save +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'. + +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. + ++++ +*** 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 +commands, such that the new incoming and outgoing commands have global +bindings: + +- 'C-x v I L' is bound to 'vc-log-incoming' +- 'C-x v I D' is bound to 'vc-root-diff-incoming' +- 'C-x v O L' is bound to 'vc-log-outgoing' +- 'C-x v O D' is bound to 'vc-root-diff-outgoing'. + +++ *** New user option 'vc-async-checkin' to enable async checkin operations. Currently only supported by the Git and Mercurial backends. @@ -1827,11 +1925,18 @@ Currently only supported by the Git and Mercurial backends. --- *** New 'log-edit-hook' option to display diff of changes to commit. You can customize 'log-edit-hook' to include its new -'log-edit-maybe-show-diff' option to enable displaying a diff of the +'log-edit-maybe-show-diff' function to enable displaying a diff of the changes to be committed in a window. This is like the 'C-c C-d' command -in Log Edit mode buffers, except that it does not select the *vc-diff* +in Log Edit mode buffers, except that it does not select the "*vc-diff*" buffer's window, and so works well when added to 'log-edit-hook'. +--- +*** 'vc-annotate' now abbreviates the Git revision in more cases. +In Emacs 30, 'vc-annotate' gained the ability to abbreviate the Git +revision in the buffer name. Now, it also abbreviates the Git revision +when visiting other revisions, such as with +'vc-annotate-revision-previous-to-line'. + --- *** New buffer-local variable 'vc-buffer-overriding-fileset'. Primarily intended for buffers not visiting files, this specifies the @@ -1900,11 +2005,19 @@ the command will only copy those files. +++ *** package-x.el is now obsolete. +--- +*** Package menu now highlights packages marked for installation or deletion. -** RCIRC +*** Package menu now displays the total number of the package type. +Package menu now displays in the mode line the total number of packages +installed, total number of packages from all the package archives, total +number of packages to upgrade and total number of new packages +available. + +** Rcirc +++ -*** Authentication via NickServ can access password from 'auth-source' +*** Authentication via NickServ can access password from 'auth-source'. For details, consult 'rcirc-authinfo'. ** Xref @@ -2084,7 +2197,7 @@ It is intended to be used in 'ring-bell-function'. --- *** New function 'flash-echo-area-bell-function'. -This function flashes current echo area briefly. +This function flashes the current echo area briefly. It is intended to be used in 'ring-bell-function'. --- @@ -2159,8 +2272,8 @@ DISABLE-URI non-nil. ** GUD ---- -*** pdb, perldb, and guiler suggest debugging the current file via 'M-n'. ++++ +*** 'pdb', 'perldb', and 'guiler' suggest debugging the current file via 'M-n'. When starting these debuggers (e.g., 'M-x pdb') while visiting a file, pressing 'M-n' in the command prompt suggests a command line including the file name, using the minibuffer's "future history". @@ -2185,13 +2298,12 @@ The month and year navigation key bindings 'M-}', 'M-{', 'C-x ]' and ** Calc *** New user option 'calc-string-maximum-character'. - Previously, the 'calc-display-strings', 'string', and 'bstring' functions only considered integer vectors whose elements are all in the Latin-1 range 0-255. This hard-coded maximum is replaced by 'calc-string-maximum-character', and setting it to a higher value allows the display of matching vectors as Unicode strings. The default value -is '0xFF' or '255' to preserve the existing behavior. +is 0xFF or 255 to preserve the existing behavior. ** Time @@ -2204,8 +2316,27 @@ each refresh. The sort direction can be controlled by using a cons cell of a format string and a boolean. Alternatively, a sorting function can be provided directly. - +** Fill ++++ +*** New variable 'fill-region-as-paragraph-function'. +The new variable 'fill-region-as-paragraph-function' provides a way to +override how functions like 'fill-paragraph' and 'fill-region' fill +text. Major modes can bind this variable to a function that fits their +needs. It defaults to 'fill-region-as-paragraph-default'. + +--- +** 'report-emacs-bug' now checks whether the bug report is about Org. +The command 'report-emacs-bug' looks in the report text for symbols that +indicate problems in Org, and if found, will ask whether the bug report +is actually about Org (in which case users should use the Org-specific +command for reporting bugs). + +--- +** The elint package is now obsolete. +Use the byte-compiler instead; it provides more and more useful warnings. + + * New Modes and Packages in Emacs 31.1 ** New minor mode 'delete-trailing-whitespace-mode'. diff --git a/etc/NEWS.30 b/etc/NEWS.30 index dfe4c65f1dd..c52929b6d38 100644 --- a/etc/NEWS.30 +++ b/etc/NEWS.30 @@ -608,6 +608,14 @@ Homebrew. *** 'write-region-inhibit-fsync' now defaults to t in interactive mode. This is the default in batch mode since Emacs 24. +*** Warnings are now by default displayed in a new window at frame's bottom. +Previously, when the selected frame had horizontally-split windows, +warnings were displayed in some window on the frame that was hard to +predict in advance. The default behavior was changed to always display +the window showing the warnings at the bottom of the selected frame. +Customize the new user option 'warning-display-at-bottom' to the nil +value to get back the previous behavior. + *** The default value of 'read-process-output-max' was increased to 65536. *** 'url-gateway-broken-resolution' is now obsolete. diff --git a/etc/images/package-menu/README b/etc/images/package-menu/README new file mode 100644 index 00000000000..6b6414689c2 --- /dev/null +++ b/etc/images/package-menu/README @@ -0,0 +1,14 @@ +COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES -*- coding: utf-8 -*- + +The following icons were created by Elías Gabriel Pérez +based on package-x-generic icon from GNOME 2.x. +Copyright (C) 2025 Free Software Foundation, Inc. +License: GNU General Public License version 3 or later (see COPYING) + + delete.pbm delete.xpm + execute.pbm execute.xpm + info.pbm info.xpm + install.pbm install.xpm + unmark.pbm unmark.xpm + url.pbm url.xpm + upgrade.pbm upgrade.xpm diff --git a/etc/images/package-menu/delete.pbm b/etc/images/package-menu/delete.pbm new file mode 100644 index 00000000000..bf071c0f4e1 Binary files /dev/null and b/etc/images/package-menu/delete.pbm differ diff --git a/etc/images/package-menu/delete.xpm b/etc/images/package-menu/delete.xpm new file mode 100644 index 00000000000..a8b2cbacf8e --- /dev/null +++ b/etc/images/package-menu/delete.xpm @@ -0,0 +1,115 @@ +/* XPM */ +static char *dummy[]={ +"24 24 88 2", +"Qt c None", +".a c None", +".b c None", +".# c None", +".D c #6a4206", +".E c #6c470a", +"#v c #764800", +"#u c #7d510a", +".c c #813f40", +".B c #825307", +".A c #85570c", +".d c #8f5902", +".y c #9a691a", +".x c #9b6b1c", +".K c #b28235", +".I c #b2833b", +".J c #b38338", +".e c #b93e3e", +".L c #bd8a3e", +".C c #c29147", +".s c #c2a473", +".M c #c89548", +".X c #cf9640", +".W c #cf9641", +".Y c #cf9740", +".Z c #cf9741", +".z c #cfa462", +".Q c #d0b78b", +"#b c #d19b4a", +".2 c #d29a46", +".0 c #d29b46", +".3 c #d29b47", +".V c #d29e50", +".T c #d29e51", +".U c #d29f51", +".S c #d29f52", +".1 c #d39b46", +"#k c #d4a04e", +".w c #d4b078", +".5 c #d59f4c", +".H c #d5ae74", +".6 c #d69f4c", +"#n c #d7a354", +".4 c #d7b074", +"#a c #d8a352", +"#o c #d8a354", +".8 c #d8a452", +"## c #d9a351", +".9 c #d9a352", +"#. c #d9a452", +"#c c #dab47b", +".P c #dbc6a6", +"#i c #dca757", +"#h c #dca758", +"#e c #dca857", +"#g c #dca858", +"#j c #dda757", +"#f c #dda857", +".7 c #ddb77e", +".O c #ddccaf", +".F c #dfb677", +"#l c #dfbb83", +".t c #e1bb81", +".N c #e1c9a3", +"#d c #e3be87", +"#p c #e3c08a", +"#t c #e5cba0", +".R c #e5ceab", +".f c #e6d4b7", +".r c #e7d7be", +"#m c #e8c792", +".G c #e8c797", +".u c #ebdbc2", +"#s c #eccd9d", +"#r c #eccd9e", +".m c #ecfaeb", +"#q c #eed5ac", +".v c #efe4d2", +".g c #f0fbf0", +".q c #f5efe4", +".j c #f8fdf8", +".o c #f9fdf8", +".n c #f9fdf9", +".i c #fafefa", +".h c #fcfefc", +".p c #fdfefd", +".l c #fefefe", +".k c #ffffff", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQt.#.a.b.c.c.c.cQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.d.dQt.c.e.e.e.e.cQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.d.f.c.e.e.e.e.e.e.cQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.d.c.e.e.e.e.e.e.e.e.c", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.d.c.e.g.h.i.j.k.l.e.c", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.d.c.e.m.n.i.o.k.p.e.c", +"QtQtQtQt.d.d.d.d.d.d.d.d.d.d.c.e.e.e.e.e.e.e.e.c", +"QtQtQtQt.d.q.q.q.q.q.q.q.r.s.t.c.e.e.e.e.e.e.cQt", +"QtQtQtQt.d.q.u.u.u.u.u.v.w.x.y.t.c.e.e.e.e.cQtQt", +"QtQtQtQt.d.q.u.u.u.u.u.v.z.A.B.A.t.c.c.c.cQtQtQt", +"QtQtQtQt.d.u.q.q.q.q.q.q.C.D.D.E.E.F.G.dQtQtQtQt", +"QtQtQtQt.d.H.I.J.K.L.L.M.N.O.P.P.P.Q.R.dQtQtQtQt", +"QtQtQtQt.d.H.S.T.U.V.V.V.V.V.V.V.V.V.H.dQtQtQtQt", +"QtQtQtQt.d.H.W.X.W.X.X.Y.Y.Z.Y.Z.X.Z.H.dQtQtQtQt", +"QtQtQtQt.d.H.0.1.1.0.2.3.0.2.0.3.0.3.H.dQtQtQtQt", +"QtQtQtQt.d.4.5.6.6.6.6.5.6.6.6.5.6.5.H.dQtQtQtQt", +"QtQtQtQt.d.7.8.9#.#.#.#.##.8#a##.9#b#c.dQtQtQtQt", +"QtQtQtQt.d#d#e#f#g#e#f#g#e#g#h#i#j#k#l.dQtQtQtQt", +"QtQtQtQt.d#m#n#n#o#n#o#n#n#o#n#o#n#o#p.dQtQtQtQt", +"QtQtQtQt.d#q#r#r#r#r#r#r#r#r#r#r#s#r#t.dQtQtQtQt", +"QtQtQtQt#u.d.d.d.d.d.d.d.d.d.d.d.d.d.d#vQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQt"}; diff --git a/etc/images/package-menu/execute.pbm b/etc/images/package-menu/execute.pbm new file mode 100644 index 00000000000..da0e6a71727 Binary files /dev/null and b/etc/images/package-menu/execute.pbm differ diff --git a/etc/images/package-menu/execute.xpm b/etc/images/package-menu/execute.xpm new file mode 100644 index 00000000000..d011aab5424 --- /dev/null +++ b/etc/images/package-menu/execute.xpm @@ -0,0 +1,68 @@ +/* XPM */ +static char *dummy[]={ +"24 24 41 1", +". c None", +"i c #002a0a", +"a c #00390d", +"# c #003c0e", +"c c #004310", +"o c #005213", +"j c #133f13", +"e c #1a3b1a", +"l c #2d392d", +"L c #485c46", +"t c #587055", +"v c #5b9159", +"y c #5d905b", +"D c #63a261", +"x c #67af67", +"C c #67af68", +"H c #6b8868", +"K c #6ba368", +"q c #6d9d6c", +"n c #6fae6e", +"s c #6faf6f", +"h c #70a770", +"G c #75af74", +"k c #77a676", +"J c #7db17b", +"F c #82b881", +"M c #89ba88", +"f c #8aba88", +"b c #8bbb8c", +"A c #93be92", +"I c #9dc39d", +"z c #9fc59d", +"p c #a8cba6", +"d c #abd0ac", +"g c #b4d5b4", +"B c #b5d1b5", +"u c #b8d6b8", +"E c #bbd6ba", +"m c #cbdfcb", +"r c #d0e4d0", +"w c #d4e4d4", +"........................", +"........................", +"........................", +"........................", +"........................", +"........................", +"..................#.....", +".................###....", +"................ab#.....", +"......cc.......ade......", +"......cfc.....aghi......", +".......jkc...lmni.......", +".......opqc.crsti.......", +"........ouvcwxyi........", +"........ozABCDti........", +".........oEFGHi.........", +".........oIJKLi.........", +"..........oMHi..........", +"..........oHLi..........", +"...........ii...........", +"........................", +"........................", +"........................", +"........................"}; diff --git a/etc/images/package-menu/info.pbm b/etc/images/package-menu/info.pbm new file mode 100644 index 00000000000..cab93478558 Binary files /dev/null and b/etc/images/package-menu/info.pbm differ diff --git a/etc/images/package-menu/info.xpm b/etc/images/package-menu/info.xpm new file mode 100644 index 00000000000..a1b134da053 --- /dev/null +++ b/etc/images/package-menu/info.xpm @@ -0,0 +1,90 @@ +/* XPM */ +static char *dummy[]={ +"24 24 63 1", +". c None", +"8 c #7d510a", +"z c #825307", +"y c #85570c", +"# c #8f5902", +"b c #97610b", +"v c #9a691a", +"u c #9b6b1c", +"F c #b28235", +"D c #b2833b", +"E c #b38338", +"h c #b47e2b", +"f c #b98330", +"G c #bd8a3e", +"e c #be8835", +"B c #bf7200", +"A c #c29147", +"n c #c2a473", +"i c #c48e3b", +"H c #c89548", +"g c #ca9442", +"P c #cf9640", +"O c #cf9641", +"x c #cfa462", +"p c #d19b4a", +"Q c #d29b46", +"M c #d29e50", +"K c #d29e51", +"L c #d29f51", +"J c #d29f52", +"R c #d39b46", +"t c #d4b078", +"T c #d59f4c", +"C c #d5ae74", +"U c #d69f4c", +"d c #d6b584", +"3 c #d7a354", +"S c #d7b074", +"4 c #d8a354", +"W c #d8a452", +"j c #d9a352", +"X c #d9a452", +"Z c #dca857", +"1 c #dca858", +"0 c #dda857", +"V c #ddb77e", +"w c #dfbc88", +"o c #e1bb81", +"Y c #e3be87", +"5 c #e58900", +"k c #e6d2b5", +"a c #e6d4b7", +"m c #e7d7be", +"2 c #e8c792", +"q c #e8c797", +"c c #e9cc9f", +"r c #ebdbc2", +"7 c #eccd9e", +"6 c #eed5ac", +"s c #efe4d2", +"I c #f59b14", +"l c #f5efe4", +"N c #ffffff", +"........................", +".............##.........", +".............#ab........", +".............#cdb.......", +".............#cedb#.....", +".............#cfgdb#....", +"....##########chijk#....", +"....#lllllllmnogipq#....", +"....#lrrrrrstuvoppw#....", +"....#lrrrrrsxyzyojq#....", +"....#rllllllABBBBBBBB...", +"....#CDEFGGHBIIIIIIIIB..", +"....#CJKLMMBIIINNNNIIIB.", +"....#COPOPBIIINNNNNNIIIB", +"....#CQRRQBIIINNIINNIIIB", +"....#STUUUBIIIIIIINNIIIB", +"....#VWjXXBIIIIINNNIIIIB", +"....#YZ01ZBIIIIINNIIIIIB", +"....#23343BIIIII55555IIB", +"....#67777BIIII5NN5555IB", +"....8#####BIII55NN55555B", +"...........B5555555555B.", +"............B55555555B..", +".............BBBBBBBB..."}; diff --git a/etc/images/package-menu/install.pbm b/etc/images/package-menu/install.pbm new file mode 100644 index 00000000000..6c015cd58b0 Binary files /dev/null and b/etc/images/package-menu/install.pbm differ diff --git a/etc/images/package-menu/install.xpm b/etc/images/package-menu/install.xpm new file mode 100644 index 00000000000..4e8a5dd2b7c --- /dev/null +++ b/etc/images/package-menu/install.xpm @@ -0,0 +1,120 @@ +/* XPM */ +static char *dummy[]={ +"24 24 93 2", +"Qt c None", +".a c None", +".b c None", +".# c None", +".c c #346a33", +".e c #5bb159", +".I c #6a4206", +".J c #6c470a", +"#A c #764800", +"#z c #7d510a", +".G c #825307", +".F c #85570c", +".d c #8f5902", +".D c #9a691a", +".C c #9b6b1c", +".P c #b28235", +".N c #b2833b", +".O c #b38338", +".Q c #bd8a3e", +".H c #c29147", +".w c #c2a473", +".R c #c89548", +".2 c #cf9640", +".1 c #cf9641", +".3 c #cf9740", +".4 c #cf9741", +".E c #cfa462", +".V c #d0b78b", +"#g c #d19b4a", +".7 c #d29a46", +".5 c #d29b46", +".8 c #d29b47", +".0 c #d29e50", +".Y c #d29e51", +".Z c #d29f51", +".X c #d29f52", +".6 c #d39b46", +"#p c #d4a04e", +".B c #d4b078", +"#. c #d59f4c", +".M c #d5ae74", +"## c #d69f4c", +"#s c #d7a354", +".9 c #d7b074", +"#f c #d8a352", +"#t c #d8a354", +"#b c #d8a452", +"#e c #d9a351", +"#c c #d9a352", +"#d c #d9a452", +"#h c #dab47b", +".U c #dbc6a6", +"#n c #dca757", +"#m c #dca758", +"#j c #dca857", +"#l c #dca858", +"#o c #dda757", +"#k c #dda857", +"#a c #ddb77e", +".T c #ddccaf", +".K c #dfb677", +"#q c #dfbb83", +".x c #e1bb81", +".S c #e1c9a3", +"#i c #e3be87", +"#u c #e3c08a", +"#y c #e5cba0", +".W c #e5ceab", +".f c #e6d4b7", +".v c #e7d7be", +"#r c #e8c792", +".L c #e8c797", +".z c #ebdbc2", +".g c #ebf9ea", +"#x c #eccd9d", +"#w c #eccd9e", +".p c #ecfaeb", +".y c #ecfaec", +"#v c #eed5ac", +".A c #efe4d2", +".k c #f0fbf0", +".t c #f3fcf3", +".u c #f5efe4", +".h c #f5fcf5", +".i c #f8fdf8", +".r c #f9fdf8", +".q c #f9fdf9", +".m c #fafefa", +".j c #fbfefb", +".l c #fcfefc", +".s c #fdfefd", +".o c #fefefe", +".n c #ffffff", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQt.#.a.b.c.c.c.cQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.d.dQt.c.e.e.e.e.cQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.d.f.c.e.e.g.h.e.e.cQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.d.c.e.e.e.i.j.e.e.e.c", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.d.c.e.k.l.m.i.n.o.e.c", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.d.c.e.p.q.m.r.n.s.e.c", +"QtQtQtQt.d.d.d.d.d.d.d.d.d.d.c.e.e.e.t.h.e.e.e.c", +"QtQtQtQt.d.u.u.u.u.u.u.u.v.w.x.c.e.e.k.y.e.e.cQt", +"QtQtQtQt.d.u.z.z.z.z.z.A.B.C.D.x.c.e.e.e.e.cQtQt", +"QtQtQtQt.d.u.z.z.z.z.z.A.E.F.G.F.x.c.c.c.cQtQtQt", +"QtQtQtQt.d.z.u.u.u.u.u.u.H.I.I.J.J.K.L.dQtQtQtQt", +"QtQtQtQt.d.M.N.O.P.Q.Q.R.S.T.U.U.U.V.W.dQtQtQtQt", +"QtQtQtQt.d.M.X.Y.Z.0.0.0.0.0.0.0.0.0.M.dQtQtQtQt", +"QtQtQtQt.d.M.1.2.1.2.2.3.3.4.3.4.2.4.M.dQtQtQtQt", +"QtQtQtQt.d.M.5.6.6.5.7.8.5.7.5.8.5.8.M.dQtQtQtQt", +"QtQtQtQt.d.9#.#########.#######.###..M.dQtQtQtQt", +"QtQtQtQt.d#a#b#c#d#d#d#d#e#b#f#e#c#g#h.dQtQtQtQt", +"QtQtQtQt.d#i#j#k#l#j#k#l#j#l#m#n#o#p#q.dQtQtQtQt", +"QtQtQtQt.d#r#s#s#t#s#t#s#s#t#s#t#s#t#u.dQtQtQtQt", +"QtQtQtQt.d#v#w#w#w#w#w#w#w#w#w#w#x#w#y.dQtQtQtQt", +"QtQtQtQt#z.d.d.d.d.d.d.d.d.d.d.d.d.d.d#AQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQt"}; diff --git a/etc/images/package-menu/unmark.pbm b/etc/images/package-menu/unmark.pbm new file mode 100644 index 00000000000..a166f1901db Binary files /dev/null and b/etc/images/package-menu/unmark.pbm differ diff --git a/etc/images/package-menu/unmark.xpm b/etc/images/package-menu/unmark.xpm new file mode 100644 index 00000000000..9d7e119c529 --- /dev/null +++ b/etc/images/package-menu/unmark.xpm @@ -0,0 +1,100 @@ +/* XPM */ +static char *dummy[]={ +"24 24 73 2", +"Qt c None", +".T c #333333", +".B c #6a4206", +".C c #6c470a", +"#g c #7d510a", +".z c #825307", +".y c #85570c", +".# c #8f5902", +".b c #97610b", +".v c #9a691a", +".u c #9b6b1c", +".H c #b28235", +".F c #b2833b", +".G c #b38338", +".1 c #b3b3b3", +".h c #b47e2b", +".f c #b98330", +".I c #bd8a3e", +".e c #be8835", +".A c #c29147", +".n c #c2a473", +".i c #c48e3b", +".J c #c89548", +".g c #ca9442", +".V c #cf9640", +".U c #cf9641", +".W c #cf9740", +".x c #cfa462", +".N c #d0b78b", +".p c #d19b4a", +".Z c #d29a46", +".X c #d29b46", +".0 c #d29b47", +".S c #d29e50", +".Q c #d29e51", +".R c #d29f51", +".P c #d29f52", +".Y c #d39b46", +".t c #d4b078", +".4 c #d59f4c", +".E c #d5ae74", +".5 c #d69f4c", +".d c #d6b584", +"#c c #d7a354", +".3 c #d7b074", +"#d c #d8a354", +".7 c #d8a452", +".j c #d9a352", +".8 c #d9a452", +".M c #dbc6a6", +"#. c #dca857", +"#a c #dca858", +"## c #dda857", +".6 c #ddb77e", +".L c #ddccaf", +".D c #dfb677", +".w c #dfbc88", +".o c #e1bb81", +".K c #e1c9a3", +".9 c #e3be87", +".O c #e5ceab", +".k c #e6d2b5", +".a c #e6d4b7", +".m c #e7d7be", +"#b c #e8c792", +".q c #e8c797", +".c c #e9cc9f", +".r c #ebdbc2", +"#f c #eccd9e", +"#e c #eed5ac", +".s c #efe4d2", +".l c #f5efe4", +".2 c #ffffff", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.#.#QtQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.#.a.bQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.#.c.d.bQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.#.c.e.d.b.#QtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.#.c.f.g.d.b.#QtQtQtQt", +"QtQtQtQt.#.#.#.#.#.#.#.#.#.#.c.h.i.j.k.#QtQtQtQt", +"QtQtQtQt.#.l.l.l.l.l.l.l.m.n.o.g.i.p.q.#QtQtQtQt", +"QtQtQtQt.#.l.r.r.r.r.r.s.t.u.v.o.p.p.w.#QtQtQtQt", +"QtQtQtQt.#.l.r.r.r.r.r.s.x.y.z.y.o.j.q.#QtQtQtQt", +"QtQtQtQt.#.r.l.l.l.l.l.l.A.B.B.C.C.D.q.#QtQtQtQt", +"QtQtQtQt.#.E.F.G.H.I.I.J.K.L.M.M.M.N.O.#QtQtQtQt", +"QtQtQtQt.#.E.P.Q.R.S.S.S.T.T.T.T.T.T.T.T.T.T.T.T", +"QtQtQtQt.#.E.U.V.U.V.V.W.T.T.T.T.T.T.T.T.T.T.T.T", +"QtQtQtQt.#.E.X.Y.Y.X.Z.0.T.T.1.1.1.1.1.1.1.1.2.T", +"QtQtQtQt.#.3.4.5.5.5.5.4.T.T.1.1.1.1.1.1.1.1.2.T", +"QtQtQtQt.#.6.7.j.8.8.8.8.T.T.1.1.1.1.1.1.1.1.2.T", +"QtQtQtQt.#.9#.###a#.###a.T.T.1.1.1.1.1.1.1.1.2.T", +"QtQtQtQt.##b#c#c#d#c#d#c.T.T.1.1.1.1.1.1.1.1.2.T", +"QtQtQtQt.##e#f#f#f#f#f#f.T.T.1.1.1.1.1.1.1.1.2.T", +"QtQtQtQt#g.#.#.#.#.#.#.#.T.T.1.1.1.1.1.1.1.1.2.T", +"QtQtQtQtQtQtQtQtQtQtQtQt.T.T.1.2.2.2.2.2.2.2.2.T", +"QtQtQtQtQtQtQtQtQtQtQtQt.T.1.2.2.2.2.2.2.2.2.2.T", +"QtQtQtQtQtQtQtQtQtQtQtQt.T.T.T.T.T.T.T.T.T.T.T.T"}; diff --git a/etc/images/package-menu/upgrade.pbm b/etc/images/package-menu/upgrade.pbm new file mode 100644 index 00000000000..95a28790d56 Binary files /dev/null and b/etc/images/package-menu/upgrade.pbm differ diff --git a/etc/images/package-menu/upgrade.xpm b/etc/images/package-menu/upgrade.xpm new file mode 100644 index 00000000000..fa2eaf822a2 --- /dev/null +++ b/etc/images/package-menu/upgrade.xpm @@ -0,0 +1,114 @@ +/* XPM */ +static char *dummy[]={ +"24 24 87 2", +"Qt c None", +".d c #1ec11a", +".i c #25a622", +".g c #25b323", +".a c #3b743a", +".J c #6a4206", +".K c #6c470a", +"#u c #764800", +"#i c #7d510a", +".G c #825307", +".F c #85570c", +".# c #8f5902", +".c c #97610b", +".u c #9a691a", +".t c #9b6b1c", +".O c #b28235", +".B c #b2833b", +".N c #b38338", +".k c #b47e2b", +".j c #b98330", +".P c #bd8a3e", +".h c #be8835", +".I c #c29147", +".n c #c2a473", +".v c #c48e3b", +".Q c #c89548", +".p c #ca9442", +".3 c #cf9640", +".H c #cf9641", +".4 c #cf9740", +".5 c #cf9741", +".E c #cfa462", +".U c #d0b78b", +".y c #d19b4a", +".9 c #d29a46", +".M c #d29b46", +"#. c #d29b47", +".0 c #d29e50", +".Y c #d29e51", +".Z c #d29f51", +".D c #d29f52", +".8 c #d39b46", +"#o c #d4a04e", +".s c #d4b078", +".X c #d59f4c", +".A c #d5ae74", +"#b c #d69f4c", +".f c #d6b584", +"#a c #d7a354", +".W c #d7b074", +"#g c #d8a352", +"#q c #d8a354", +".2 c #d8a452", +"#f c #d9a351", +".w c #d9a352", +"#e c #d9a452", +"#h c #dab47b", +".T c #dbc6a6", +"#m c #dca757", +"#l c #dca758", +".7 c #dca857", +"#k c #dca858", +"#n c #dda757", +"#j c #dda857", +".1 c #ddb77e", +".S c #ddccaf", +".L c #dfb677", +"#p c #dfbb83", +".C c #dfbc88", +".o c #e1bb81", +".R c #e1c9a3", +".6 c #e3be87", +"#r c #e3c08a", +"#t c #e5cba0", +".V c #e5ceab", +".x c #e6d2b5", +".b c #e6d4b7", +".m c #e7d7be", +"## c #e8c792", +".z c #e8c797", +".e c #e9cc9f", +".q c #ebdbc2", +"#s c #eccd9d", +"#d c #eccd9e", +"#c c #eed5ac", +".r c #efe4d2", +".l c #f5efe4", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQt.#.#QtQtQt.a.a.a.a.a.a.a", +"QtQtQtQtQtQtQtQtQtQtQtQt.#.b.cQtQtQtQt.a.d.aQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQt.#.e.f.cQtQt.a.d.g.g.aQt", +"QtQtQtQtQtQtQtQtQtQtQtQt.#.e.h.#.#.a.d.g.g.i.i.a", +"QtQtQtQtQtQtQtQtQtQtQtQt.#.e.j.#.b.c.a.g.g.i.aQt", +"QtQtQt.#.#.#.#.#.#.#.#.#.#.e.k.#.e.f.a.i.i.i.aQt", +"QtQtQt.#.l.l.l.l.l.l.l.m.n.o.p.#.e.h.a.i.i.i.aQt", +"QtQtQt.#.l.q.q.q.q.q.r.s.t.u.o.#.e.j.a.a.a.a.aQt", +"QtQtQt.#.l.q.#.#.#.#.#.#.#.#.#.#.e.k.v.w.x.#QtQt", +"QtQtQt.#.q.l.#.l.l.l.l.l.l.l.m.n.o.p.v.y.z.#QtQt", +"QtQtQt.#.A.B.#.l.q.q.q.q.q.r.s.t.u.o.y.y.C.#QtQt", +"QtQtQt.#.A.D.#.l.q.q.q.q.q.r.E.F.G.F.o.w.z.#QtQt", +"QtQtQt.#.A.H.#.q.l.l.l.l.l.l.I.J.J.K.K.L.z.#QtQt", +"QtQtQt.#.A.M.#.A.B.N.O.P.P.Q.R.S.T.T.T.U.V.#QtQt", +"QtQtQt.#.W.X.#.A.D.Y.Z.0.0.0.0.0.0.0.0.0.A.#QtQt", +"QtQtQt.#.1.2.#.A.H.3.H.3.3.4.4.5.4.5.3.5.A.#QtQt", +"QtQtQt.#.6.7.#.A.M.8.8.M.9#..M.9.M#..M#..A.#QtQt", +"QtQtQt.####a.#.W.X#b#b#b#b.X#b#b#b.X#b.X.A.#QtQt", +"QtQtQt.##c#d.#.1.2.w#e#e#e#e#f.2#g#f.w.y#h.#QtQt", +"QtQtQt#i.#.#.#.6.7#j#k.7#j#k.7#k#l#m#n#o#p.#QtQt", +"QtQtQtQtQtQt.####a#a#q#a#q#a#a#q#a#q#a#q#r.#QtQt", +"QtQtQtQtQtQt.##c#d#d#d#d#d#d#d#d#d#d#s#d#t.#QtQt", +"QtQtQtQtQtQt#i.#.#.#.#.#.#.#.#.#.#.#.#.#.##uQtQt"}; diff --git a/etc/images/package-menu/url.pbm b/etc/images/package-menu/url.pbm new file mode 100644 index 00000000000..97d5d604833 Binary files /dev/null and b/etc/images/package-menu/url.pbm differ diff --git a/etc/images/package-menu/url.xpm b/etc/images/package-menu/url.xpm new file mode 100644 index 00000000000..b5df57ca39f --- /dev/null +++ b/etc/images/package-menu/url.xpm @@ -0,0 +1,200 @@ +/* XPM */ +static char *dummy[]={ +"24 24 173 2", +"Qt c None", +"aD c #14293d", +"#B c #183046", +"aQ c #1b3c5c", +"aP c #1e4061", +"#P c #21384d", +"aH c #214364", +"aN c #22415f", +"aO c #224465", +"ai c #294763", +"aG c #294b6c", +"aC c #2a3e51", +"at c #2a4d6d", +"aL c #2c3c49", +"ar c #2e4e6c", +".Z c #2f506f", +"aK c #365168", +"aj c #365a7b", +"ax c #375876", +"aw c #395c7b", +"av c #40607e", +"aM c #4e687e", +"aE c #506d87", +".Y c #53728d", +"aF c #567187", +".X c #575f65", +"aI c #577690", +".V c #5a6267", +".W c #5d6368", +"au c #607d96", +"#A c #627583", +"#8 c #637a8c", +"#q c #666357", +"#F c #687885", +".B c #6a4206", +".C c #6c470a", +"al c #6d8aa2", +"aB c #6e8ca4", +"#U c #708492", +"aJ c #7390a6", +"am c #7693ab", +"an c #7794ab", +"as c #7d510a", +"#4 c #7d98ad", +"#9 c #7d9ab2", +".4 c #7f7a6a", +"aa c #7f9bb3", +".z c #825307", +"#e c #827d6f", +"#. c #828e99", +".y c #85570c", +"aq c #87a3b8", +"#m c #8997a1", +"ay c #89a4b8", +"a. c #8aa5ba", +"#V c #8ca9be", +"ak c #8ea9bd", +".# c #8f5902", +"#O c #8fa7b9", +"a# c #91acc0", +"#W c #92adc1", +"aA c #95acbd", +"ap c #95aec0", +".U c #967d54", +"ab c #96b1c5", +".b c #97610b", +"af c #99b3c6", +".v c #9a691a", +".u c #9b6b1c", +"ac c #9fb7c8", +"ao c #9fb8ca", +"#3 c #a0b9cb", +"ad c #a1b9cb", +"#X c #a2bcce", +"ae c #a4bdcf", +"#2 c #a6bfd0", +"#1 c #a8c0d1", +"#0 c #a9c0cf", +"az c #a9c1d2", +"#M c #abc0d0", +"#N c #abc1d2", +"#H c #afc7d7", +"#Z c #b1c9d7", +".H c #b28235", +".F c #b2833b", +"#L c #b2cbdb", +".G c #b38338", +"#Y c #b3ccdd", +".h c #b47e2b", +".5 c #b6c2cb", +"#K c #b7d0df", +".f c #b98330", +"#r c #bbc8d1", +"#I c #bbd5e5", +"#v c #bcd5e5", +".I c #bd8a3e", +".9 c #bdcbd6", +"#u c #bdd5e5", +"#J c #bdd6e6", +".e c #be8835", +"#G c #bed0dd", +"#w c #bed5e3", +"#z c #bfd1de", +".3 c #c08d3e", +"#d c #c18e40", +".A c #c29147", +".n c #c2a473", +"#i c #c2d7e6", +".i c #c48e3b", +".T c #c4934b", +"#x c #c4d5e1", +"#j c #c5d7e4", +"#t c #c6dae8", +".J c #c89548", +"#y c #c8d8e4", +".g c #ca9442", +"#f c #cad4db", +"#h c #cbdde9", +".8 c #cedce7", +".1 c #cf9640", +".0 c #cf9641", +".2 c #cf9740", +".x c #cfa462", +".N c #d0b78b", +".p c #d19b4a", +"#b c #d29a46", +"## c #d29b46", +"#c c #d29b47", +".S c #d29e50", +".Q c #d29e51", +".R c #d29f51", +".P c #d29f52", +"#a c #d39b46", +".t c #d4b078", +"#o c #d59f4c", +".E c #d5ae74", +"#p c #d69f4c", +".d c #d6b584", +"#l c #d6e3ed", +"#6 c #d7a354", +"#n c #d7b074", +"#k c #d7e4ed", +"#7 c #d8a354", +"#D c #d8a452", +".j c #d9a352", +"#E c #d9a452", +".M c #dbc6a6", +"#R c #dca857", +"#T c #dca858", +"#s c #dce9f1", +"#S c #dda857", +"#C c #ddb77e", +".L c #ddccaf", +"#g c #ddeaf2", +".6 c #dee8ef", +".D c #dfb677", +".w c #dfbc88", +".o c #e1bb81", +".K c #e1c9a3", +".7 c #e1edf5", +"#Q c #e3be87", +".O c #e5ceab", +".k c #e6d2b5", +".a c #e6d4b7", +".m c #e7d7be", +"#5 c #e8c792", +".q c #e8c797", +".c c #e9cc9f", +".r c #ebdbc2", +"ah c #eccd9e", +"ag c #eed5ac", +".s c #efe4d2", +".l c #f5efe4", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.#.#QtQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.#.a.bQtQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.#.c.d.bQtQtQtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.#.c.e.d.b.#QtQtQtQtQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQt.#.c.f.g.d.b.#QtQtQtQt", +"QtQtQtQt.#.#.#.#.#.#.#.#.#.#.c.h.i.j.k.#QtQtQtQt", +"QtQtQtQt.#.l.l.l.l.l.l.l.m.n.o.g.i.p.q.#QtQtQtQt", +"QtQtQtQt.#.l.r.r.r.r.r.s.t.u.v.o.p.p.w.#QtQtQtQt", +"QtQtQtQt.#.l.r.r.r.r.r.s.x.y.z.y.o.j.q.#QtQtQtQt", +"QtQtQtQt.#.r.l.l.l.l.l.l.A.B.B.C.C.D.q.#QtQtQtQt", +"QtQtQtQt.#.E.F.G.H.I.I.J.K.L.M.M.M.N.O.#QtQtQtQt", +"QtQtQtQt.#.E.P.Q.R.S.S.S.S.S.T.U.V.W.X.Y.Y.ZQtQt", +"QtQtQtQt.#.E.0.1.0.1.1.2.2.3.4.5.6.7.8.9#..Y.ZQt", +"QtQtQtQt.#.E###a#a###b#c#d#e#f#g#h#i#j#k#l#m.Y.Z", +"QtQtQtQt.##n#o#p#p#p#p#o#q#r#s#t#u#v#w#x#y#z#A#B", +"QtQtQtQt.##C#D.j#E#E#E#E#F#G#H#I#J#K#v#L#M#N#O#P", +"QtQtQtQt.##Q#R#S#T#R#S#T#U#V#W#X#Y#Z#0#1#2#3#4#P", +"QtQtQtQt.##5#6#6#7#6#7#6#8#9a.a#aaabacadaeaf.Y#P", +"QtQtQtQt.#agahahahahahahaiajakalamanao#3apaqar#P", +"QtQtQtQtas.#.#.#.#.#.#.#aiatauavawaxayazaAaBar#P", +"QtQtQtQtQtQtQtQtQtQtQtQtaCaDaEaFaGaH.ZaIaJaKai#P", +"QtQtQtQtQtQtQtQtQtQtQtQtQtaCaLaMaNaOaPaQ#P#P#BQt", +"QtQtQtQtQtQtQtQtQtQtQtQtQtQtaCaC#P#P#P#P#B#BQtQt"}; diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index e9f41afbaba..07fd35998c9 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -127,6 +127,15 @@ set_attribute (enum scmp_filter_attr attr, uint32_t value) #action, #syscall, arg_cnt, #__VA_ARGS__); \ } \ while (false) +#define RULE0(action, syscall) \ + do \ + { \ + int status = seccomp_rule_add (ctx, action, syscall, 0); \ + if (status < 0) \ + fail (-status, "seccomp_rule_add (%s, %s, 0)", \ + #action, #syscall); \ + } \ + while (false) static void export_filter (const char *file, @@ -178,8 +187,8 @@ main (int argc, char **argv) assert ((uintptr_t) NULL == 0); /* Allow a clean exit. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit_group)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (exit)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (exit_group)); /* Allow `mmap' and friends. This is necessary for dynamic loading, reading the portable dump file, and thread creation. We don't @@ -206,58 +215,58 @@ main (int argc, char **argv) ~(MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED | MAP_DENYWRITE), 0)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (munmap)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (munmap)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (mprotect), /* Don't allow making pages executable. */ SCMP_A2_32 (SCMP_CMP_MASKED_EQ, ~(PROT_NONE | PROT_READ | PROT_WRITE), 0)); /* Allow restartable sequences. The dynamic linker uses them. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (rseq)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (rseq)); /* Futexes are used everywhere. */ RULE (SCMP_ACT_ALLOW, SCMP_SYS (futex), SCMP_A1_32 (SCMP_CMP_EQ, FUTEX_WAKE_PRIVATE)); /* Allow basic dynamic memory management. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (brk)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (brk)); /* Allow some status inquiries. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (uname)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (getuid)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (geteuid)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpid)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (gettid)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (uname)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (getuid)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (geteuid)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (getpid)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (gettid)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp)); /* Allow operations on open file descriptors. File descriptors are capabilities, and operating on them shouldn't cause security issues. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (read)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (pread64)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (write)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (close)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (lseek)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup2)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstat)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (read)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (pread64)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (write)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (close)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (lseek)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (dup)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (dup2)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (fstat)); /* Allow read operations on the filesystem. If necessary, these should be further restricted using mount namespaces. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (access)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (access)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (faccessat)); #ifdef __NR_faccessat2 - RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat2)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (faccessat2)); #endif - RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat64)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat64)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstatat64)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (newfstatat)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlink)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlinkat)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (getcwd)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (stat)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (stat64)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (lstat)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (lstat64)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (fstatat64)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (newfstatat)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (readlink)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (readlinkat)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (getcwd)); /* Allow opening files, assuming they are only opened for reading. */ @@ -292,17 +301,17 @@ main (int argc, char **argv) SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL)); /* Allow reading random numbers from the kernel. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrandom)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (getrandom)); /* Changing the umask is uncritical. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (umask)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (umask)); /* Allow creation of pipes. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe2)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (pipe)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (pipe2)); /* Allow reading (but not changing) resource limits. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrlimit)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (getrlimit)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (prlimit64), SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */); @@ -313,20 +322,20 @@ main (int argc, char **argv) SCMP_A2_64 (SCMP_CMP_NE, 0) /* new_limit != NULL */); /* Emacs installs signal handlers, which is harmless. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaction)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigaction)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigprocmask)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigprocmask)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (sigaction)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigaction)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (sigprocmask)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigprocmask)); /* Allow reading the current time. */ RULE (SCMP_ACT_ALLOW, SCMP_SYS (clock_gettime), SCMP_A0_32 (SCMP_CMP_EQ, CLOCK_REALTIME)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (time)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (gettimeofday)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (time)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (gettimeofday)); /* Allow timer support. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (timer_create)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (timerfd_create)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (timer_create)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (timerfd_create)); /* Allow thread creation. See the NOTES section in the manual page for the `clone' function. */ @@ -340,25 +349,25 @@ main (int argc, char **argv) | CLONE_CHILD_CLEARTID), 0)); /* glibc 2.34+ pthread_create uses clone3. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (clone3)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (clone3)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list)); /* Allow setting the process name for new threads. */ RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl), SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NAME)); /* Allow some event handling functions used by glib. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd2)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (wait4)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (poll)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (eventfd)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (eventfd2)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (wait4)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (poll)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (pidfd_open), SCMP_A1_32 (SCMP_CMP_EQ, 0)); /* Don't allow creating sockets (network access would be extremely dangerous), but also don't crash. */ - RULE (SCMP_ACT_ERRNO (EACCES), SCMP_SYS (socket)); + RULE0 (SCMP_ACT_ERRNO (EACCES), SCMP_SYS (socket)); EXPORT_FILTER (argv[1], seccomp_export_bpf); EXPORT_FILTER (argv[2], seccomp_export_pfc); @@ -368,15 +377,15 @@ main (int argc, char **argv) calls. Firstly, the wrapper binary will need to `execve' the Emacs binary. Furthermore, the C library requires some system calls at startup time to set up thread-local storage. */ - RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (execve)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address)); RULE (SCMP_ACT_ERRNO (EINVAL), SCMP_SYS (prctl), SCMP_A0_32 (SCMP_CMP_EQ, PR_CAPBSET_READ)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl), SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS)); RULE (SCMP_ACT_ERRNO (EINVAL), SCMP_SYS (arch_prctl), SCMP_A0_32 (SCMP_CMP_EQ, ARCH_CET_STATUS)); - RULE (SCMP_ACT_ALLOW, SCMP_SYS (statfs)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (statfs)); /* We want to allow starting the Emacs binary itself with the --seccomp flag, so we need to allow the `prctl' and `seccomp' diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h index 0d452649fb2..8e63387914c 100644 --- a/lib/_Noreturn.h +++ b/lib/_Noreturn.h @@ -14,33 +14,25 @@ You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . */ +/* The _Noreturn keyword of C11. + Do not use [[noreturn]], because with it the syntax + extern _Noreturn void func (...); + would not be valid; such a declaration would be valid only with 'extern' + and '_Noreturn' swapped, or without the 'extern' keyword. However, some + AIX system header files and several gnulib header files use precisely + this syntax with 'extern'. So even though C23 deprecates _Noreturn, + it is currently more portable to prefer it to [[noreturn]]. + + Also, do not try to work around LLVM bug 59792 (clang 15 or earlier). + This rare bug can be worked around by compiling with 'clang -D_Noreturn=', + though the workaround may generate many false-alarm warnings. */ #ifndef _Noreturn -# if (defined __cplusplus \ - && ((201103 <= __cplusplus && !(__GNUC__ == 4 && __GNUC_MINOR__ == 7)) \ - || (defined _MSC_VER && 1900 <= _MSC_VER)) \ - && 0) - /* [[noreturn]] is not practically usable, because with it the syntax - extern _Noreturn void func (...); - would not be valid; such a declaration would only be valid with 'extern' - and '_Noreturn' swapped, or without the 'extern' keyword. However, some - AIX system header files and several gnulib header files use precisely - this syntax with 'extern'. */ -# define _Noreturn [[noreturn]] -# elif (defined __clang__ && __clang_major__ < 16 \ - && defined _GL_WORK_AROUND_LLVM_BUG_59792) - /* Compile with -D_GL_WORK_AROUND_LLVM_BUG_59792 to work around - that rare LLVM bug, though you may get many false-alarm warnings. */ -# define _Noreturn -# elif ((!defined __cplusplus || defined __clang__) \ - && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \ - || (!defined __STRICT_ANSI__ \ - && (4 < __GNUC__ + (7 <= __GNUC_MINOR__) && !defined __clang__ \ - || (defined __apple_build_version__ \ - ? 6000000 <= __apple_build_version__ \ - : 3 < __clang_major__ + (5 <= __clang_minor__)))))) +# if 201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) /* _Noreturn works as-is. */ # elif (2 < __GNUC__ + (8 <= __GNUC_MINOR__) || defined __clang__ \ || 0x5110 <= __SUNPRO_C) + /* Prefer __attribute__ ((__noreturn__)) to plain _Noreturn even if the + latter works, as 'gcc -std=gnu99 -Wpedantic' warns about _Noreturn. */ # define _Noreturn __attribute__ ((__noreturn__)) # elif 1200 <= (defined _MSC_VER ? _MSC_VER : 0) # define _Noreturn __declspec (noreturn) diff --git a/lib/acl.h b/lib/acl.h index 90fd24e152d..e3c134fb41c 100644 --- a/lib/acl.h +++ b/lib/acl.h @@ -79,6 +79,8 @@ struct aclinfo bool acl_errno_valid (int) _GL_ATTRIBUTE_CONST; int file_has_acl (char const *, struct stat const *); int file_has_aclinfo (char const *restrict, struct aclinfo *restrict, int); +int fdfile_has_aclinfo (int, char const *restrict, + struct aclinfo *restrict, int); #if HAVE_LINUX_XATTR_H && HAVE_LISTXATTR bool aclinfo_has_xattr (struct aclinfo const *, char const *) diff --git a/lib/attribute.h b/lib/attribute.h index ae7bbe8e2cb..c85412d90af 100644 --- a/lib/attribute.h +++ b/lib/attribute.h @@ -50,8 +50,9 @@ - In a function declaration/definition with a storage-class specifier: between the storage-class specifier and the return type. - - Or after the parameter list, - ∙ but after ATTRIBUTE_NOTHROW if present. + - Or, in a function declaration: + after the parameter list, + ∙ but after ATTRIBUTE_NOTHROW if present. In other declarations, such as variable declarations: diff --git a/lib/boot-time.h b/lib/boot-time.h index 195839a2c53..7abfa12e444 100644 --- a/lib/boot-time.h +++ b/lib/boot-time.h @@ -29,11 +29,16 @@ extern "C" { /* Store the approximate time when the machine last booted in *P_BOOT_TIME, and return 0. If it cannot be determined, return -1. + If the machine is a container inside another host machine, + return the boot time of the container, not the host. + The difference can matter in GNU/Linux, where times in /proc/stat + might be relative to boot time of the host, not the container. + This function is not multithread-safe, since on many platforms it - invokes the functions setutxent, getutxent, endutxent. These - functions are needed because they may lock FILE (so that we don't - read garbage when a concurrent process writes to FILE), but their - drawback is that they have a common global state. */ + invokes the functions setutxent, getutxent, endutxent. + These functions may lock a file like /var/log/wtmp (so that we + don't read garbage when a concurrent process writes to that file), + but their drawback is that they have a common global state. */ extern int get_boot_time (struct timespec *p_boot_time); diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h index d7f551b30f3..c5068ed48a0 100644 --- a/lib/fcntl.in.h +++ b/lib/fcntl.in.h @@ -209,7 +209,9 @@ _GL_WARN_ON_USE (open, "open is not always POSIX compliant - " # undef open # define open _open # endif -_GL_CXXALIAS_MDA (open, int, (const char *filename, int flags, ...)); +/* Need to cast, because in MSVC the parameter list of _open as a C++ function + is (const char *, int, int = 0). */ +_GL_CXXALIAS_MDA_CAST (open, int, (const char *filename, int flags, ...)); # else _GL_CXXALIAS_SYS (open, int, (const char *filename, int flags, ...)); # endif @@ -313,7 +315,7 @@ _GL_WARN_ON_USE (openat, "openat is not portable - " #endif #ifndef O_DIRECTORY -# define O_DIRECTORY 0 +# define O_DIRECTORY 0x20000000 /* Try to not collide with system O_* flags. */ #endif #ifndef O_DSYNC diff --git a/lib/file-has-acl.c b/lib/file-has-acl.c index 66b920c1ab2..a9cfbf3a16e 100644 --- a/lib/file-has-acl.c +++ b/lib/file-has-acl.c @@ -85,6 +85,13 @@ smack_new_label_from_path (MAYBE_UNUSED const char *path, { return -1; } +static ssize_t +smack_new_label_from_file (MAYBE_UNUSED int fd, + MAYBE_UNUSED const char *xattr, + MAYBE_UNUSED char **label) +{ + return -1; +} # endif static bool is_smack_enabled (void) @@ -115,14 +122,16 @@ aclinfo_may_indicate_xattr (struct aclinfo const *ai) static bool has_xattr (char const *xattr, struct aclinfo const *ai, - MAYBE_UNUSED char const *restrict name, MAYBE_UNUSED int flags) + int fd, char const *restrict name, int flags) { if (ai && aclinfo_has_xattr (ai, xattr)) return true; else if (!ai || aclinfo_may_indicate_xattr (ai)) { - int ret = ((flags & ACL_SYMLINK_FOLLOW ? getxattr : lgetxattr) - (name, xattr, NULL, 0)); + int ret = (fd < 0 + ? ((flags & ACL_SYMLINK_FOLLOW ? getxattr : lgetxattr) + (name, xattr, NULL, 0)) + : fgetxattr (fd, xattr, NULL, 0)); if (0 <= ret || (errno == ERANGE || errno == E2BIG)) return true; } @@ -145,11 +154,12 @@ aclinfo_has_xattr (struct aclinfo const *ai, char const *xattr) return false; } -/* Get attributes of the file NAME into AI, if USE_ACL. +/* Get attributes of the file FD aka NAME into AI, if USE_ACL. + Ignore FD if it is negative. If FLAGS & ACL_GET_SCONTEXT, also get security context. If FLAGS & ACL_SYMLINK_FOLLOW, follow symbolic links. */ static void -get_aclinfo (char const *name, struct aclinfo *ai, int flags) +get_aclinfo (int fd, char const *name, struct aclinfo *ai, int flags) { int scontext_err = ENOTSUP; ai->buf = ai->u.__gl_acl_ch; @@ -163,7 +173,9 @@ get_aclinfo (char const *name, struct aclinfo *ai, int flags) = (flags & ACL_SYMLINK_FOLLOW ? listxattr : llistxattr); while (true) { - ai->size = lsxattr (name, ai->buf, acl_alloc); + ai->size = (fd < 0 + ? lsxattr (name, ai->buf, acl_alloc) + : flistxattr (fd, ai->buf, acl_alloc)); if (0 < ai->size) break; ai->u.err = ai->size < 0 ? errno : 0; @@ -171,7 +183,9 @@ get_aclinfo (char const *name, struct aclinfo *ai, int flags) break; /* The buffer was too small. Find how large it should have been. */ - ssize_t size = lsxattr (name, NULL, 0); + ssize_t size = (fd < 0 + ? lsxattr (name, NULL, 0) + : flistxattr (fd, NULL, 0)); if (size <= 0) { ai->size = size; @@ -214,9 +228,13 @@ get_aclinfo (char const *name, struct aclinfo *ai, int flags) { if (ai->size < 0 || aclinfo_has_xattr (ai, XATTR_NAME_SMACK)) { - ssize_t r = smack_new_label_from_path (name, "security.SMACK64", - flags & ACL_SYMLINK_FOLLOW, - &ai->scontext); + static char const SMACK64[] = "security.SMACK64"; + ssize_t r = + (fd < 0 + ? smack_new_label_from_path (name, SMACK64, + flags & ACL_SYMLINK_FOLLOW, + &ai->scontext) + : smack_new_label_from_file (fd, SMACK64, &ai->scontext)); scontext_err = r < 0 ? errno : 0; } } @@ -226,8 +244,10 @@ get_aclinfo (char const *name, struct aclinfo *ai, int flags) if (ai->size < 0 || aclinfo_has_xattr (ai, XATTR_NAME_SELINUX)) { ssize_t r = - ((flags & ACL_SYMLINK_FOLLOW ? getfilecon : lgetfilecon) - (name, &ai->scontext)); + (fd < 0 + ? ((flags & ACL_SYMLINK_FOLLOW ? getfilecon : lgetfilecon) + (name, &ai->scontext)) + : fgetfilecon (fd, &ai->scontext)); scontext_err = r < 0 ? errno : 0; # ifndef SE_SELINUX_INLINE /* Gnulib's selinux-h module is not in use, so getfilecon and @@ -362,11 +382,14 @@ acl_nfs4_nontrivial (uint32_t *xattr, ssize_t nbytes) } #endif -#if (!USE_LINUX_XATTR && USE_ACL && HAVE_ACL_GET_FD \ - && !HAVE_ACL_EXTENDED_FILE && !HAVE_ACL_TYPE_EXTENDED \ - && !HAVE_ACL_GET_LINK_NP) -# include -# ifdef O_PATH +#if (!USE_LINUX_XATTR && USE_ACL && HAVE_ACL_GET_FILE \ + && !HAVE_ACL_EXTENDED_FILE && !HAVE_ACL_TYPE_EXTENDED) +/* FreeBSD, NetBSD >= 10, IRIX, Tru64, Cygwin >= 2.5 */ + +# if HAVE_ACL_GET_FD && !HAVE_ACL_GET_LINK_NP /* IRIX, Tru64, Cygwin >= 2.5 */ +# include +# ifdef O_PATH +# define acl_get_fd_np(fd, type) acl_get_fd (fd) /* Like acl_get_file, but do not follow symbolic links. */ static acl_t @@ -381,8 +404,24 @@ acl_get_link_np (char const *name, acl_type_t type) errno = err; return r; } -# define HAVE_ACL_GET_LINK_NP 1 +# define HAVE_ACL_GET_LINK_NP 1 +# endif # endif + +static acl_t +acl_get_fdfile (int fd, char const *name, acl_type_t type, int flags) +{ + acl_t (*get) (char const *, acl_type_t) = acl_get_file; +# if HAVE_ACL_GET_LINK_NP /* FreeBSD, NetBSD >= 10, Cygwin >= 2.5 */ + if (0 <= fd) + return acl_get_fd_np (fd, type); + if (! (flags & ACL_SYMLINK_FOLLOW)) + get = acl_get_link_np; +# else + /* Ignore FD and FLAGS, unfortunately. */ +# endif + return get (name, type); +} #endif /* Return 1 if NAME has a nontrivial access control list, @@ -398,14 +437,35 @@ acl_get_link_np (char const *name, acl_type_t type) If the d_type value is not known, use DT_UNKNOWN though this may be less efficient. */ int -file_has_aclinfo (MAYBE_UNUSED char const *restrict name, +file_has_aclinfo (char const *restrict name, struct aclinfo *restrict ai, int flags) +{ + return fdfile_has_aclinfo (-1, name, ai, flags); +} + +/* Return 1 if FD aka NAME has a nontrivial access control list, + 0 if ACLs are not supported, or if NAME has no or only a base ACL, + and -1 (setting errno) on error. Note callers can determine + if ACLs are not supported as errno is set in that case also. + Ignore FD if it is negative. + Set *AI to ACL info regardless of return value. + FLAGS should be a d_type value, optionally ORed with + - _GL_DT_NOTDIR if it is known that NAME is not a directory, + - ACL_GET_SCONTEXT to retrieve security context and return 1 if present, + - ACL_SYMLINK_FOLLOW to follow the link if NAME is a symbolic link; + otherwise do not follow them if possible. + If the d_type value is not known, use DT_UNKNOWN though this may be less + efficient. */ +int +fdfile_has_aclinfo (MAYBE_UNUSED int fd, + MAYBE_UNUSED char const *restrict name, + struct aclinfo *restrict ai, int flags) { MAYBE_UNUSED unsigned char d_type = flags & UCHAR_MAX; #if USE_LINUX_XATTR int initial_errno = errno; - get_aclinfo (name, ai, flags); + get_aclinfo (fd, name, ai, flags); if (!aclinfo_may_indicate_xattr (ai) && ai->size <= 0) { @@ -418,11 +478,11 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, In earlier Fedora the two types of ACLs were mutually exclusive. Attempt to work correctly on both kinds of systems. */ - if (!has_xattr (XATTR_NAME_NFSV4_ACL, ai, name, flags)) + if (!has_xattr (XATTR_NAME_NFSV4_ACL, ai, fd, name, flags)) return - (has_xattr (XATTR_NAME_POSIX_ACL_ACCESS, ai, name, flags) + (has_xattr (XATTR_NAME_POSIX_ACL_ACCESS, ai, fd, name, flags) || ((d_type == DT_DIR || d_type == DT_UNKNOWN) - && has_xattr (XATTR_NAME_POSIX_ACL_DEFAULT, ai, name, flags))); + && has_xattr (XATTR_NAME_POSIX_ACL_DEFAULT, ai, fd, name, flags))); /* A buffer large enough to hold any trivial NFSv4 ACL. The max length of a trivial NFSv4 ACL is 6 words for owner, @@ -432,8 +492,10 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, everyone is another word to hold "EVERYONE@". */ uint32_t buf[2 * (6 + 6 + 7)]; - int ret = ((flags & ACL_SYMLINK_FOLLOW ? getxattr : lgetxattr) - (name, XATTR_NAME_NFSV4_ACL, buf, sizeof buf)); + int ret = (fd < 0 + ? ((flags & ACL_SYMLINK_FOLLOW ? getxattr : lgetxattr) + (name, XATTR_NAME_NFSV4_ACL, buf, sizeof buf)) + : fgetxattr (fd, XATTR_NAME_NFSV4_ACL, buf, sizeof buf)); if (ret < 0) switch (errno) { @@ -467,20 +529,23 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, /* On Linux, acl_extended_file is an optimized function: It only makes two calls to getxattr(), one for ACL_TYPE_ACCESS, one for ACL_TYPE_DEFAULT. */ - ret = ((flags & ACL_SYMLINK_FOLLOW - ? acl_extended_file - : acl_extended_file_nofollow) - (name)); + ret = (fd < 0 + ? ((flags & ACL_SYMLINK_FOLLOW + ? acl_extended_file + : acl_extended_file_nofollow) + (name)) + : acl_extended_fd (fd)); # elif HAVE_ACL_TYPE_EXTENDED /* Mac OS X */ /* On Mac OS X, acl_get_file (name, ACL_TYPE_ACCESS) and acl_get_file (name, ACL_TYPE_DEFAULT) always return NULL / EINVAL. There is no point in making these two useless calls. The real ACL is retrieved through - acl_get_file (name, ACL_TYPE_EXTENDED). */ - acl_t acl = ((flags & ACL_SYMLINK_FOLLOW - ? acl_get_file - : acl_get_link_np) - (name, ACL_TYPE_EXTENDED)); + ACL_TYPE_EXTENDED. */ + acl_t acl = + (fd < 0 + ? ((flags & ACL_SYMLINK_FOLLOW ? acl_get_file : acl_get_link_np) + (name, ACL_TYPE_EXTENDED)) + : acl_get_fd_np (fd, ACL_TYPE_EXTENDED)); if (acl) { ret = acl_extended_nontrivial (acl); @@ -489,13 +554,8 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, else ret = -1; # else /* FreeBSD, NetBSD >= 10, IRIX, Tru64, Cygwin >= 2.5 */ - acl_t (*acl_get_file_or_link) (char const *, acl_type_t) = acl_get_file; -# if HAVE_ACL_GET_LINK_NP /* FreeBSD, NetBSD >= 10, Cygwin >= 2.5 */ - if (! (flags & ACL_SYMLINK_FOLLOW)) - acl_get_file_or_link = acl_get_link_np; -# endif - acl_t acl = acl_get_file_or_link (name, ACL_TYPE_ACCESS); + acl_t acl = acl_get_fdfile (fd, name, ACL_TYPE_ACCESS, flags); if (acl) { ret = acl_access_nontrivial (acl); @@ -517,7 +577,7 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, && (d_type == DT_DIR || (d_type == DT_UNKNOWN && !(flags & _GL_DT_NOTDIR)))) { - acl = acl_get_file_or_link (name, ACL_TYPE_DEFAULT); + acl = acl_get_fdfile (fd, name, ACL_TYPE_DEFAULT, flags); if (acl) { # ifdef __CYGWIN__ /* Cygwin >= 2.5 */ @@ -562,7 +622,10 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, /* Solaris 10 (newer version), which has additional API declared in (acl_t) and implemented in libsec (acl_set, acl_trivial, - acl_fromtext, ...). */ + acl_fromtext, ...). + + Ignore FD, unfortunately. That is better than mishandling + ZFS-style ACLs, as the general case code does. */ return acl_trivial (name); # else /* Solaris, Cygwin, general case */ @@ -586,7 +649,9 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, for (;;) { - count = acl (name, GETACL, alloc, entries); + count = (fd < 0 + ? acl (name, GETACL, alloc, entries) + : facl (fd, GETACL, alloc, entries)); if (count < 0 && errno == ENOSPC) { /* Increase the size of the buffer. */ @@ -657,7 +722,9 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, for (;;) { - count = acl (name, ACE_GETACL, alloc, entries); + count = (fd < 0 + ? acl (name, ACE_GETACL, alloc, entries) + : facl (fd, ACE_GETACL, alloc, entries)); if (count < 0 && errno == ENOSPC) { /* Increase the size of the buffer. */ @@ -722,7 +789,9 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, struct acl_entry entries[NACLENTRIES]; int count; - count = getacl (name, NACLENTRIES, entries); + count = (fd < 0 + ? getacl (name, NACLENTRIES, entries) + : fgetacl (fd, NACLENTRIES, entries)); if (count < 0) { @@ -751,7 +820,8 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, { struct stat statbuf; - if (stat (name, &statbuf) == -1 && errno != EOVERFLOW) + if ((fd < 0 ? stat (name, &statbuf) : fstat (fd, &statbuf)) < 0 + && errno != EOVERFLOW) return -1; return acl_nontrivial (count, entries); @@ -765,6 +835,7 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, struct acl entries[NACLVENTRIES]; int count; + /* Ignore FD, unfortunately. */ count = acl ((char *) name, ACL_GET, NACLVENTRIES, entries); if (count < 0) @@ -809,7 +880,9 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, /* The docs say that type being 0 is equivalent to ACL_ANY, but it is not true, in AIX 5.3. */ type.u64 = ACL_ANY; - if (aclx_get (name, 0, &type, aclbuf, &aclsize, &mode) >= 0) + if (0 <= (fd < 0 + ? aclx_get (name, 0, &type, aclbuf, &aclsize, &mode) + : aclx_fget (fd, 0, &type, aclbuf, &aclsize, &mode))) break; if (errno == ENOSYS) return 0; @@ -855,7 +928,10 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, union { struct acl a; char room[4096]; } u; - if (statacl ((char *) name, STX_NORMAL, &u.a, sizeof (u)) < 0) + if ((fd < 0 + ? statacl ((char *) name, STX_NORMAL, &u.a, sizeof u) + : fstatacl (fd, STX_NORMAL, &u.a, sizeof u)) + < 0) return -1; return acl_nontrivial (&u.a); @@ -866,6 +942,7 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, struct acl entries[NACLENTRIES]; int count; + /* Ignore FD, unfortunately. */ count = acl ((char *) name, ACL_GET, NACLENTRIES, entries); if (count < 0) diff --git a/lib/gettext.h b/lib/gettext.h index ea0c27e0002..fd6c62b7eb7 100644 --- a/lib/gettext.h +++ b/lib/gettext.h @@ -59,18 +59,61 @@ # endif # endif -/* Disabled NLS. - The casts to 'const char *' serve the purpose of producing warnings - for invalid uses of the value returned from these functions. - On pre-ANSI systems without 'const', the config.h file is supposed to - contain "#define const". */ -# undef gettext -# define gettext(Msgid) ((const char *) (Msgid)) -# undef dgettext -# define dgettext(Domainname, Msgid) ((void) (Domainname), gettext (Msgid)) -# undef dcgettext -# define dcgettext(Domainname, Msgid, Category) \ - ((void) (Category), dgettext (Domainname, Msgid)) +/* Disabled NLS. */ +# if defined __GNUC__ && !defined __clang__ && !defined __cplusplus +/* Use inline functions, to avoid warnings + warning: format not a string literal and no format arguments + that don't occur with enabled NLS. */ +/* The return type 'const char *' serves the purpose of producing warnings + for invalid uses of the value returned from these functions. */ +# if __GNUC__ >= 9 +# pragma GCC diagnostic push +# pragma GCC diagnostic ignored "-Wbuiltin-declaration-mismatch" +# endif +__attribute__ ((__always_inline__, __gnu_inline__)) extern inline +# if !defined(__sun) +const +# endif +char * +gettext (const char *msgid) +{ + return msgid; +} +__attribute__ ((__always_inline__, __gnu_inline__)) extern inline +# if !defined(__sun) +const +# endif +char * +dgettext (const char *domain, const char *msgid) +{ + (void) domain; + return msgid; +} +__attribute__ ((__always_inline__, __gnu_inline__)) extern inline +# if !defined(__sun) +const +# endif +char * +dcgettext (const char *domain, const char *msgid, int category) +{ + (void) domain; + (void) category; + return msgid; +} +# if __GNUC__ >= 9 +# pragma GCC diagnostic pop +# endif +# else +/* The casts to 'const char *' serve the purpose of producing warnings + for invalid uses of the value returned from these functions. */ +# undef gettext +# define gettext(Msgid) ((const char *) (Msgid)) +# undef dgettext +# define dgettext(Domainname, Msgid) ((void) (Domainname), gettext (Msgid)) +# undef dcgettext +# define dcgettext(Domainname, Msgid, Category) \ + ((void) (Category), dgettext (Domainname, Msgid)) +# endif # undef ngettext # define ngettext(Msgid1, Msgid2, N) \ ((N) == 1 \ diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index fb34cf2cc1d..bb147b69eed 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -739,6 +739,9 @@ HAVE_CANONICALIZE_FILE_NAME = @HAVE_CANONICALIZE_FILE_NAME@ HAVE_CHOWN = @HAVE_CHOWN@ HAVE_CLOSEDIR = @HAVE_CLOSEDIR@ HAVE_COPY_FILE_RANGE = @HAVE_COPY_FILE_RANGE@ +HAVE_CXX_STDCKDINT_H = @HAVE_CXX_STDCKDINT_H@ +HAVE_C_STDCKDINT_H = @HAVE_C_STDCKDINT_H@ +HAVE_C_UNREACHABLE = @HAVE_C_UNREACHABLE@ HAVE_DECL_DIRFD = @HAVE_DECL_DIRFD@ HAVE_DECL_ECVT = @HAVE_DECL_ECVT@ HAVE_DECL_ENVIRON = @HAVE_DECL_ENVIRON@ @@ -911,6 +914,7 @@ HAVE_SIGNED_WINT_T = @HAVE_SIGNED_WINT_T@ HAVE_SIGSET_T = @HAVE_SIGSET_T@ HAVE_SLEEP = @HAVE_SLEEP@ HAVE_SPAWN_H = @HAVE_SPAWN_H@ +HAVE_STDCKDINT_H = @HAVE_STDCKDINT_H@ HAVE_STDINT_H = @HAVE_STDINT_H@ HAVE_STPCPY = @HAVE_STPCPY@ HAVE_STPNCPY = @HAVE_STPNCPY@ @@ -960,6 +964,8 @@ HAVE_VASPRINTF = @HAVE_VASPRINTF@ HAVE_VDPRINTF = @HAVE_VDPRINTF@ HAVE_WCHAR_H = @HAVE_WCHAR_H@ HAVE_WINSOCK2_H = @HAVE_WINSOCK2_H@ +HAVE_WORKING_CXX_STDCKDINT_H = @HAVE_WORKING_CXX_STDCKDINT_H@ +HAVE_WORKING_C_STDCKDINT_H = @HAVE_WORKING_C_STDCKDINT_H@ HAVE_XSERVER = @HAVE_XSERVER@ HAVE__EXIT = @HAVE__EXIT@ IEEE754_H = @IEEE754_H@ @@ -1087,6 +1093,7 @@ NEXT_AS_FIRST_DIRECTIVE_GETOPT_H = @NEXT_AS_FIRST_DIRECTIVE_GETOPT_H@ NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H = @NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H@ NEXT_AS_FIRST_DIRECTIVE_LIMITS_H = @NEXT_AS_FIRST_DIRECTIVE_LIMITS_H@ NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H = @NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H@ +NEXT_AS_FIRST_DIRECTIVE_STDCKDINT_H = @NEXT_AS_FIRST_DIRECTIVE_STDCKDINT_H@ NEXT_AS_FIRST_DIRECTIVE_STDDEF_H = @NEXT_AS_FIRST_DIRECTIVE_STDDEF_H@ NEXT_AS_FIRST_DIRECTIVE_STDINT_H = @NEXT_AS_FIRST_DIRECTIVE_STDINT_H@ NEXT_AS_FIRST_DIRECTIVE_STDIO_H = @NEXT_AS_FIRST_DIRECTIVE_STDIO_H@ @@ -1107,6 +1114,7 @@ NEXT_GETOPT_H = @NEXT_GETOPT_H@ NEXT_INTTYPES_H = @NEXT_INTTYPES_H@ NEXT_LIMITS_H = @NEXT_LIMITS_H@ NEXT_SIGNAL_H = @NEXT_SIGNAL_H@ +NEXT_STDCKDINT_H = @NEXT_STDCKDINT_H@ NEXT_STDDEF_H = @NEXT_STDDEF_H@ NEXT_STDINT_H = @NEXT_STDINT_H@ NEXT_STDIO_H = @NEXT_STDIO_H@ @@ -3202,6 +3210,15 @@ BUILT_SOURCES += $(STDCKDINT_H) ifneq (,$(GL_GENERATE_STDCKDINT_H_CONDITION)) stdckdint.h: stdckdint.in.h $(top_builddir)/config.status $(gl_V_at)$(SED_HEADER_STDOUT) \ + -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STDCKDINT_H''@|$(NEXT_STDCKDINT_H)|g' \ + -e 's|@''HAVE_C_STDCKDINT_H''@|$(HAVE_C_STDCKDINT_H)|g' \ + -e 's|@''HAVE_WORKING_C_STDCKDINT_H''@|$(HAVE_WORKING_C_STDCKDINT_H)|g' \ + -e 's|@''HAVE_CXX_STDCKDINT_H''@|$(HAVE_CXX_STDCKDINT_H)|g' \ + -e 's|@''HAVE_WORKING_CXX_STDCKDINT_H''@|$(HAVE_WORKING_CXX_STDCKDINT_H)|g' \ $(srcdir)/stdckdint.in.h > $@-t $(AM_V_at)mv $@-t $@ else @@ -3234,6 +3251,7 @@ stddef.h: stddef.in.h $(top_builddir)/config.status -e 's|@''STDDEF_NOT_IDEMPOTENT''@|$(STDDEF_NOT_IDEMPOTENT)|g' \ -e 's|@''REPLACE_NULL''@|$(REPLACE_NULL)|g' \ -e 's|@''HAVE_MAX_ALIGN_T''@|$(HAVE_MAX_ALIGN_T)|g' \ + -e 's|@''HAVE_C_UNREACHABLE''@|$(HAVE_C_UNREACHABLE)|g' \ $(srcdir)/stddef.in.h > $@-t $(AM_V_at)mv $@-t $@ else diff --git a/lib/open.c b/lib/open.c index 7415b48f81c..d76372fd603 100644 --- a/lib/open.c +++ b/lib/open.c @@ -55,24 +55,29 @@ orig_open (const char *filename, int flags, mode_t mode) #include #include -#ifndef REPLACE_OPEN_DIRECTORY -# define REPLACE_OPEN_DIRECTORY 0 +#ifndef HAVE_WORKING_O_DIRECTORY +# define HAVE_WORKING_O_DIRECTORY false #endif +#ifndef OPEN_TRAILING_SLASH_BUG +# define OPEN_TRAILING_SLASH_BUG false +#endif + +#ifndef REPLACE_OPEN_DIRECTORY +# define REPLACE_OPEN_DIRECTORY false +#endif + +static int +lstatif (char const *filename, struct stat *st, int flags) +{ + return flags & O_NOFOLLOW ? lstat (filename, st) : stat (filename, st); +} + int open (const char *filename, int flags, ...) { - /* 0 = unknown, 1 = yes, -1 = no. */ -#if GNULIB_defined_O_CLOEXEC - int have_cloexec = -1; -#else - static int have_cloexec; -#endif + mode_t mode = 0; - mode_t mode; - int fd; - - mode = 0; if (flags & O_CREAT) { va_list arg; @@ -99,7 +104,6 @@ open (const char *filename, int flags, ...) filename = "NUL"; #endif -#if OPEN_TRAILING_SLASH_BUG /* Fail if one of O_CREAT, O_WRONLY, O_RDWR is specified and the filename ends in a slash, as POSIX says such a filename must name a directory : @@ -118,21 +122,55 @@ open (const char *filename, int flags, ...) directories, - if O_WRONLY or O_RDWR is specified, open() must fail because the file does not contain a '.' directory. */ - if ((flags & O_CREAT) - || (flags & O_ACCMODE) == O_RDWR - || (flags & O_ACCMODE) == O_WRONLY) + bool check_for_slash_bug; + if (OPEN_TRAILING_SLASH_BUG) { size_t len = strlen (filename); - if (len > 0 && filename[len - 1] == '/') + check_for_slash_bug = len && filename[len - 1] == '/'; + } + else + check_for_slash_bug = false; + + if (check_for_slash_bug + && (flags & O_CREAT + || (flags & O_ACCMODE) == O_RDWR + || (flags & O_ACCMODE) == O_WRONLY)) + { + errno = EISDIR; + return -1; + } + + /* With the trailing slash bug or without working O_DIRECTORY, check with + stat first lest we hang trying to open a fifo. Although there is + a race between this and opening the file, we can do no better. + After opening the file we will check again with fstat. */ + bool check_directory = + (check_for_slash_bug + || (!HAVE_WORKING_O_DIRECTORY && flags & O_DIRECTORY)); + if (check_directory) + { + struct stat statbuf; + if (lstatif (filename, &statbuf, flags) < 0) { - errno = EISDIR; + if (! (flags & O_CREAT && errno == ENOENT)) + return -1; + } + else if (!S_ISDIR (statbuf.st_mode)) + { + errno = ENOTDIR; return -1; } } + + /* 0 = unknown, 1 = yes, -1 = no. */ +#if GNULIB_defined_O_CLOEXEC + int have_cloexec = -1; +#else + static int have_cloexec; #endif - fd = orig_open (filename, - flags & ~(have_cloexec < 0 ? O_CLOEXEC : 0), mode); + int fd = orig_open (filename, + flags & ~(have_cloexec < 0 ? O_CLOEXEC : 0), mode); if (flags & O_CLOEXEC) { @@ -154,19 +192,21 @@ open (const char *filename, int flags, ...) #if REPLACE_FCHDIR /* Implementing fchdir and fdopendir requires the ability to open a directory file descriptor. If open doesn't support that (as on - mingw), we use a dummy file that behaves the same as directories + mingw), use a dummy file that behaves the same as directories on Linux (ie. always reports EOF on attempts to read()), and - override fstat() in fchdir.c to hide the fact that we have a - dummy. */ + override fstat in fchdir.c to hide the dummy. */ if (REPLACE_OPEN_DIRECTORY && fd < 0 && errno == EACCES - && ((flags & O_ACCMODE) == O_RDONLY - || (O_SEARCH != O_RDONLY && (flags & O_ACCMODE) == O_SEARCH))) + && ((flags & (O_ACCMODE | O_CREAT)) == O_RDONLY + || (O_SEARCH != O_RDONLY + && (flags & (O_ACCMODE | O_CREAT)) == O_SEARCH))) { struct stat statbuf; - if (stat (filename, &statbuf) == 0 && S_ISDIR (statbuf.st_mode)) + if (check_directory + || (lstatif (filename, &statbuf, flags) == 0 + && S_ISDIR (statbuf.st_mode))) { /* Maximum recursion depth of 1. */ - fd = open ("/dev/null", flags, mode); + fd = open ("/dev/null", flags & ~O_DIRECTORY, mode); if (0 <= fd) fd = _gl_register_fd (fd, filename); } @@ -175,10 +215,8 @@ open (const char *filename, int flags, ...) } #endif -#if OPEN_TRAILING_SLASH_BUG - /* If the filename ends in a slash and fd does not refer to a directory, - then fail. - Rationale: POSIX says such a filename must name a directory + /* If checking for directories, fail if fd does not refer to a directory. + Rationale: A filename ending in slash cannot name a non-directory : "A pathname that contains at least one non- character and that ends with one or more trailing characters shall not be resolved @@ -186,23 +224,18 @@ open (const char *filename, int flags, ...) characters names an existing directory" If the named file without the slash is not a directory, open() must fail with ENOTDIR. */ - if (fd >= 0) + if (check_directory && 0 <= fd) { - /* We know len is positive, since open did not fail with ENOENT. */ - size_t len = strlen (filename); - if (filename[len - 1] == '/') + struct stat statbuf; + int r = fstat (fd, &statbuf); + if (r < 0 || !S_ISDIR (statbuf.st_mode)) { - struct stat statbuf; - - if (fstat (fd, &statbuf) >= 0 && !S_ISDIR (statbuf.st_mode)) - { - close (fd); - errno = ENOTDIR; - return -1; - } + int err = r < 0 ? errno : ENOTDIR; + close (fd); + errno = err; + return -1; } } -#endif #if REPLACE_FCHDIR if (!REPLACE_OPEN_DIRECTORY && 0 <= fd) diff --git a/lib/qcopy-acl.c b/lib/qcopy-acl.c index ad7966152aa..282f4b2d2a5 100644 --- a/lib/qcopy-acl.c +++ b/lib/qcopy-acl.c @@ -26,6 +26,7 @@ #if USE_XATTR # include +# include # include # if HAVE_LINUX_XATTR_H @@ -61,6 +62,7 @@ is_attr_permissions (const char *name, struct error_context *ctx) a valid file descriptor, use file descriptor operations, else use filename based operations on SRC_NAME. Likewise for DEST_DESC and DST_NAME. + MODE should be the source file's st_mode. If access control lists are not available, fchmod the target file to MODE. Also sets the non-permission bits of the destination file (S_ISUID, S_ISGID, S_ISVTX) to those from MODE if any are set. @@ -86,10 +88,29 @@ qcopy_acl (const char *src_name, int source_desc, const char *dst_name, Functions attr_copy_* return 0 in case we copied something OR nothing to copy */ if (ret == 0) - ret = source_desc <= 0 || dest_desc <= 0 - ? attr_copy_file (src_name, dst_name, is_attr_permissions, NULL) - : attr_copy_fd (src_name, source_desc, dst_name, dest_desc, - is_attr_permissions, NULL); + { + ret = source_desc <= 0 || dest_desc <= 0 + ? attr_copy_file (src_name, dst_name, is_attr_permissions, NULL) + : attr_copy_fd (src_name, source_desc, dst_name, dest_desc, + is_attr_permissions, NULL); + + /* Copying can fail with EOPNOTSUPP even when the source + permissions are trivial (Bug#78328). Don't report an error + in this case, as the chmod_or_fchmod suffices. */ + if (ret < 0 && errno == EOPNOTSUPP) + { + /* fdfile_has_aclinfo cares only about DT_DIR, _GL_DT_NOTDIR, + and DT_LNK (but DT_LNK is not possible here), + so use _GL_DT_NOTDIR | DT_UNKNOWN for other file types. */ + int flags = S_ISDIR (mode) ? DT_DIR : _GL_DT_NOTDIR | DT_UNKNOWN; + + struct aclinfo ai; + if (!fdfile_has_aclinfo (source_desc, src_name, &ai, flags)) + ret = 0; + aclinfo_free (&ai); + errno = EOPNOTSUPP; + } + } #else /* no XATTR, so we proceed the old dusty way */ struct permission_context ctx; diff --git a/lib/regcomp.c b/lib/regcomp.c index a23f289d7a1..878b65baf07 100644 --- a/lib/regcomp.c +++ b/lib/regcomp.c @@ -1001,21 +1001,25 @@ create_initial_state (re_dfa_t *dfa) Idx dest_idx = dfa->edests[node_idx].elems[0]; if (!re_node_set_contains (&init_nodes, dest_idx)) { - reg_errcode_t merge_err + err = re_node_set_merge (&init_nodes, dfa->eclosures + dest_idx); - if (merge_err != REG_NOERROR) - return merge_err; + if (err != REG_NOERROR) + break; i = 0; } } } /* It must be the first time to invoke acquire_state. */ - dfa->init_state = re_acquire_state_context (&err, dfa, &init_nodes, 0); - /* We don't check ERR here, since the initial state must not be NULL. */ + dfa->init_state + = (err == REG_NOERROR + ? re_acquire_state_context (&err, dfa, &init_nodes, 0) + : NULL); if (__glibc_unlikely (dfa->init_state == NULL)) - return err; - if (dfa->init_state->has_constraint) + { + /* Don't check ERR here, as the initial state must not be null. */ + } + else if (dfa->init_state->has_constraint) { dfa->init_state_word = re_acquire_state_context (&err, dfa, &init_nodes, CONTEXT_WORD); @@ -1025,17 +1029,13 @@ create_initial_state (re_dfa_t *dfa) &init_nodes, CONTEXT_NEWLINE | CONTEXT_BEGBUF); - if (__glibc_unlikely (dfa->init_state_word == NULL - || dfa->init_state_nl == NULL - || dfa->init_state_begbuf == NULL)) - return err; } else dfa->init_state_word = dfa->init_state_nl = dfa->init_state_begbuf = dfa->init_state; re_node_set_free (&init_nodes); - return REG_NOERROR; + return err; } /* If it is possible to do searching in single byte encoding instead of UTF-8 @@ -1677,12 +1677,11 @@ calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa, Idx node, bool root) { err = duplicate_node_closure (dfa, node, node, node, dfa->nodes[node].constraint); - if (__glibc_unlikely (err != REG_NOERROR)) - return err; } /* Expand each epsilon destination nodes. */ - if (IS_EPSILON_NODE(dfa->nodes[node].type)) + if (__glibc_likely (err == REG_NOERROR) + && IS_EPSILON_NODE (dfa->nodes[node].type)) for (i = 0; i < dfa->edests[node].nelem; ++i) { re_node_set eclosure_elem; @@ -1700,14 +1699,14 @@ calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa, Idx node, bool root) { err = calc_eclosure_iter (&eclosure_elem, dfa, edest, false); if (__glibc_unlikely (err != REG_NOERROR)) - return err; + break; } else eclosure_elem = dfa->eclosures[edest]; /* Merge the epsilon closure of 'edest'. */ err = re_node_set_merge (&eclosure, &eclosure_elem); if (__glibc_unlikely (err != REG_NOERROR)) - return err; + break; /* If the epsilon closure of 'edest' is incomplete, the epsilon closure of this node is also incomplete. */ if (dfa->eclosures[edest].nelem == 0) @@ -1717,12 +1716,18 @@ calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa, Idx node, bool root) } } - if (incomplete && !root) - dfa->eclosures[node].nelem = 0; + if (err != REG_NOERROR) + re_node_set_free (&eclosure); else - dfa->eclosures[node] = eclosure; - *new_set = eclosure; - return REG_NOERROR; + { + if (incomplete && !root) + dfa->eclosures[node].nelem = 0; + else + dfa->eclosures[node] = eclosure; + *new_set = eclosure; + } + + return err; } /* Functions for token which are used in the parser. */ @@ -3275,6 +3280,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, else { free_charset (mbcset); + mbcset = NULL; /* Build a tree for simple bracket. */ br_token.type = SIMPLE_BRACKET; br_token.opr.sbcset = sbcset; @@ -3288,7 +3294,8 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, *err = REG_ESPACE; parse_bracket_exp_free_return: re_free (sbcset); - free_charset (mbcset); + if (__glibc_likely (mbcset != NULL)) + free_charset (mbcset); return NULL; } diff --git a/lib/regexec.c b/lib/regexec.c index c5ab9b6649f..0d14ac35fe9 100644 --- a/lib/regexec.c +++ b/lib/regexec.c @@ -2271,7 +2271,7 @@ merge_state_with_log (reg_errcode_t *err, re_match_context_t *mctx, these destinations and the results of the transition table. */ pstate = mctx->state_log[cur_idx]; log_nodes = pstate->entrance_nodes; - if (next_state != NULL) + if (next_state != NULL && next_state->entrance_nodes != NULL) { table_nodes = next_state->entrance_nodes; *err = re_node_set_init_union (&next_nodes, table_nodes, diff --git a/lib/stat-time.h b/lib/stat-time.h index 69813932d5e..38315b9f569 100644 --- a/lib/stat-time.h +++ b/lib/stat-time.h @@ -117,6 +117,31 @@ get_stat_birthtime_ns (_GL_UNUSED struct stat const *st) # endif } +/* Constructs a 'struct timespec' with the given contents. + This macro / function is private to stat-time.h. */ +#if !defined __cplusplus +/* Use a C99 compound literal. + This is guaranteed to initialize also the padding bits, for example on + platforms where tv_sec is 64 bits and tv_nsec is 32 bits, thus avoiding + gcc -Wuse-of-uninitialized-value warnings. */ +# define _gl_make_timespec(sec,nsec) \ + (struct timespec) { .tv_sec = (sec), .tv_nsec = (nsec) } +#else +/* C++ does not have C99 compound literals. + A constructor invocation + timespec { (sec), (nsec) } + would make assumptions about the order of the fields of 'struct timespec', + which are not guaranteed by POSIX. So, use an inline function. */ +static inline struct timespec +_gl_make_timespec (time_t sec, long nsec) +{ + struct timespec ts; + ts.tv_sec = sec; + ts.tv_nsec = nsec; + return ts; +} +#endif + /* Return *ST's access time. */ _GL_STAT_TIME_INLINE struct timespec _GL_ATTRIBUTE_PURE get_stat_atime (struct stat const *st) @@ -124,8 +149,7 @@ get_stat_atime (struct stat const *st) #ifdef STAT_TIMESPEC return STAT_TIMESPEC (st, st_atim); #else - return (struct timespec) { .tv_sec = st->st_atime, - .tv_nsec = get_stat_atime_ns (st) }; + return _gl_make_timespec (st->st_atime, get_stat_atime_ns (st)); #endif } @@ -136,8 +160,7 @@ get_stat_ctime (struct stat const *st) #ifdef STAT_TIMESPEC return STAT_TIMESPEC (st, st_ctim); #else - return (struct timespec) { .tv_sec = st->st_ctime, - .tv_nsec = get_stat_ctime_ns (st) }; + return _gl_make_timespec (st->st_ctime, get_stat_ctime_ns (st)); #endif } @@ -148,8 +171,7 @@ get_stat_mtime (struct stat const *st) #ifdef STAT_TIMESPEC return STAT_TIMESPEC (st, st_mtim); #else - return (struct timespec) { .tv_sec = st->st_mtime, - .tv_nsec = get_stat_mtime_ns (st) }; + return _gl_make_timespec (st->st_mtime, get_stat_mtime_ns (st)); #endif } @@ -164,8 +186,7 @@ get_stat_birthtime (_GL_UNUSED struct stat const *st) || defined HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC) t = STAT_TIMESPEC (st, st_birthtim); #elif defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC - t = (struct timespec) { .tv_sec = st->st_birthtime, - .tv_nsec = st->st_birthtimensec }; + t = _gl_make_timespec (st->st_birthtime, st->st_birthtimensec); #elif defined _WIN32 && ! defined __CYGWIN__ /* Native Windows platforms (but not Cygwin) put the "file creation time" in st_ctime (!). See @@ -173,11 +194,11 @@ get_stat_birthtime (_GL_UNUSED struct stat const *st) # if _GL_WINDOWS_STAT_TIMESPEC t = st->st_ctim; # else - t = (struct timespec) { .tv_sec = st->st_ctime }; + t = _gl_make_timespec (st->st_ctime, 0); # endif #else /* Birth time is not supported. */ - t = (struct timespec) { .tv_sec = -1, .tv_nsec = -1 }; + t = _gl_make_timespec (-1, -1); #endif #if (defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC \ @@ -189,7 +210,7 @@ get_stat_birthtime (_GL_UNUSED struct stat const *st) sometimes returns junk in the birth time fields; work around this bug if it is detected. */ if (! (t.tv_sec && 0 <= t.tv_nsec && t.tv_nsec < 1000000000)) - t = (struct timespec) { .tv_sec = -1, .tv_nsec = -1 }; + t = _gl_make_timespec (-1, -1); #endif return t; diff --git a/lib/stdckdint.in.h b/lib/stdckdint.in.h index 83277b728ee..bb9089b4a13 100644 --- a/lib/stdckdint.in.h +++ b/lib/stdckdint.in.h @@ -15,10 +15,30 @@ You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . */ -#ifndef _GL_STDCKDINT_H -#define _GL_STDCKDINT_H +#if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ +#endif +@PRAGMA_COLUMNS@ -#include "intprops-internal.h" +#ifndef _@GUARD_PREFIX@_STDCKDINT_H + +/* The include_next requires a split double-inclusion guard. */ +#if defined __cplusplus ? @HAVE_CXX_STDCKDINT_H@ : @HAVE_C_STDCKDINT_H@ +# @INCLUDE_NEXT@ @NEXT_STDCKDINT_H@ +#endif + +#ifndef _@GUARD_PREFIX@_STDCKDINT_H +#define _@GUARD_PREFIX@_STDCKDINT_H + +/* Do nothing but include the system header if it works properly. */ +# if defined __cplusplus ? !@HAVE_WORKING_CXX_STDCKDINT_H@ : !@HAVE_WORKING_C_STDCKDINT_H@ + +/* Avoid redefining macros. */ +# undef ckd_add +# undef ckd_sub +# undef ckd_mul + +# include "intprops-internal.h" /* Store into *R the low-order bits of A + B, A - B, A * B, respectively. Return 1 if the result overflows, 0 otherwise. @@ -26,10 +46,13 @@ bit-precise integer type, or an enumeration type. These are like the standard macros introduced in C23, except that - arguments should not have side effects. */ + arguments should not have side effects. The C++26 standard is + expected to add this header and it's macros. */ -#define ckd_add(r, a, b) ((bool) _GL_INT_ADD_WRAPV (a, b, r)) -#define ckd_sub(r, a, b) ((bool) _GL_INT_SUBTRACT_WRAPV (a, b, r)) -#define ckd_mul(r, a, b) ((bool) _GL_INT_MULTIPLY_WRAPV (a, b, r)) +# define ckd_add(r, a, b) ((bool) _GL_INT_ADD_WRAPV (a, b, r)) +# define ckd_sub(r, a, b) ((bool) _GL_INT_SUBTRACT_WRAPV (a, b, r)) +# define ckd_mul(r, a, b) ((bool) _GL_INT_MULTIPLY_WRAPV (a, b, r)) -#endif /* _GL_STDCKDINT_H */ +# endif /* defined __cplusplus ? @HAVE_WORKING_CXX_STDCKDINT_H@ : @HAVE_WORKING_C_STDCKDINT_H@ */ +#endif /* _@GUARD_PREFIX@_STDCKDINT_H */ +#endif /* _@GUARD_PREFIX@_STDCKDINT_H */ diff --git a/lib/stddef.in.h b/lib/stddef.in.h index dc689b8df80..e8c55ff1cdc 100644 --- a/lib/stddef.in.h +++ b/lib/stddef.in.h @@ -188,38 +188,57 @@ typedef union #endif /* ISO C 23 § 7.21.1 The unreachable macro */ -#ifndef unreachable +/* This macro is only usable in C, not in C++. + There is no way to define it as a macro in C++, because that would break code + that does + #include + ... std::unreachable() ... + Similarly, there is no way to define it as an inline function in C++, because + that would break code that does + #include + using std::unreachable; + As a workaround, we define a macro gl_unreachable, that is like unreachable, + but is usable in both C and C++. */ /* Code borrowed from verify.h. */ -# ifndef _GL_HAS_BUILTIN_UNREACHABLE -# if defined __clang_major__ && __clang_major__ < 5 -# define _GL_HAS_BUILTIN_UNREACHABLE 0 -# elif 4 < __GNUC__ + (5 <= __GNUC_MINOR__) && !defined __clang__ -# define _GL_HAS_BUILTIN_UNREACHABLE 1 -# elif defined __has_builtin -# define _GL_HAS_BUILTIN_UNREACHABLE __has_builtin (__builtin_unreachable) -# else -# define _GL_HAS_BUILTIN_UNREACHABLE 0 -# endif -# endif - -# if _GL_HAS_BUILTIN_UNREACHABLE -# define unreachable() __builtin_unreachable () -# elif 1200 <= _MSC_VER -# define unreachable() __assume (0) +#ifndef _GL_HAS_BUILTIN_UNREACHABLE +# if defined __clang_major__ && __clang_major__ < 5 +# define _GL_HAS_BUILTIN_UNREACHABLE 0 +# elif 4 < __GNUC__ + (5 <= __GNUC_MINOR__) && !defined __clang__ +# define _GL_HAS_BUILTIN_UNREACHABLE 1 +# elif defined __has_builtin +# define _GL_HAS_BUILTIN_UNREACHABLE __has_builtin (__builtin_unreachable) # else +# define _GL_HAS_BUILTIN_UNREACHABLE 0 +# endif +#endif + +#if _GL_HAS_BUILTIN_UNREACHABLE +# define gl_unreachable() __builtin_unreachable () +#elif 1200 <= _MSC_VER +# define gl_unreachable() __assume (0) +#elif !defined __cplusplus && @HAVE_C_UNREACHABLE@ +# define gl_unreachable() unreachable () +#else /* Declare abort(), without including . */ extern -# if defined __cplusplus +# if defined __cplusplus "C" -# endif +# endif _Noreturn void abort (void) -# if defined __cplusplus && (__GLIBC__ >= 2) +# if defined __cplusplus && (__GLIBC__ >= 2) _GL_ATTRIBUTE_NOTHROW -# endif +# endif ; -# define unreachable() abort () +# define gl_unreachable() abort () +#endif + +#if !defined __cplusplus && !@HAVE_C_UNREACHABLE@ +/* In C, define unreachable as a macro. */ + +# ifndef unreachable +# define unreachable() gl_unreachable () # endif #endif diff --git a/lib/string.in.h b/lib/string.in.h index e7642211685..e3d94b76c17 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -215,25 +215,49 @@ _GL_EXTERN_C void free (void *); /* Declarations for ISO C N3322. */ #if defined __GNUC__ && __GNUC__ >= 15 && !defined __clang__ _GL_EXTERN_C void *memcpy (void *__dest, const void *__src, size_t __n) +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 + _GL_ATTRIBUTE_NOTHROW +# endif _GL_ATTRIBUTE_NONNULL_IF_NONZERO (1, 3) _GL_ATTRIBUTE_NONNULL_IF_NONZERO (2, 3); _GL_EXTERN_C void *memccpy (void *__dest, const void *__src, int __c, size_t __n) +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 + _GL_ATTRIBUTE_NOTHROW +# endif _GL_ATTRIBUTE_NONNULL_IF_NONZERO (1, 4) _GL_ATTRIBUTE_NONNULL_IF_NONZERO (2, 4); _GL_EXTERN_C void *memmove (void *__dest, const void *__src, size_t __n) +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 + _GL_ATTRIBUTE_NOTHROW +# endif _GL_ATTRIBUTE_NONNULL_IF_NONZERO (1, 3) _GL_ATTRIBUTE_NONNULL_IF_NONZERO (2, 3); _GL_EXTERN_C char *strncpy (char *__dest, const char *__src, size_t __n) +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 + _GL_ATTRIBUTE_NOTHROW +# endif _GL_ATTRIBUTE_NONNULL_IF_NONZERO (1, 3) _GL_ATTRIBUTE_NONNULL_IF_NONZERO (2, 3); _GL_EXTERN_C char *strndup (const char *__s, size_t __n) +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 + _GL_ATTRIBUTE_NOTHROW +# endif _GL_ATTRIBUTE_NONNULL_IF_NONZERO (1, 2); _GL_EXTERN_C char *strncat (char *__dest, const char *__src, size_t __n) +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 + _GL_ATTRIBUTE_NOTHROW +# endif _GL_ARG_NONNULL ((1)) _GL_ATTRIBUTE_NONNULL_IF_NONZERO (2, 3); _GL_EXTERN_C int memcmp (const void *__s1, const void *__s2, size_t __n) +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 + _GL_ATTRIBUTE_NOTHROW +# endif _GL_ATTRIBUTE_NONNULL_IF_NONZERO (1, 3) _GL_ATTRIBUTE_NONNULL_IF_NONZERO (2, 3); _GL_EXTERN_C int strncmp (const char *__s1, const char *__s2, size_t __n) +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 + _GL_ATTRIBUTE_NOTHROW +# endif _GL_ATTRIBUTE_NONNULL_IF_NONZERO (1, 3) _GL_ATTRIBUTE_NONNULL_IF_NONZERO (2, 3); # ifndef __cplusplus @@ -243,6 +267,9 @@ _GL_EXTERN_C void *memrchr (const void *__s, int __c, size_t __n) _GL_ATTRIBUTE_NONNULL_IF_NONZERO (1, 3); # endif _GL_EXTERN_C void *memset (void *__s, int __c, size_t __n) +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 + _GL_ATTRIBUTE_NOTHROW +# endif _GL_ATTRIBUTE_NONNULL_IF_NONZERO (1, 3); _GL_EXTERN_C void *memset_explicit (void *__s, int __c, size_t __n) _GL_ATTRIBUTE_NONNULL_IF_NONZERO (1, 3); diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index 8bde5a7d631..c3c38fd653e 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -849,7 +849,11 @@ _GL_WARN_ON_USE (mknodat, "mknodat is not portable - " # elif @WINDOWS_64_BIT_ST_SIZE@ /* Above, we define stat to _stati64. */ # if defined __MINGW32__ && defined _stati64 -# ifndef _USE_32BIT_TIME_T +# ifdef _USE_32BIT_TIME_T + /* The system headers possibly define _stati64 to _stat32i64. */ +# undef _stat32i64 +# define _stat32i64(name, st) rpl_stat (name, st) +# else /* The system headers define _stati64 to _stat64. */ # undef _stat64 # define _stat64(name, st) rpl_stat (name, st) diff --git a/lib/unistd.in.h b/lib/unistd.in.h index c135a770dc1..9f057d30cdf 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -95,6 +95,15 @@ # include #endif +/* Native Windows platforms declare _chdir, _getcwd, _rmdir in + and/or , not in . + They also declare _access(), _chmod(), _close(), _dup(), _dup2(), _isatty(), + _lseek(), _read(), _unlink(), _write() in . */ +#if defined _WIN32 && !defined __CYGWIN__ +# include +# include +#endif + /* FreeBSD 14.0, NetBSD 10.0, OpenBSD 7.5, Solaris 11.4, and glibc 2.41 do not define O_CLOEXEC in . */ /* Cygwin 1.7.1 and Android 4.3 declare unlinkat in , not in @@ -120,15 +129,6 @@ # undef __need_system_stdlib_h #endif -/* Native Windows platforms declare _chdir, _getcwd, _rmdir in - and/or , not in . - They also declare _access(), _chmod(), _close(), _dup(), _dup2(), _isatty(), - _lseek(), _read(), _unlink(), _write() in . */ -#if defined _WIN32 && !defined __CYGWIN__ -# include -# include -#endif - /* Native Windows platforms declare _execl*, _execv* in . */ #if defined _WIN32 && !defined __CYGWIN__ # include diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 4bda7452ddd..e7492d1b9ed 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -181,9 +181,9 @@ If this contains a %s, that will be replaced by the matching rule." " . ((" (let ((all-variables (apropos-internal ".*" - (lambda (symbol) - (and (boundp symbol) - (get symbol 'variable-documentation)))))) + ,(lambda (symbol) + (and (boundp symbol) + (get symbol 'variable-documentation)))))) (completing-read "Variable to set: " all-variables)) " . " (completing-read "Value to set it to: " nil) @@ -206,11 +206,11 @@ If this contains a %s, that will be replaced by the matching rule." ;; Keywords: " '(require 'finder) ;;'(setq v1 (apply 'vector (mapcar 'car finder-known-keywords))) - '(setq v1 (mapcar (lambda (x) (list (symbol-name (car x)))) + '(setq v1 (mapcar ,(lambda (x) (list (symbol-name (car x)))) finder-known-keywords) v2 (mapconcat (lambda (x) (format "%12s: %s" (car x) (cdr x))) - finder-known-keywords - "\n")) + finder-known-keywords + "\n")) ((let ((minibuffer-help-form v2)) (completing-read "Keyword, C-h: " v1 nil t)) str ", ") diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 1c98de98b9b..917624c489e 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1432,12 +1432,10 @@ Optional integers MON and YR are used instead of today's date." (fit-window-to-buffer nil nil calendar-minimum-window-height) ;; For a full height window or a window that is horizontally ;; combined don't fit height to that of its buffer. - (set-window-vscroll nil 0)) - (sit-for 0)) + (set-window-vscroll nil 0))) (and calendar-mark-holidays-flag ;; (calendar-date-is-valid-p today) ; useful for BC dates - (calendar-mark-holidays) - (and in-calendar-window (sit-for 0))) + (calendar-mark-holidays)) (unwind-protect (if calendar-mark-diary-entries-flag (diary-mark-entries)) (run-hooks (if today-visible diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 4fdf5150cbd..8fb6fadfe4c 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1280,8 +1280,15 @@ function that converts absolute dates to dates of the appropriate type." (month "[0-9]+\\|\\*") (day "[0-9]+\\|\\*") (year "[0-9]+\\|\\*")) - (let* ((case-fold-search t) - marks) + (let ((months-alist (if months (calendar-make-alist months) + (calendar-make-alist + calendar-month-name-array + 1 nil calendar-month-abbrev-array + (mapcar (lambda (e) + (format "%s." e)) + calendar-month-abbrev-array)))) + (case-fold-search t) + marks) (dolist (date-form diary-date-forms) (if (eq (car date-form) 'backup) ; ignore 'backup directive (setq date-form (cdr date-form))) @@ -1363,16 +1370,7 @@ function that converts absolute dates to dates of the appropriate type." (if mm-name (setq mm (if (string-equal mm-name "*") 0 - (cdr (assoc-string - mm-name - (if months (calendar-make-alist months) - (calendar-make-alist - calendar-month-name-array - 1 nil calendar-month-abbrev-array - (mapcar (lambda (e) - (format "%s." e)) - calendar-month-abbrev-array))) - t))))) + (cdr (assoc-string mm-name months-alist t))))) (funcall markfunc mm dd yy marks))))))))) ;;;###cal-autoload diff --git a/lisp/comint.el b/lisp/comint.el index 56a28f6ae99..b9c910eff43 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -523,8 +523,14 @@ executed once, when the buffer is created." :group 'comint) (defcustom comint-terminfo-terminal "dumb" - "Value to use for TERM when the system uses terminfo." - :type 'string + "Value to use for TERM when the system uses terminfo. +If the system's terminfo database contains a definition for the +\"dumb-emacs-ansi\" terminal (as all recent versions of terminfo do), +set this to \"dumb-emacs-ansi\" and then some terminfo-aware programs +will send colorized output when run under Comint." + :type '(choice (const "dumb") + (const "dumb-emacs-ansi") + string) :group 'comint :version "26.1") diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index e029e2610b0..426cb254e5a 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -792,24 +792,24 @@ when the action is chosen.") (defvar custom-reset-extended-menu (let ((map (make-sparse-keymap))) (define-key-after map [Custom-reset-current] - '(menu-item "Undo Edits in Customization Buffer" Custom-reset-current - :enable (seq-some (lambda (option) - (eq (widget-get option :custom-state) - 'modified)) + `(menu-item "Undo Edits in Customization Buffer" Custom-reset-current + :enable (seq-some ,(lambda (option) + (eq (widget-get option :custom-state) + 'modified)) custom-options))) (define-key-after map [Custom-reset-saved] - '(menu-item "Revert This Session's Customizations" Custom-reset-saved - :enable (seq-some (lambda (option) - (memq (widget-get option :custom-state) - '(modified set changed rogue))) + `(menu-item "Revert This Session's Customizations" Custom-reset-saved + :enable (seq-some ,(lambda (option) + (memq (widget-get option :custom-state) + '(modified set changed rogue))) custom-options))) (when (or custom-file user-init-file) (define-key-after map [Custom-reset-standard] - '(menu-item "Erase Customizations" Custom-reset-standard + `(menu-item "Erase Customizations" Custom-reset-standard :enable (seq-some - (lambda (option) - (memq (widget-get option :custom-state) - '(modified set changed rogue saved))) + ,(lambda (option) + (memq (widget-get option :custom-state) + '(modified set changed rogue saved))) custom-options)))) map) "A menu for the \"Revert...\" button. @@ -6095,6 +6095,7 @@ Moves point into the widget that holds the value." "Arrange to execute BODY in a \"*Customize Dirlocals*\" buffer." ;; We don't use `custom-buffer-create' because the settings here ;; don't go into the `custom-file'. + (declare (indent 0) (debug t)) `(progn (switch-to-buffer "*Customize Dirlocals*") diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 09364b68e11..3bc296e4ad1 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -946,19 +946,21 @@ since it could result in memory overflow and make Emacs crash." (put symbol 'custom-set (cadr prop))) ;; This is used by describe-variable. (if version (put symbol 'custom-version version)) - ;; Don't re-add to custom-delayed-init-variables post-startup. - (unless after-init-time - ;; Note this is the _only_ initialize property we handle. - (if (eq (cadr (memq :initialize rest)) #'custom-initialize-delay) - ;; These vars are defined early and should hence be initialized - ;; early, even if this file happens to be loaded late. so add them - ;; to the end of custom-delayed-init-variables. Otherwise, - ;; auto-save-file-name-transforms will appear in customize-rogue. - (add-to-list 'custom-delayed-init-variables symbol 'append))) - ;; If this is NOT while dumping Emacs, set up the rest of the - ;; customization info. This is the stuff that is not needed - ;; until someone does M-x customize etc. - (unless dump-mode + ;; `cus-start' can be loaded twice: it's preloaded by `loadup.el' + ;; (at which point we don't set up all the info) but can be *re*loaded + ;; later on demand by `custom' (and `info-xref') to get the full info. + ;; `cus-start--preload' is bound to t by loadup.el before it loads + ;; this file. + (if (bound-and-true-p cus-start--preload) + ;; Note this is the _only_ initialize property we handle. + (if (eq (cadr (memq :initialize rest)) #'custom-initialize-delay) + ;; These vars are defined early and should hence be initialized + ;; early, even if this file happens to be loaded late. so add + ;; them to the end of custom-delayed-init-variables. Otherwise, + ;; auto-save-file-name-transforms will appear in customize-rogue. + (add-to-list 'custom-delayed-init-variables symbol 'append)) + ;; We're not preloading, so set up the rest of the customization info. + ;; This is the stuff that is not needed until M-x customize etc. ;; Add it to the right group(s). (if (listp group) (dolist (g group) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 89390a482f0..59668f79bd7 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -132,7 +132,7 @@ option value: (restricted-sexp :tag "Variable with regexp value (default: `dired-re-exe')" :match-alternatives - ((lambda (obj) (and (symbolp obj) (boundp obj)))) + (,(lambda (obj) (and (symbolp obj) (boundp obj)))) :value dired-re-exe)) :group 'dired-x) diff --git a/lisp/dired.el b/lisp/dired.el index 4ae3eaf0d98..1e7f26f732f 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2496,11 +2496,11 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (easy-menu-define dired-mode-immediate-menu dired-mode-map "Immediate menu for Dired mode." - '("Immediate" + `("Immediate" ["Edit File Names" wdired-change-to-wdired-mode :help "Put a Dired buffer in a mode in which filenames are editable" :keys "C-x C-q" - :filter (lambda (x) (if (eq major-mode 'dired-mode) x))] + :filter ,(lambda (x) (if (eq major-mode 'dired-mode) x))] ["Create Empty file..." dired-create-empty-file :help "Create an empty file"] ["Create Directory..." dired-create-directory diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index 3173160370e..7c32e2521c5 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -43,10 +43,34 @@ Pairs of delimiters in this list are a fallback in case they have no syntax relevant to `electric-pair-mode' in the mode's syntax table. +Each list element should be in one of these forms: + (CHAR . CHAR) +Where CHAR is character to be used as pair. + + (STRING STRING SPC) +Where STRING is a string to be used as pair and SPC a non-nil value +which specifies to insert an extra space after first STRING. + + (STRING . STRING) +This is similar to (STRING STRING SPC) form, except that SPC (space) is +ignored and will not be inserted. + +In both string pairs forms, the first string pair must be a regular +expression. + +In comparation to character pairs, string pairs does not support +inserting pairs in regions and can not be deleted with +`electric-pair-delete-pair', thus string pairs should be used only for +multi-character pairs. + See also the variable `electric-pair-text-pairs'." :version "24.1" :group 'electricity - :type '(repeat (cons character character))) + :type '(repeat + (choice (cons :tag "Characters" character character) + (cons :tag "Strings" string string) + (list :tag "Strings, plus insert SPC after first string" + string string boolean)))) (defcustom electric-pair-text-pairs `((?\" . ?\") @@ -56,10 +80,36 @@ See also the variable `electric-pair-text-pairs'." Pairs of delimiters in this list are a fallback in case they have no syntax relevant to `electric-pair-mode' in the syntax table -defined in `electric-pair-text-syntax-table'." +defined in `electric-pair-text-syntax-table'. + +Each list element should be in one of these forms: + (CHAR . CHAR) +Where CHAR is character to be used as pair. + + (STRING STRING SPC) +Where STRING is a string to be used as pair and SPC a non-nil value +which specifies to insert an extra space after first STRING. + + (STRING . STRING) +This is similar to (STRING STRING SPC) form, except that SPC (space) is +ignored and will not be inserted. + +In both string pairs forms, the first string pair must be a regular +expression. + +In comparation to character pairs, string pairs does not support +inserting pairs in regions and can not be deleted with +`electric-pair-delete-pair', thus string pairs should be used only for +multi-character pairs. + +See also the variable `electric-pair-pairs'." :version "24.4" :group 'electricity - :type '(repeat (cons character character))) + :type '(repeat + (choice (cons :tag "Characters" character character) + (cons :tag "Strings" string string) + (list :tag "Strings, plus insert SPC after first string" + string string boolean)))) (defcustom electric-pair-skip-self #'electric-pair-default-skip-self "If non-nil, skip char instead of inserting a second closing paren. @@ -276,6 +326,22 @@ string." (direct (assq command-event fallback)) (reverse (rassq command-event fallback))) (cond + ((cl-loop + for pairs in fallback + if (and + (stringp (car pairs)) + (looking-back (car pairs) (pos-bol))) + return (list + 'str + ;; Get pair ender + (if (proper-list-p pairs) + (nth 1 pairs) + (cdr pairs)) + nil + ;; Check if pairs have to insert a space after + ;; first pair was inserted. + (if (proper-list-p pairs) + (nth 2 pairs))))) ((memq (car table-syntax-and-pair) '(?\" ?\( ?\) ?\$)) (append table-syntax-and-pair (list nil string-or-comment))) @@ -560,7 +626,7 @@ The decision is taken by order of preference: (beg (when num (- pos num))) (skip-whitespace-info)) (pcase (electric-pair-syntax-info last-command-event) - (`(,syntax ,pair ,unconditional ,_) + (`(,syntax ,pair ,unconditional ,space) (cond ((null pos) nil) ((zerop num) nil) @@ -622,6 +688,12 @@ The decision is taken by order of preference: pos)) (forward-char num)) ;; Insert matching pair. + ;; String pairs + ((and (eq syntax 'str) (not overwrite-mode)) + (if space (insert " ")) + (save-excursion + (insert pair))) + ;; Char pairs ((and (memq syntax '(?\( ?\" ?\$)) (not overwrite-mode) (or unconditional diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f74fc2eb6c4..67a1b5545d4 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -145,6 +145,8 @@ Possible values are: 1 - emitted code is to be generated in a safe manner, even if functions are mis-declared. +Note that \"safe\" does not mean \"correct\": if functions are declared +incorrectly, the emitted code might also be incorrect. This currently affects only code produced by native-compilation." :type 'integer :safe #'integerp @@ -5167,7 +5169,8 @@ binding slots have been popped." (pcase-let* ;; `macro' is non-nil if it defines a macro. ;; `fun' is the function part of `arg' (defaults to `arg'). - (((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let macro t)) + (((or (and (or `(cons 'macro ,fun) `'(macro . ,(app (list 'quote) fun))) + (let macro t)) (and (let fun arg) (let macro nil))) arg) ;; `lam' is the lambda expression in `fun' (or nil if not @@ -5184,8 +5187,10 @@ binding slots have been popped." name macro arglist body rest) (when macro (if (null fun) - (message "Macro %s unrecognized, won't work in file" name) - (message "Macro %s partly recognized, trying our luck" name) + (byte-compile-warn-x + name "Macro %s unrecognized, won't work in file" name) + (byte-compile-warn-x + name "Macro %s partly recognized, trying our luck" name) (push (cons name (eval fun lexical-binding)) byte-compile-macro-environment))) (byte-compile-keep-pending form)))) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 1fe0411062f..4a9819a2039 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -494,13 +494,17 @@ Optional second arg STATE is a random-state object." (let* ((i (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-i state))) (j (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-j state))) (n (aset vec i (logand 8388607 (- (aref vec i) (aref vec j)))))) - (if (integerp lim) - (if (<= lim 512) (% n lim) - (if (> lim 8388607) (setq n (+ (ash n 9) (cl-random 512 state)))) - (let ((mask 1023)) - (while (< mask (1- lim)) (setq mask (1+ (+ mask mask)))) - (if (< (setq n (logand n mask)) lim) n (cl-random lim state)))) - (* (/ n '8388608e0) lim))))) + (cond + ((natnump lim) + (if (<= lim 512) (% n lim) + (if (> lim 8388607) (setq n (+ (ash n 9) (cl-random 512 state)))) + (let ((mask 1023)) + (while (< mask (1- lim)) (setq mask (1+ (+ mask mask)))) + (if (< (setq n (logand n mask)) lim) n (cl-random lim state))))) + ((< 0 lim 1.0e+INF) + (* (/ n '8388608e0) lim)) + (t + (error "Limit %S not supported by cl-random" lim)))))) ;;;###autoload (defun cl-make-random-state (&optional state) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 34eb66c6884..47e9abf4302 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3363,7 +3363,7 @@ Prepare every function for final compilation and drive the C back-end." nil ".el")) (default-directory invocation-directory)) (with-temp-file temp-file - (insert ";; -*-coding: utf-8-emacs-unix; -*-\n") + (insert ";; -*- coding: utf-8-emacs-unix; lexical-binding: t -*-\n") (mapc (lambda (e) (insert (prin1-to-string e))) expr)) diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el index b0ace3ce8f0..390c1a86717 100644 --- a/lisp/emacs-lisp/cursor-sensor.el +++ b/lisp/emacs-lisp/cursor-sensor.el @@ -141,63 +141,69 @@ By convention, this is a list of symbols where each symbol stands for the ;;; Detect cursor movement. (defun cursor-sensor--detect (&optional window) - (with-current-buffer (window-buffer window) - (unless cursor-sensor-inhibit - (let* ((point (window-point window)) - ;; It's often desirable to make the - ;; cursor-sensor-functions property non-sticky on both - ;; ends, but that means get-pos-property might never - ;; see it. - (new (or (get-char-property point 'cursor-sensor-functions) - (unless (<= (point-min) point) - (get-char-property (1- point) - 'cursor-sensor-functions)))) - (old (window-parameter window 'cursor-sensor--last-state)) - (oldposmark (car old)) - (oldpos (or (if oldposmark (marker-position oldposmark)) - (point-min))) - (start (min oldpos point)) - (end (max oldpos point))) - (unless (or (null old) (eq (marker-buffer oldposmark) (current-buffer))) - ;; `window' does not display the same buffer any more! - (setcdr old nil)) - (if (or (and (null new) (null (cdr old))) - (and (eq new (cdr old)) - (eq (next-single-char-property-change - start 'cursor-sensor-functions nil end) - end))) - ;; Clearly nothing to do. - nil - ;; Maybe something to do. Let's see exactly what needs to run. - (let* ((missing-p - (lambda (f) - "Non-nil if F is missing somewhere between START and END." - (let ((pos start) - (missing nil)) - (while (< pos end) - (setq pos (next-single-char-property-change - pos 'cursor-sensor-functions - nil end)) - (unless (memq f (get-char-property - pos 'cursor-sensor-functions)) - (setq missing t))) - missing))) - (window (selected-window))) - (dolist (f (cdr old)) - (unless (and (memq f new) (not (funcall missing-p f))) - (funcall f window oldpos 'left))) - (dolist (f new) - (unless (and (memq f (cdr old)) (not (funcall missing-p f))) - (funcall f window oldpos 'entered))))) + ;; We're run from `pre-redisplay-functions' and `post-command-hook' + ;; where we can't handle errors very well, so just demote them to make + ;; sure they don't get in the way. + (with-demoted-errors "cursor-sensor--detect: %S" + (with-current-buffer (window-buffer window) + (unless cursor-sensor-inhibit + (let* ((point (window-point window)) + ;; It's often desirable to make the + ;; cursor-sensor-functions property non-sticky on both + ;; ends, so we can't use `get-pos-property' because it + ;; might never see it. + ;; FIXME: Combine properties from covering overlays? + (new (or (get-char-property point 'cursor-sensor-functions) + (unless (<= (point-min) point) + (get-char-property (1- point) + 'cursor-sensor-functions)))) + (old (window-parameter window 'cursor-sensor--last-state)) + (oldposmark (car old)) + (oldpos (or (if oldposmark (marker-position oldposmark)) + (point-min))) + (start (min oldpos point)) + (end (max oldpos point))) + (unless (or (null old) + (eq (marker-buffer oldposmark) (current-buffer))) + ;; `window' does not display the same buffer any more! + (setcdr old nil)) + (if (and (null new) (null (cdr old))) + ;; Clearly nothing to do. + nil + ;; Maybe something to do. Let's see exactly what needs to run. + (let* ((missing-p + (lambda (f) + "Non-nil if F is missing somewhere between START and END." + (let ((pos start) + (missing nil)) + (while (< pos end) + (setq pos (next-single-char-property-change + pos 'cursor-sensor-functions + nil end)) + (unless (memq f (get-char-property + pos 'cursor-sensor-functions)) + (setq missing t))) + missing))) + (window (selected-window))) + (dolist (f (cdr old)) + (unless (and (memq f new) (not (funcall missing-p f))) + (funcall f window oldpos 'left))) + (dolist (f new) + (let ((op (cond + ((or (not (memq f (cdr old))) (funcall missing-p f)) + 'entered) + ((not (= start end)) 'moved)))) + (when op + (funcall f window oldpos op)))))) - ;; Remember current state for next time. - ;; Re-read cursor-sensor-functions since the functions may have moved - ;; window-point! - (if old - (progn (move-marker (car old) point) - (setcdr old new)) - (set-window-parameter window 'cursor-sensor--last-state - (cons (copy-marker point) new))))))) + ;; Remember current state for next time. + ;; Re-read cursor-sensor-functions since the functions may have moved + ;; window-point! + (if old + (progn (move-marker (car old) point) + (setcdr old new)) + (set-window-parameter window 'cursor-sensor--last-state + (cons (copy-marker point) new)))))))) ;;;###autoload (define-minor-mode cursor-sensor-mode @@ -205,8 +211,9 @@ By convention, this is a list of symbols where each symbol stands for the This property should hold a list of functions which react to the motion of the cursor. They're called with three arguments (WINDOW OLDPOS DIR) where WINDOW is the affected window, OLDPOS is the last known position of -the cursor and DIR can be `entered' or `left' depending on whether the cursor -is entering the area covered by the text-property property or leaving it." +the cursor and DIR can be `entered', `left', or `moved' depending on whether +the cursor is entering the area covered by the text-property property, +leaving it, or just moving inside of it." :global nil (cond (cursor-sensor-mode diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 72640e88301..a88473ee792 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -681,7 +681,7 @@ an error." nil ;; Trim off object IDX junk added in for the object index. (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots))) - (let* ((sd (aref (eieio--class-slots class) + (let* ((sd (aref (cl--class-slots class) ;?? slot-idx)) (st (cl--slot-descriptor-type sd))) (cond @@ -740,7 +740,8 @@ Argument FN is the function calling this verifier." (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. - (if (setq c (eieio--class-slot-name-index class slot)) + (if (and (eieio--class-p class) + (setq c (eieio--class-slot-name-index class slot))) ;; Oref that slot. (aref (eieio--class-class-allocation-values class) c) ;; The slot-missing method is a cool way of allowing an object author @@ -783,8 +784,9 @@ Fills in CLASS's SLOT with its default value." (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. - (if (setq c - (eieio--class-slot-name-index cl slot)) + (if (and (eieio--class-p cl) + (setq c + (eieio--class-slot-name-index cl slot))) ;; Oref that slot. (aref (eieio--class-class-allocation-values cl) c) @@ -808,8 +810,9 @@ Fills in OBJ's SLOT with VALUE." (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. - (if (setq c - (eieio--class-slot-name-index class slot)) + (if (and (eieio--class-p class) + (setq c + (eieio--class-slot-name-index class slot))) ;; Oset that slot. (progn (eieio--validate-class-slot-value class c value slot) @@ -849,7 +852,8 @@ Fills in the default value in CLASS' in SLOT with VALUE." (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. - (if (setq c (eieio--class-slot-name-index class slot)) + (if (and (eieio--class-p class) + (setq c (eieio--class-slot-name-index class slot))) (progn ;; Oref that slot. (eieio--validate-class-slot-value class c value slot) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 6c949f1016b..b6c1f2c9f9f 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -367,6 +367,8 @@ See also `incf'." (gv-define-simple-setter aref aset) (gv-define-simple-setter char-table-range set-char-table-range) +(gv-define-simple-setter char-table-extra-slot set-char-table-extra-slot) +(gv-define-simple-setter char-table-parent set-char-table-parent) (gv-define-simple-setter car setcar) (gv-define-simple-setter cdr setcdr) ;; FIXME: add compiler-macros for `cXXr' instead! @@ -400,10 +402,12 @@ See also `incf'." ;;; Elisp-specific generalized variables. (gv-define-simple-setter default-value set-default) +(gv-define-simple-setter default-toplevel-value set-default-toplevel-value t) (gv-define-simple-setter frame-parameter set-frame-parameter 'fix) -(gv-define-simple-setter terminal-parameter set-terminal-parameter) +(gv-define-simple-setter terminal-parameter set-terminal-parameter t) (gv-define-simple-setter keymap-parent set-keymap-parent) (gv-define-simple-setter match-data set-match-data 'fix) +(gv-define-simple-setter marker-insertion-type set-marker-insertion-type) (gv-define-simple-setter overlay-get overlay-put) (gv-define-setter overlay-start (store ov) (macroexp-let2 nil store store @@ -415,6 +419,9 @@ See also `incf'." (gv-define-simple-setter process-filter set-process-filter) (gv-define-simple-setter process-sentinel set-process-sentinel) (gv-define-simple-setter process-get process-put 'fix) +(gv-define-simple-setter process-plist set-process-plist) +(gv-define-simple-setter process-query-on-exit-flag set-process-query-on-exit-flag) +(gv-define-simple-setter process-thread set-process-thread) (gv-define-simple-setter window-parameter set-window-parameter) (gv-define-setter window-buffer (v &optional w) (macroexp-let2 nil v v @@ -427,6 +434,12 @@ See also `incf'." (gv-define-setter window-hscroll (v &optional w) `(set-window-hscroll ,w ,v)) (gv-define-setter window-point (v &optional w) `(set-window-point ,w ,v)) (gv-define-setter window-start (v &optional w) `(set-window-start ,w ,v)) +(gv-define-setter window-prev-buffers (v &optional w) `(set-window-prev-buffers ,w ,v)) +(gv-define-setter window-next-buffers (v &optional w) `(set-window-next-buffers ,w ,v)) +(gv-define-setter window-new-normal (v &optional w) `(set-window-new-normal ,w ,v)) +(gv-define-simple-setter font-get font-put) +(gv-define-simple-setter charset-plist set-charset-plist) +(gv-define-simple-setter get-charset-property put-charset-property t) (gv-define-setter buffer-local-value (val var buf) (macroexp-let2 nil v val diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index babc0b71524..7433fce2d89 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -913,24 +913,29 @@ for the last released version of the package." (find-file directory))) ;;;###autoload -(defun package-vc-install-from-checkout (dir &optional name) +(defun package-vc-install-from-checkout (dir &optional name interactive) "Install the package NAME from its source directory DIR. -NAME defaults to the base name of DIR. -Interactively, prompt the user for DIR, which should be a directory -under version control, typically one created by `package-vc-checkout'. -If invoked interactively with a prefix argument, prompt the user -for the NAME of the package to set up." - (interactive (let* ((dir (read-directory-name "Directory: ")) - (base (file-name-base (directory-file-name dir)))) +NAME defaults to the base name of DIR. Interactively, prompt the user +for DIR, which should be a directory under version control, typically +one created by `package-vc-checkout'. If invoked interactively with a +prefix argument, prompt the user for the NAME of the package to set up. +If the optional argument INTERACTIVE is non-nil (as happens +interactively), DIR must be an absolute file name." + (interactive (let ((dir (expand-file-name (read-directory-name "Directory: ")))) (list dir (and current-prefix-arg - (read-string - (format-prompt "Package name" base) - nil nil base))))) + (let ((base (file-name-base + (directory-file-name + dir)))) + (read-string + (format-prompt "Package name" base) + nil nil base))) + :interactive))) (package-vc--archives-initialize) - (let* ((name (or name (file-name-base (directory-file-name dir)))) - (pkg-dir (expand-file-name name package-user-dir)) + (let* ((dir (if interactive dir (expand-file-name dir))) ;avoid double expansion + (name (or name (file-name-base (directory-file-name dir)))) + (pkg-dir (file-name-concat package-user-dir name)) (package-vc-selected-packages - (cons (list name :lisp-dir (expand-file-name dir)) + (cons (list name :lisp-dir dir) package-vc-selected-packages))) (when (file-exists-p pkg-dir) (if (yes-or-no-p (format "Overwrite previous checkout for package `%s'?" name)) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 82fcf439a11..ffe0321c594 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3221,6 +3221,105 @@ either a full name or nil, and EMAIL is a valid email address." (defvar package-menu--transaction-status nil "Mode-line status of ongoing package transaction.") +(defconst package-menu-mode-line-format + '((package-menu-mode-line-info + (:eval (symbol-value 'package-menu-mode-line-info))))) + +(defvar-local package-menu-mode-line-info nil + "Variable which stores package-menu mode-line format.") + +(defun package-menu--set-mode-line-format () + "Display package-menu mode-line." + (when-let* ((buf (get-buffer "*Packages*")) + ((buffer-live-p buf))) + (with-current-buffer buf + (setq package-menu-mode-line-info + (let ((installed 0) + (new 0) + (total (length package-archive-contents)) + (to-upgrade (length (package-menu--find-upgrades))) + (total-help "Total number of packages of all package archives") + (installed-help "Total number of packages installed") + (upgrade-help "Total number of packages to upgrade") + (new-help "Total number of packages added recently")) + + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((status (package-menu-get-status))) + (cond + ((member status + '("installed" "dependency" "unsigned")) + (setq installed (1+ installed))) + ((equal status "new") + (setq new (1+ new))))) + (forward-line))) + + (setq installed (number-to-string installed)) + (setq total (number-to-string total)) + (setq to-upgrade (number-to-string to-upgrade)) + + (list + " [" + (propertize "Total: " 'help-echo total-help) + (propertize total + 'help-echo total-help + 'face 'package-mode-line-total) + " / " + (propertize "Installed: " 'help-echo installed-help) + (propertize installed + 'help-echo installed-help + 'face 'package-mode-line-installed) + " / " + (propertize "To Upgrade: " 'help-echo upgrade-help) + (propertize to-upgrade + 'help-echo upgrade-help + 'face 'package-mode-line-to-upgrade) + (when (> new 0) + (concat + " / " + (propertize "New: " 'help-echo new-help) + (propertize (number-to-string new) + 'help-echo new-help + 'face 'package-mode-line-new))) + "] ")))))) +(defvar package-menu--tool-bar-map + (let ((map (make-sparse-keymap))) + (tool-bar-local-item-from-menu + #'package-menu-execute "package-menu/execute" + map package-menu-mode-map) + (define-key-after map [separator-1] menu-bar-separator) + (tool-bar-local-item-from-menu + #'package-menu-mark-unmark "package-menu/unmark" + map package-menu-mode-map) + (tool-bar-local-item-from-menu + #'package-menu-mark-install "package-menu/install" + map package-menu-mode-map) + (tool-bar-local-item-from-menu + #'package-menu-mark-delete "package-menu/delete" + map package-menu-mode-map) + (tool-bar-local-item-from-menu + #'package-menu-describe-package "package-menu/info" + map package-menu-mode-map) + (tool-bar-local-item-from-menu + #'package-browse-url "package-menu/url" + map package-menu-mode-map) + (tool-bar-local-item + "package-menu/upgrade" 'package-upgrade-all + 'package-upgrade-all + map :help "Upgrade all the packages") + (define-key-after map [separator-2] menu-bar-separator) + (tool-bar-local-item + "search" 'isearch-forward 'search map + :help "Search" :vert-only t) + (tool-bar-local-item-from-menu + #'revert-buffer "refresh" + map package-menu-mode-map) + (tool-bar-local-item-from-menu + #'quit-window "close" + map package-menu-mode-map) + map)) + (define-derived-mode package-menu-mode tabulated-list-mode "Package Menu" "Major mode for browsing a list of packages. The most useful commands here are: @@ -3236,6 +3335,11 @@ The most useful commands here are: (setq mode-line-process '((package--downloads-in-progress ":Loading") (package-menu--transaction-status package-menu--transaction-status))) + (setq-local mode-line-misc-info + (append + mode-line-misc-info + package-menu-mode-line-format)) + (setq-local tool-bar-map package-menu--tool-bar-map) (setq tabulated-list-format `[("Package" ,package-name-column-width package-menu--name-predicate) ("Version" ,package-version-column-width package-menu--version-predicate) @@ -3642,6 +3746,40 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." "Face used on the status and version of avail-obso packages." :version "25.1") +(defface package-mark-install-line + '((((class color) (background light)) + :background "darkolivegreen1" :extend t) + (((class color) (background dark)) + :background "seagreen" :extend t) + (t :inherit (highlight) :extend t)) + "Face used for highlighting in package-menu packages marked to be installed." + :version "31.1") + +(defface package-mark-delete-line + '((((class color) (background light)) + :background "rosybrown1" :extend t) + (((class color) (background dark)) + :background "indianred4" :extend t) + (t :inherit (highlight) :extend t)) + "Face used for highlighting in package-menu packages marked to be deleted." + :version "31.1") + +(defface package-mode-line-total nil + "Face for the total number of packages displayed on the mode line." + :version "31.1") + +(defface package-mode-line-installed '((t :inherit package-status-installed)) + "Face for the number of installed packages displayed on the mode line." + :version "31.1") + +(defface package-mode-line-to-upgrade '((t :inherit bold)) + "Face for the number of packages to upgrade displayed on the mode line." + :version "31.1") + +(defface package-mode-line-new '((t :inherit package-status-new)) + "Face for the number of new packages displayed on the mode line." + :version "31.1") + ;;; Package menu printing @@ -3702,6 +3840,20 @@ function. The args ARG and NOCONFIRM, passed from (package-refresh-contents package-menu-async)) (define-obsolete-function-alias 'package-menu-refresh 'revert-buffer "27.1") +(defun package-menu--overlay-line (face) + "Highlight whole line with face FACE." + (let ((ov (make-overlay (line-beginning-position) + (1+ (line-end-position))))) + (overlay-put ov 'pkg-menu-ov t) + (overlay-put ov 'evaporate t) + (overlay-put ov 'face face))) + +(defun package-menu--remove-overlay () + "Remove all overlays done by `package-menu--overlay-line' in current line." + (remove-overlays (line-beginning-position) + (1+ (line-end-position)) + 'pkg-menu-ov t)) + (defun package-menu-hide-package () "Hide in Package Menu packages that match a regexp. Prompt for the regexp to match against package names. @@ -3757,7 +3909,8 @@ The current package is the package at point." (package--ensure-package-menu-mode) (if (member (package-menu-get-status) '("installed" "source" "dependency" "obsolete" "unsigned")) - (tabulated-list-put-tag "D" t) + (progn (package-menu--overlay-line 'package-mark-delete-line) + (tabulated-list-put-tag "D" t)) (forward-line))) (defun package-menu-mark-install (&optional _num) @@ -3766,7 +3919,8 @@ The current package is the package at point." (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency")) - (tabulated-list-put-tag "I" t) + (progn (package-menu--overlay-line 'package-mark-install-line) + (tabulated-list-put-tag "I" t)) (forward-line))) (defun package-menu-mark-unmark (&optional _num) @@ -3774,6 +3928,7 @@ The current package is the package at point." The current package is the package at point." (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) + (package-menu--remove-overlay) (tabulated-list-put-tag " " t)) (defun package-menu-backup-unmark () @@ -3781,6 +3936,7 @@ The current package is the package at point." (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (forward-line -1) + (package-menu--remove-overlay) (tabulated-list-put-tag " ")) (defun package-menu-mark-obsolete-for-deletion () @@ -3791,7 +3947,8 @@ The current package is the package at point." (goto-char (point-min)) (while (not (eobp)) (if (equal (package-menu-get-status) "obsolete") - (tabulated-list-put-tag "D" t) + (progn (package-menu--overlay-line 'package-mark-delete-line) + (tabulated-list-put-tag "D" t)) (forward-line 1))))) (defvar package--quick-help-keys @@ -4225,6 +4382,8 @@ short description." #'package-menu--post-refresh) (add-hook 'package--post-download-archives-hook #'package-menu--mark-or-notify-upgrades 'append) + (add-hook 'package--post-download-archives-hook + #'package-menu--set-mode-line-format 'append) ;; Generate the Package Menu. (let ((buf (get-buffer-create "*Packages*"))) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index c183f442d8d..01dc95e649b 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -71,9 +71,9 @@ Lisp syntax." (const :tag "Emacs<29 algorithm, fast and good enough" pp-28) (const :tag "Work hard for code (slow on large inputs)" pp-emacs-lisp-code) - (const :tag "`pp-emacs-lisp-code' if `pp-use-max-width' else `pp-28'" + (const :tag "Work hard for code if `pp-use-max-width' non-nil, else as in Emacs<29" pp-29) - function) + (function :tag "Custom function")) :version "30.1") (defvar pp--inhibit-function-formatting nil) @@ -123,7 +123,7 @@ and should pretty print it at point into the current buffer." (defun pp-29 (beg-or-sexp &optional end) ;FIXME: Better name? "Prettify the current region with printed representation of a Lisp object. -Uses the pretty-printing algorithm that was standard in Emacs-29, +Uses the pretty-printing algorithm that was standard in Emacs 29, which, depending on `pp-use-max-width', will either use `pp-28' or `pp-emacs-lisp-code'." (if pp-use-max-width @@ -278,7 +278,7 @@ it inserts and pretty-prints that arg at point." (defun pp-28 (beg &optional end) ;FIXME: Better name? "Prettify the current region with printed representation of a Lisp object. -Uses the pretty-printing algorithm that was standard before Emacs-30. +Uses the pretty-printing algorithm that was standard before Emacs 30. Non-interactively can also be called with a single argument, in which case that argument will be inserted pretty-printed at point." (interactive "r") diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 6c77d57a6ba..6f7ef9f5864 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -122,9 +122,22 @@ See also `warning-suppress-log-types'." :version "22.1") (defcustom warning-display-at-bottom t - "Display the warning buffer at the bottom of the screen. -The output window will be scrolled to the bottom of the buffer -to show the last warning message." + "Whether to display the warning buffer at the bottom of the screen. +If this is non-nil (the default), Emacs will attempt to display the +window showing the warning buffer at the bottom of the selected +frame, whether by reusing the bottom-most window or by creating a +new window at the bottom of the frame. The resulting window will be +scrolled to the bottom of the buffer to show the last warning message. + +If the value of this variable is nil, Emacs will display the warning +buffer in some window, as determined by `display-buffer' and its +customizations. In particular, the category designated by the +symbol `warning' can be used in `display-buffer-alist' to customize +the display of this buffer. + +This option affects display of all the buffers shown by `dispay-warning', +including warnings from byte-compiler and native-compiler, +from `check-declare', etc." :type 'boolean :version "30.1") diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index aaf875d5dee..95f5507f33a 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -3867,7 +3867,6 @@ Null string will repeat previous search." (setq viper-use-register nil) (error viper-EmptyRegister reg)) (user-error viper-ViperBell))) - (setq viper-use-register nil) (if (viper-end-with-a-newline-p text) (progn (end-of-line) @@ -3879,6 +3878,7 @@ Null string will repeat previous search." (set-marker (mark-marker) (point) (current-buffer)) (viper-set-destructive-command (list 'viper-put-back val nil viper-use-register nil nil)) + (setq viper-use-register nil) (setq sv-point (point)) (viper-loop val (viper-yank text)) (setq chars-inserted (abs (- (point) sv-point)) @@ -3917,10 +3917,10 @@ Null string will repeat previous search." (setq viper-use-register nil) (error viper-EmptyRegister reg)) (user-error viper-ViperBell))) - (setq viper-use-register nil) (if (viper-end-with-a-newline-p text) (beginning-of-line)) (viper-set-destructive-command (list 'viper-Put-back val nil viper-use-register nil nil)) + (setq viper-use-register nil) (set-marker (mark-marker) (point) (current-buffer)) (setq sv-point (point)) (viper-loop val (viper-yank text)) diff --git a/lisp/expand.el b/lisp/expand.el index 4488714a9d1..f3e8828056d 100644 --- a/lisp/expand.el +++ b/lisp/expand.el @@ -277,12 +277,8 @@ cyclically with the functions `expand-jump-to-previous-slot' and `expand-jump-to-next-slot'. If ARG is omitted, point is placed at the end of the expanded text." - - (if (null abbrevs) - table - (expand-add-abbrev table (nth 0 (car abbrevs)) (nth 1 (car abbrevs)) - (nth 2 (car abbrevs))) - (expand-add-abbrevs table (cdr abbrevs)))) + (mapc (lambda (x) (apply #'expand-add-abbrev table x)) abbrevs) + table) (defvar expand-list nil "Temporary variable used by the Expand package.") @@ -295,8 +291,9 @@ If ARG is omitted, point is placed at the end of the expanded text." (defvar-local expand-point nil "End of the expanded region.") -(defun expand-add-abbrev (table abbrev expansion arg) +(defun expand-add-abbrev (table abbrev expansion arg &rest rest) "Add one abbreviation and provide the hook to move to the specified positions." + (when rest (message "Ignoring extra args for abbrev \"%s\": %S" abbrev rest)) (let* ((string-exp (if (and (symbolp expansion) (fboundp expansion)) nil expansion)) @@ -317,7 +314,7 @@ If ARG is omitted, point is placed at the end of the expanded text." (if (and (symbolp expansion) (fboundp expansion)) expansion nil)) - 'expand-abbrev-hook))) + #'expand-abbrev-hook))) (put 'expand-abbrev-hook 'no-self-insert t) ;;;###autoload @@ -335,19 +332,14 @@ See `expand-add-abbrevs'. Value is non-nil if expansion was done." ?w) (expand-do-expansion)) (progn + (if (listp expand-list) + (setq expand-index 0 + expand-pos (expand-list-to-markers expand-list) + expand-list nil)) ;; expand-point tells us if we have inserted the text ;; ourself or if it is the hook which has done the job. (if expand-point - (progn - (if (vectorp expand-list) - (expand-build-marks expand-point)) - (indent-region p expand-point nil)) - ;; an outside function can set expand-list to a list of - ;; markers in reverse order. - (if (listp expand-list) - (setq expand-index 0 - expand-pos (expand-list-to-markers expand-list) - expand-list nil))) + (indent-region p expand-point nil)) (run-hooks 'expand-expand-hook) t) nil)) @@ -359,12 +351,16 @@ See `expand-add-abbrevs'. Value is non-nil if expansion was done." (text (aref vect 0)) (position (aref vect 1)) (jump-args (aref vect 2)) - (hook (aref vect 3))) + (hook (aref vect 3)) + (startpos (point))) (cond (text (insert text) (setq expand-point (point)))) (if jump-args - (funcall #'expand-build-list (car jump-args) (cdr jump-args))) + (setq expand-list (nreverse + (mapcar (lambda (offset) + (+ startpos -1 offset)) + (cdr jump-args))))) (if position (backward-char position)) (if hook @@ -373,11 +369,8 @@ See `expand-add-abbrevs'. Value is non-nil if expansion was done." (defun expand-abbrev-from-expand (word) "Test if an abbrev has a hook." - (or - (and (intern-soft word local-abbrev-table) - (symbol-function (intern-soft word local-abbrev-table))) - (and (intern-soft word global-abbrev-table) - (symbol-function (intern-soft word global-abbrev-table))))) + (let ((a (abbrev-symbol word))) + (when a (symbol-function a)))) (defun expand-previous-word () "Return the previous word." @@ -415,28 +408,6 @@ This is used only in conjunction with `expand-add-abbrevs'." ;;;###autoload (define-key abbrev-map "p" 'expand-jump-to-previous-slot) ;;;###autoload (define-key abbrev-map "n" 'expand-jump-to-next-slot) -(defun expand-build-list (len l) - "Build a vector of offset positions from the list of positions." - (expand-clear-markers) - (setq expand-list (vconcat l)) - (let ((i 0) - (lenlist (length expand-list))) - (while (< i lenlist) - (aset expand-list i (- len (1- (aref expand-list i)))) - (setq i (1+ i))))) - -(defun expand-build-marks (p) - "Transform the offsets vector into a marker vector." - (if expand-list - (progn - (setq expand-index 0) - (setq expand-pos (make-vector (length expand-list) nil)) - (let ((i (1- (length expand-list)))) - (while (>= i 0) - (aset expand-pos i (copy-marker (- p (aref expand-list i)))) - (setq i (1- i)))) - (setq expand-list nil)))) - (defun expand-clear-markers () "Make the markers point nowhere." (if expand-pos diff --git a/lisp/ffap.el b/lisp/ffap.el index 1c9f0294601..10afcd9514a 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -807,7 +807,9 @@ to extract substrings.") (declare-function project-root "project" (project)) (defun ffap-in-project (name) (when-let* ((project (project-current))) - (file-name-concat (project-root project) name))) + (ffap-file-exists-string + (file-name-concat (project-root project) name) + 'nomodify))) (defun ffap-home (name) (ffap-locate-file name t '("~"))) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 96c2c46d1df..f76330c85c2 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -123,7 +123,9 @@ It is nil or a `file-notify--rename' defstruct where the cookie can be nil.") (defun file-notify--expand-file-name (watch file) "Full file name of FILE reported for WATCH." (directory-file-name - (expand-file-name file (file-notify--watch-directory watch)))) + (if (file-name-absolute-p file) + (concat (file-remote-p (file-notify--watch-directory watch)) file) + (expand-file-name file (file-notify--watch-directory watch))))) (cl-defun file-notify--callback-inotify ((desc actions file &optional file1-or-cookie)) @@ -189,7 +191,7 @@ It is nil or a `file-notify--rename' defstruct where the cookie can be nil.") "Notification callback for file name handlers." (file-notify--handle-event desc - ;; File name handlers use gfilenotify or inotify actions. + ;; File name handlers use gfilenotify, inotify or w32notify actions. (delq nil (mapcar (lambda (action) (cond @@ -205,7 +207,12 @@ It is nil or a `file-notify--rename' defstruct where the cookie can be nil.") ((memq action '(delete delete-self move-self)) 'deleted) ((eq action 'moved-from) 'renamed-from) ((eq action 'moved-to) 'renamed-to) - ((memq action '(ignored unmount)) 'stopped))) + ((memq action '(ignored unmount)) 'stopped) + ;; w32notify actions: + ((eq action 'added) 'created) + ((eq action 'modified) 'changed) + ((eq action 'removed) 'deleted) + ((memq action '(renamed-from renamed-to)) action))) (if (consp actions) actions (list actions)))) file file1-or-cookie)) @@ -237,7 +244,7 @@ It is nil or a `file-notify--rename' defstruct where the cookie can be nil.") (when (file-notify--watch-callback watch) (when file-notify-debug (message - "file-notify-callback %S %S %S %S %S %S %S" + "file-notify--call-handler %S %S %S %S %S %S %S" desc action file file1 watch (file-notify--watch-absolute-filename watch) (file-notify--watch-directory watch))) diff --git a/lisp/files.el b/lisp/files.el index 04a212b9bca..5feaa4567ca 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -8288,10 +8288,14 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'." ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line. ;; We take care of that case later. (forward-line -2) - (when (looking-at "//SUBDIRED//") + ;; We reset case-fold-search here and elsewhere, because + ;; case-insensitive search for strings with uppercase 'I' will fail + ;; in language environments (such as Turkish) where 'I' downcases to + ;; 'ı', not to 'i'. + (when (let ((case-fold-search nil)) (looking-at "//SUBDIRED//")) (delete-region (point) (progn (forward-line 1) (point))) (forward-line -1)) - (if (looking-at "//DIRED//") + (if (let ((case-fold-search nil)) (looking-at "//DIRED//")) (let ((end (line-end-position)) (linebeg (point)) error-lines) @@ -8328,7 +8332,7 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'." ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line ;; and we went one line too far back (see above). (forward-line 1)) - (if (looking-at "//DIRED-OPTIONS//") + (if (let ((case-fold-search nil)) (looking-at "//DIRED-OPTIONS//")) (delete-region (point) (progn (forward-line 1) (point)))))) ;; insert-directory @@ -8470,11 +8474,12 @@ normally equivalent short `-D' option is just passed on to (string-match "--dired\\>" switches) (member "--dired" switches)) (save-excursion - (forward-line -2) - (when (looking-at "//SUBDIRED//") - (forward-line -1)) - (if (looking-at "//DIRED//") - (setq result 0)))) + (let ((case-fold-search nil)) + (forward-line -2) + (when (looking-at "//SUBDIRED//") + (forward-line -1)) + (if (looking-at "//DIRED//") + (setq result 0))))) (when (and (not (eq 0 result)) (eq insert-directory-ls-version 'unknown)) diff --git a/lisp/frame.el b/lisp/frame.el index ec582096110..f07a59c78d2 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -490,8 +490,12 @@ there (in decreasing order of priority)." parms ;; initial-frame-alist and default-frame-alist were already ;; applied in pc-win.el. - (append initial-frame-alist window-system-frame-alist - default-frame-alist parms nil))) + (setq parms (append initial-frame-alist window-system-frame-alist + default-frame-alist parms nil)) + ;; Don't enable tab-bar in daemon's initial frame. + (when (and (daemonp) (not (frame-parameter nil 'client))) + (setq parms (delq (assq 'tab-bar-lines parms) parms))) + parms)) (if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el (let ((newparms (frame-parameters)) (frame (selected-frame))) @@ -1258,6 +1262,9 @@ that variable should be nil." "Display the buffer of the next command in a new frame. The next buffer is the buffer displayed by the next command invoked immediately after this command (ignoring reading from the minibuffer). +In case of multiple consecutive mouse events such as , +a mouse release event , , +all bound commands are handled until one of them displays a buffer. Creates a new frame before displaying the buffer. When `switch-to-buffer-obey-display-actions' is non-nil, `switch-to-buffer' commands are also supported." diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 87acd4dd515..759d19a047e 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -232,6 +232,10 @@ before the external MIME handler is invoked." mm-inline-image ,(lambda (handle) (mm-valid-and-fit-image-p 'pbm handle))) + ("image/svg\\+xml" + mm-inline-image + ,(lambda (handle) + (mm-valid-and-fit-image-p 'svg handle))) ("text/plain" mm-inline-text identity) ("text/enriched" mm-inline-text identity) ("text/richtext" mm-inline-text identity) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 481360b5d3c..9cd30107002 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -632,7 +632,11 @@ the C sources, too." (format-message "`%s'" remapped) "an anonymous command")) (princ "as well.\n")) - (or remapped (princ ".")) + ;; The (= (point) start) condition tests whether + ;; 'help-fns--insert-menu-bindings' inserted anything; + ;; if it didn't, we already have a period from the + ;; previous 'princ' call. + (or remapped (= (point) start) (princ ".")) (fill-region-as-paragraph start (point)))) (ensure-empty-lines))))))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 7f272de790e..a8c0b1da818 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -89,9 +89,9 @@ (when (mouse-posn-property (event-start click) 'mouse-face) (define-key menu [help-mode-push-button] - '(menu-item "Follow Link" (lambda (event) - (interactive "e") - (push-button event)) + `(menu-item "Follow Link" ,(lambda (event) + (interactive "e") + (push-button event)) :help "Follow the link at click"))) menu) diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el index 1b735810ee4..9955c0fb569 100644 --- a/lisp/international/latexenc.el +++ b/lisp/international/latexenc.el @@ -144,24 +144,28 @@ coding system names is determined from `latex-inputenc-coding-alist'." (file-name-directory (nth 1 arg-list)) default-directory)) latexenc-main-file) - ;; Is there a TeX-master or tex-main-file in the local variables - ;; section? + ;; Is there a TeX-master or tex-main-file in the local + ;; variables section or is it globally set to a constant + ;; string? (unless latexenc-dont-use-TeX-master-flag (goto-char (point-max)) (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) - (search-forward "Local Variables:" nil t) - (when (re-search-forward - "^%+ *\\(TeX-master\\|tex-main-file\\): *\"\\(.+\\)\"" - nil t) - (let ((file (match-string 2))) - (dolist (ext `("" ,(if (boundp 'TeX-default-extension) - (concat "." TeX-default-extension) - "") - ".tex" ".ltx" ".dtx" ".drv")) - (if (and (null latexenc-main-file) ;Stop at first. - (file-exists-p (concat file ext))) - (setq latexenc-main-file (concat file ext))))))) + (re-search-forward "^%+ *Local Variables:" nil t) + (let ((file (if (re-search-forward + "^%+ *\\(TeX-master\\|tex-main-file\\): *\"\\(.+\\)\"" + nil t) + (match-string 2) + (or (and (bound-and-true-p TeX-master) + (stringp TeX-master)) + (bound-and-true-p tex-main-file))))) + (dolist (ext `("" ,(if (boundp 'TeX-default-extension) + (concat "." TeX-default-extension) + "") + ".tex" ".ltx" ".dtx" ".drv")) + (if (and (null latexenc-main-file) ;Stop at first. + (file-exists-p (concat file ext))) + (setq latexenc-main-file (concat file ext)))))) ;; try tex-modes tex-guess-main-file (when (and (not latexenc-dont-use-tex-guess-main-file-flag) (not latexenc-main-file)) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 709e12176d4..8d275b37172 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -2023,6 +2023,9 @@ Accepts keyword arguments: same behavior as if no special keyword had been used (that is, the command is bound, and it's `repeat-map' property set) +:continue-only BINDINGS - Within the scope of `:repeat-map', will make + the command continue but not enter the repeat + map, via the `repeat-continue' property :filter FORM - optional form to determine when bindings apply The rest of the arguments are conses of keybinding string and a @@ -4919,7 +4922,17 @@ directory (the last entry in `native-comp-eln-load-path') unless `native-compile-target-directory' is non-nil. If the environment variable \"NATIVE_DISABLED\" is set, only byte compile.") (autoload 'native-compile-prune-cache "comp" "\ -Remove .eln files that aren't applicable to the current Emacs invocation." t) +Remove *.eln files that aren't usable by the current Emacs build. + +This command removes all the *.eln files in `native-comp-eln-load-path' +which are incompatible with the Emacs session in which you invoke this +command. This includes the *.eln files compiled by all the Emacs +sessions where `comp-native-version-dir' had a value different from the +current session. + +Note that this command does not prune the *.eln files in the last +directory in `native-comp-eln-load-path', which holds *.eln files +compiled during the Emacs build process." t) (register-definition-prefixes "comp" '("comp-" "native-comp" "no-native-compile")) @@ -5221,6 +5234,8 @@ evaluate the variable `compilation-shell-minor-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. +\\{compilation-shell-minor-mode-map} + (fn &optional ARG)" t) (autoload 'compilation-minor-mode "compile" "\ Toggle Compilation minor mode. @@ -5243,6 +5258,8 @@ evaluate the variable `compilation-minor-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. +\\{compilation-minor-mode-map} + (fn &optional ARG)" t) (autoload 'compilation-next-error-function "compile" "\ Advance to the next error message and visit the file where the error was. @@ -6100,8 +6117,9 @@ Handle the `cursor-sensor-functions' text property. This property should hold a list of functions which react to the motion of the cursor. They're called with three arguments (WINDOW OLDPOS DIR) where WINDOW is the affected window, OLDPOS is the last known position of -the cursor and DIR can be `entered' or `left' depending on whether the cursor -is entering the area covered by the text-property property or leaving it. +the cursor and DIR can be `entered', `left', or `moved' depending on whether +the cursor is entering the area covered by the text-property property, +leaving it, or just moving inside of it. This is a minor mode. If called interactively, toggle the `Cursor-Sensor mode' mode. If the prefix argument is positive, enable @@ -6436,6 +6454,11 @@ that FILENAME specifies. (fn &optional FILENAME)" t) (register-definition-prefixes "cus-edit" '("Custom-" "cus" "widget-")) + +;;; Generated autoloads from cus-start.el + +(register-definition-prefixes "cus-start" '("minibuffer-prompt-properties--setter")) + ;;; Generated autoloads from cus-theme.el @@ -7937,7 +7960,7 @@ Describe the display table DT in a help buffer. (autoload 'describe-current-display-table "disp-table" "\ Describe the display table in use in the selected window and buffer." t) (autoload 'standard-display-unicode-special-glyphs "disp-table" "\ -Display some glyps using Unicode characters. +Display some glyphs using Unicode characters. The glyphs being changed by this function are `vertical-border', `box-vertical',`box-horizontal', `box-down-right', `box-down-left', `box-up-right', `box-up-left',`box-double-vertical', @@ -8906,7 +8929,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. @@ -9842,15 +9865,15 @@ either customize it (see the info node `Easy Customization') or call the function `electric-pair-mode'.") (custom-autoload 'electric-pair-mode "elec-pair" nil) (autoload 'electric-pair-mode "elec-pair" "\ -Toggle automatic parens pairing (Electric Pair mode). +Toggle automatic pairing of delimiters (Electric Pair mode). -Electric Pair mode is a global minor mode. When enabled, typing -an open parenthesis automatically inserts the corresponding -closing parenthesis, and vice versa. (Likewise for brackets, etc.). -If the region is active, the parentheses (brackets, etc.) are -inserted around the region instead. +Electric Pair mode is a global minor mode. When enabled, typing an +opening delimiter (parenthesis, bracket, etc.) automatically inserts the +corresponding closing delimiter. If the region is active, the +delimiters are inserted around the region instead. -To toggle the mode in a single buffer, use `electric-pair-local-mode'. +To toggle the mode only in the current buffer, use +`electric-pair-local-mode'. This is a global minor mode. If called interactively, toggle the `Electric-Pair mode' mode. If the prefix argument is positive, enable @@ -10698,7 +10721,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. @@ -10721,7 +10744,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. @@ -10953,7 +10976,9 @@ it has to be wrapped in `(eval (quote ...))'. If NAME is already defined as a test and Emacs is running in batch mode, an error is signaled. -(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] BODY...)" nil 'macro) +(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] BODY...)" nil t) +(function-put 'ert-deftest 'doc-string-elt 3) +(function-put 'ert-deftest 'lisp-indent-function 2) (autoload 'ert-run-tests-batch "ert" "\ Run the tests specified by SELECTOR, printing results to the terminal. @@ -11688,7 +11713,8 @@ non-nil, collect results from all servers. (fn &optional SAVE-QUERY-AS-KILL TRY-ALL-SERVERS)" t) (autoload 'eudc-format-inline-expansion-result "eudc" "\ -Format a query result according to `eudc-inline-expansion-format'. +Format a query result RES according to `eudc-inline-expansion-format'. +QUERY-ATTRS is a list of attributes to include in the expansion. (fn RES QUERY-ATTRS)") (autoload 'eudc-query-with-words "eudc" "\ @@ -11930,8 +11956,6 @@ for the search engine used." t) (autoload 'eww-mode "eww" "\ Mode for browsing the web. -\\{eww-mode-map} - (fn)" t) (autoload 'eww-browse-url "eww" "\ Ask the EWW browser to load URL. @@ -12629,10 +12653,16 @@ For adding local variables on the first line of a file, for example for settings like `lexical-binding, which must be specified there, use the `add-file-local-variable-prop-line' command instead. +If optional variable INTERACTIVE is non-nil, display a message telling +the user how to make the new value take effect. + (fn VARIABLE VALUE &optional INTERACTIVE)" t) (autoload 'delete-file-local-variable "files-x" "\ Delete all settings of file-local VARIABLE from the Local Variables list. +If optional variable INTERACTIVE is non-nil, display a message telling +the user how to make the new value take effect. + (fn VARIABLE &optional INTERACTIVE)" t) (autoload 'add-file-local-variable-prop-line "files-x" "\ Add file-local VARIABLE with its VALUE to the -*- line. @@ -12647,10 +12677,16 @@ then this function adds it. To add variables to the Local Variables list at the end of the file, use the `add-file-local-variable' command instead. +If optional variable INTERACTIVE is non-nil, display a message telling +the user how to make the new value take effect. + (fn VARIABLE VALUE &optional INTERACTIVE)" t) (autoload 'delete-file-local-variable-prop-line "files-x" "\ Delete all settings of file-local VARIABLE from the -*- line. +If optional variable INTERACTIVE is non-nil, display a message telling +the user how to make the new value take effect. + (fn VARIABLE &optional INTERACTIVE)" t) (autoload 'add-dir-local-variable "files-x" "\ Add directory-local VARIABLE with its VALUE and MODE to .dir-locals.el. @@ -13058,7 +13094,7 @@ is non-nil, signal an error instead. (fn FUNCTION &optional LISP-ONLY)") (autoload 'find-function "find-func" "\ -Find the definition of the FUNCTION near point. +Find the definition of the Emacs Lisp FUNCTION near point. Finds the source file containing the definition of the function near point (selected by `function-called-at-point') in a buffer and @@ -13067,6 +13103,9 @@ Set mark before moving, if the buffer already existed. See also `find-function-recenter-line' and `find-function-after-hook'. +Use \\[xref-find-definitions] to find definitions of functions and variables +that are not part of Emacs. + (fn FUNCTION)" t) (autoload 'find-function-other-window "find-func" "\ Find, in another window, the definition of FUNCTION near point. @@ -13256,7 +13295,7 @@ lines. ;;; Generated autoloads from progmodes/flymake.el -(push '(flymake 1 3 7) package--builtin-versions) +(push '(flymake 1 4 1) package--builtin-versions) (autoload 'flymake-log "flymake" "\ Log, at level LEVEL, the message MSG formatted with ARGS. LEVEL is passed to `display-warning', which is used to display @@ -13269,24 +13308,29 @@ generated it. Make a Flymake diagnostic for LOCUS's region from BEG to END. LOCUS is a buffer object or a string designating a file name. -TYPE is a diagnostic symbol and TEXT is string describing the -problem detected in this region. DATA is any object that the -caller wishes to attach to the created diagnostic for later -retrieval with `flymake-diagnostic-data'. +TYPE is a diagnostic symbol (see Info Node `(Flymake)Flymake error +types') -If LOCUS is a buffer BEG and END should be buffer positions -inside it. If LOCUS designates a file, BEG and END should be a -cons (LINE . COL) indicating a file position. In this second -case, END may be omitted in which case the region is computed -using `flymake-diag-region' if the diagnostic is appended to an -actual buffer. +INFO is a description of the problem detected. It may be a string, or +list (ORIGIN CODE MESSAGE) appropriately categorizing and describing the +diagnostic. ORIGIN may be a string or nil. CODE maybe be a string, a +number or nil. MESSAGE must be a string. -OVERLAY-PROPERTIES is an alist of properties attached to the -created diagnostic, overriding the default properties and any -properties listed in the `flymake-overlay-control' property of -the diagnostic's type symbol. +DATA is any object that the caller wishes to attach to the created +diagnostic for later retrieval with `flymake-diagnostic-data'. -(fn LOCUS BEG END TYPE TEXT &optional DATA OVERLAY-PROPERTIES)") +If LOCUS is a buffer, BEG and END should be buffer positions inside it. +If LOCUS designates a file, BEG and END should be a cons (LINE . COL) +indicating a file position. In this second case, END may be omitted in +which case the region is computed using `flymake-diag-region' if the +diagnostic is appended to an actual buffer. + +OVERLAY-PROPERTIES is an alist of properties attached to the created +diagnostic, overriding the default properties and any properties listed +in the `flymake-overlay-control' property of the diagnostic's type +symbol. + +(fn LOCUS BEG END TYPE INFO &optional DATA OVERLAY-PROPERTIES)") (autoload 'flymake-diagnostics "flymake" "\ Get Flymake diagnostics in region determined by BEG and END. @@ -13355,6 +13399,8 @@ evaluate the variable `flymake-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. +\\{flymake-mode-map} + (fn &optional ARG)" t) (autoload 'flymake-mode-on "flymake" "\ Turn Flymake mode on.") @@ -17056,7 +17102,8 @@ inlined into the compiled format versions. This means that if you change its definition, you should explicitly call `ibuffer-recompile-formats'. -(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil 'macro) +(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil t) +(function-put 'define-ibuffer-column 'lisp-indent-function 'defun) (autoload 'define-ibuffer-sorter "ibuf-macs" "\ Define a method of sorting named NAME. DOCUMENTATION is the documentation of the function, which will be called @@ -17067,7 +17114,9 @@ For sorting, the forms in BODY will be evaluated with `a' bound to one buffer object, and `b' bound to another. BODY should return a non-nil value if and only if `a' is \"less than\" `b'. -(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil 'macro) +(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil t) +(function-put 'define-ibuffer-sorter 'lisp-indent-function 1) +(function-put 'define-ibuffer-sorter 'doc-string-elt 2) (autoload 'define-ibuffer-op "ibuf-macs" "\ Generate a function which operates on a buffer. OP becomes the name of the function; if it doesn't begin with @@ -17110,7 +17159,9 @@ BODY define the operation; they are forms to evaluate per each marked buffer. BODY is evaluated with `buf' bound to the buffer object. -(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil 'macro) +(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil t) +(function-put 'define-ibuffer-op 'lisp-indent-function 2) +(function-put 'define-ibuffer-op 'doc-string-elt 3) (autoload 'define-ibuffer-filter "ibuf-macs" "\ Define a filter named NAME. DOCUMENTATION is the documentation of the function. @@ -17125,7 +17176,9 @@ not a particular buffer should be displayed or not. The forms in BODY will be evaluated with BUF bound to the buffer object, and QUALIFIER bound to the current value of the filter. -(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil 'macro) +(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil t) +(function-put 'define-ibuffer-filter 'lisp-indent-function 2) +(function-put 'define-ibuffer-filter 'doc-string-elt 2) (register-definition-prefixes "ibuf-macs" '("ibuffer-")) @@ -20116,7 +20169,8 @@ A major mode to edit m4 macro files. (defalias 'name-last-kbd-macro #'kmacro-name-last-macro) (autoload 'insert-kbd-macro "macros" "\ Insert in buffer the definition of kbd macro MACRONAME, as Lisp code. -MACRONAME should be a symbol. +MACRONAME should be a symbol; if none is given, the function inserts +the definition of `last-kdb-macro'. Optional second arg KEYS means also record the keys it is on (this is the prefix argument, when calling interactively). @@ -24176,7 +24230,8 @@ info node `(elisp)Packaging'). Specially, if current buffer is a directory, the -pkg.el description file is not mandatory, in which case the information -is derived from the main .el file in the directory. +is derived from the main .el file in the directory. Using Dired, +you can restrict what files to install by marking specific files. Downloads and installs required packages as needed." t) (autoload 'package-install-file "package" "\ @@ -24325,13 +24380,14 @@ for the last released version of the package. (fn PKG-DESC DIRECTORY &optional REV)" t) (autoload 'package-vc-install-from-checkout "package-vc" "\ Install the package NAME from its source directory DIR. -NAME defaults to the base name of DIR. -Interactively, prompt the user for DIR, which should be a directory -under version control, typically one created by `package-vc-checkout'. -If invoked interactively with a prefix argument, prompt the user -for the NAME of the package to set up. +NAME defaults to the base name of DIR. Interactively, prompt the user +for DIR, which should be a directory under version control, typically +one created by `package-vc-checkout'. If invoked interactively with a +prefix argument, prompt the user for the NAME of the package to set up. +If the optional argument INTERACTIVE is non-nil (as happens +interactively), DIR must be an absolute file name. -(fn DIR &optional NAME)" t) +(fn DIR &optional NAME INTERACTIVE)" t) (autoload 'package-vc-rebuild "package-vc" "\ Rebuild the installation for package given by PKG-DESC. Rebuilding an installation means scraping for new autoload @@ -26199,7 +26255,7 @@ If project PR satisfies `project-list-exclude', then nothing is done. Save the result in `project-list-file' if the list of projects has changed, and NO-WRITE is nil. -(fn PR &optional NO-WRITE)") +(fn PR &optional NO-WRITE)" t) (autoload 'project-forget-project "project" "\ Remove directory PROJECT-ROOT from the project list. PROJECT-ROOT is the root directory of a known project listed in @@ -26519,7 +26575,7 @@ If EXTENSION is any other symbol, it is ignored. (register-definition-prefixes "ps-samp" '("ps-")) -;;; Generated autoloads from cedet/pulse.el +;;; Generated autoloads from pulse.el (push '(pulse 1 0) package--builtin-versions) (autoload 'pulse-momentary-highlight-one-line "pulse" "\ @@ -26962,7 +27018,7 @@ Prompt for FILE in `recentf-list' and visit it. Enable `recentf-mode' if it isn't already. (fn FILE)" t) -(defalias 'recentf 'recentf-open) +(defalias 'recentf #'recentf-open) (defvar recentf-mode nil "\ Non-nil if Recentf mode is enabled. See the `recentf-mode' command @@ -27148,6 +27204,8 @@ evaluate the variable `rectangle-mark-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. +\\{rectangle-mark-mode-map} + (fn &optional ARG)" t) (register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-")) @@ -27465,9 +27523,18 @@ Toggle Repeat mode. When Repeat mode is enabled, certain commands bound to multi-key sequences can be repeated by typing a single key, after typing the full key sequence once. -The commands which can be repeated like that are those whose symbol - has the property `repeat-map' which specifies a keymap of single -keys for repeating. + +The commands that can be repeated in this way are those whose symbols +have the `repeat-map' property, which specifies a keymap of single keys +for repeating. + +Normally, invoking a command outside that keymap terminates the +repeating sequence. However, if the command's `repeat-continue' +property is non-nil, it may instead continue the current repeating +sequence: if the property is a list of keymaps, then the command +continues when the current repeat map is in the list; if the property is +t, the command always continues the sequence. + See `describe-repeat-maps' for a list of all repeatable commands. This is a global minor mode. If called interactively, toggle the @@ -27651,6 +27718,17 @@ Make a ring that can contain SIZE elements. (fn SIZE)") (register-definition-prefixes "ring" '("ring-")) + +;;; Generated autoloads from ring-bell-fns.el + +(autoload 'flash-face-bell-function "ring-bell-fns" "\ +Indicate ringing the bell by flashing some faces. +Intended to be used in `ring-bell-function'.") +(autoload 'flash-echo-area-bell-function "ring-bell-fns" "\ +Indicate ringing the bell by flashing the echo area. +Intended to be used in `ring-bell-function'.") +(register-definition-prefixes "ring-bell-fns" '("flash-face-")) + ;;; Generated autoloads from mail/rmail.el @@ -31085,29 +31163,32 @@ Major-mode for writing SRecode macros. (autoload 'string-edit "string-edit" "\ Switch to a new buffer to edit STRING. -When the user finishes editing (with \\\\[string-edit-done]), SUCCESS-CALLBACK -is called with the resulting string. -If the user aborts (with \\\\[string-edit-abort]), ABORT-CALLBACK (if any) is -called with no parameters. +Call MAJOR-MODE-SYM (defaulting to `string-edit-mode') to set up the new +buffer, and insert PROMPT (defaulting to nothing) at the start of the +buffer. -PROMPT will be inserted at the start of the buffer, but won't be -included in the resulting string. If PROMPT is nil, no help text -will be inserted. +When the user finishes editing (with \\\\[string-edit-done]), call +READ (defaulting to `identity') on the resulting string, omitting PROMPT if any. + +If READ returns without an error, quit the buffer and call +SUCCESS-CALLBACK on the result. + +If the user aborts (with \\\\[string-edit-abort]), +call ABORT-CALLBACK (if any) with no parameters. Also see `read-string-from-buffer'. -(fn PROMPT STRING SUCCESS-CALLBACK &key ABORT-CALLBACK)") +(fn PROMPT STRING SUCCESS-CALLBACK &key ABORT-CALLBACK MAJOR-MODE-SYM READ)") (autoload 'read-string-from-buffer "string-edit" "\ Switch to a new buffer to edit STRING in a recursive edit. The user finishes editing with \\\\[string-edit-done], or aborts with \\\\[string-edit-abort]). -PROMPT will be inserted at the start of the buffer, but won't be -included in the resulting string. If nil, no prompt will be -inserted in the buffer. +Insert PROMPT at the start of the buffer. If nil, no prompt is +inserted. -When the user exits recursive edit, this function returns the -edited STRING. +When the user exits recursive edit, return the contents of the +buffer (without including PROMPT). Also see `string-edit'. @@ -31354,19 +31435,29 @@ indivisible unit. (fn STRING)") (function-put 'string-glyph-split 'side-effect-free 't) (autoload 'add-display-text-property "subr-x" "\ -Add display property PROP with VALUE to the text from START to END. -If any text in the region has a non-nil `display' property, those -properties are retained. +Add the display specification (SPEC VALUE) to the text from START to END. +If any text in the region has a non-nil `display' property, the existing +display specifications are retained. -If OBJECT is non-nil, it should be a string or a buffer. If nil, -this defaults to the current buffer. +OBJECT is either a string or a buffer to add the specification to. +If omitted, OBJECT defaults to the current buffer. -(fn START END PROP VALUE &optional OBJECT)") +(fn START END SPEC VALUE &optional OBJECT)") +(autoload 'remove-display-text-property "subr-x" "\ +Remove the display specification SPEC from the text from START to END. +SPEC is the car of the display specification to remove, e.g. `height'. +If any text in the region has other display specifications, those specs +are retained. + +OBJECT is either a string or a buffer to remove the specification from. +If omitted, OBJECT defaults to the current buffer. + +(fn START END SPEC &optional OBJECT)") (autoload 'read-process-name "subr-x" "\ Query the user for a process and return the process object. (fn PROMPT)") -(register-definition-prefixes "subr-x" '("emacs-etc--hide-local-variables" "hash-table-" "internal--thread-argument" "string-remove-" "thread-" "with-buffer-unmodified-if-unchanged" "work-buffer-")) +(register-definition-prefixes "subr-x" '("add-remove--display-text-property" "emacs-etc--hide-local-variables" "hash-table-" "internal--thread-argument" "string-remove-" "thread-" "with-buffer-unmodified-if-unchanged" "work-buffer-")) ;;; Generated autoloads from progmodes/subword.el @@ -33831,7 +33922,7 @@ Unload Tramp file name handlers from `file-name-handler-alist'." (dolist (fnh fi Deactivate remote file names." (interactive) (when (fboundp 'tramp-cleanup-all-connections) (funcall 'tramp-cleanup-all-connections)) (tramp-unload-file-name-handlers) (setq tramp-mode nil)) (defmacro without-remote-files (&rest body) "\ Deactivate remote file names temporarily. -Run BODY." (declare (indent 0) (debug ((form body) body))) `(let ((file-name-handler-alist (copy-tree file-name-handler-alist)) tramp-mode) (tramp-unload-file-name-handlers) ,@body)) +Run BODY." (declare (indent 0) (debug t)) `(let ((file-name-handler-alist (copy-tree file-name-handler-alist)) tramp-mode) (tramp-unload-file-name-handlers) ,@body)) (defun tramp-unload-tramp nil "\ Discard Tramp from loading remote files." (interactive) (ignore-errors (unload-feature 'tramp 'force))) (register-definition-prefixes "tramp" '("tramp-" "with-")) @@ -33967,13 +34058,13 @@ Interactively, with a prefix argument, prompt for a different method." t) ;;; Generated autoloads from net/trampver.el -(push '(tramp 2 8 0 -1) package--builtin-versions) +(push '(tramp 2 8 0) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) ;;; Generated autoloads from transient.el -(push '(transient 0 8 6) package--builtin-versions) +(push '(transient 0 9 3) package--builtin-versions) (autoload 'transient-insert-suffix "transient" "\ Insert a SUFFIX into PREFIX before LOC. PREFIX is a prefix command, a symbol. @@ -34018,6 +34109,13 @@ See info node `(transient)Modifying Existing Transients'. (fn PREFIX LOC SUFFIX)") (function-put 'transient-replace-suffix 'lisp-indent-function 'defun) +(autoload 'transient-inline-group "transient" "\ +Inline the included GROUP into PREFIX. +Replace the symbol GROUP with its expanded layout in the +layout of PREFIX. + +(fn PREFIX GROUP)") +(function-put 'transient-inline-group 'lisp-indent-function 'defun) (autoload 'transient-remove-suffix "transient" "\ Remove the suffix or group at LOC in PREFIX. PREFIX is a prefix command, a symbol. @@ -34062,6 +34160,56 @@ nil, the grammar is installed to the standard location, the (fn LANG &optional OUT-DIR)" t) (register-definition-prefixes "treesit" '("treesit-")) + +;;; Generated autoloads from treesit-x.el + +(autoload 'define-treesit-generic-mode "treesit-x" "\ +Create a new treesit generic mode MODE. + +A \"treesit\" mode is a simple major mode with basic support for +Font Lock mode, but otherwise does not have any special keystrokes +or functionality available. + +MODE is the name of the command for the treesit generic mode; don't +quote it. The optional DOCSTRING is the documentation for the mode +command. If you do not supply it, `define-treesit-generic-mode' +uses a default documentation string instead. + +KEYWORD-ARGS are optional arguments in the form of pairs of keyword +and value. The following keyword arguments are currently supported: + + :lang is a language symbol of the corresponding tree-sitter grammar. + + :source is either a string for the URL or a list in the same format + as for elements in `treesit-language-source-alist', i.e. + (URL REVISION SOURCE-DIR CC C++ COMMIT). + + :auto-mode is a regular expression or a list of regular expressions + to add to `auto-mode-alist'. These regular expressions are added + when Emacs runs the macro expansion. + + :parent is the name of the command for the parent mode. + + :name is a string that will appear in the mode line. + +BODY are forms to execute just before running the +hooks for the new mode. Do not use `interactive' here. +These forms do some additional setup. The mode command calls +these functions just before it runs `treesit-major-mode-setup' +and the mode hook `MODE-hook'. + +See at the bottom of the file treesit-x.el for some examples +of `define-treesit-generic-mode'. + +(fn MODE [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)" nil t) +(function-put 'define-treesit-generic-mode 'doc-string-elt 2) +(function-put 'define-treesit-generic-mode 'lisp-indent-function 'defun) +(autoload 'treesit-generic-mode-setup "treesit-x" "\ +Go into the treesit generic mode MODE. + +(fn LANG)") +(register-definition-prefixes "treesit-x" '("alpinejs-generic-ts-" "gitattributes-generic-ts-mode" "liquid-generic-ts-mode" "treesit-generic-mode-font-lock-")) + ;;; Generated autoloads from tty-tip.el @@ -35159,7 +35307,7 @@ Usage: :custom Call `Custom-set' or `set-default' with each variable definition without modifying the Emacs `custom-file'. (compare with `custom-set-variables'). -:custom-face Call `custom-set-faces' with each face definition. +:custom-face Call `face-spec-set' with each face definition. :ensure Loads the package using package.el if necessary. :pin Pin the package to an archive. :vc Install the package directly from a version control system @@ -35377,9 +35525,8 @@ responsible for the given file. (autoload 'vc-next-action "vc" "\ Do the next logical version control operation on the current fileset. This requires that all files in the current VC fileset be in the -same state. If they are not, signal an error. Also signal an error if -files in the fileset are missing (removed, but tracked by version control), -or are ignored by the version control system. +sufficiently similar states. If they are not, signal an error. +Also signal an error if files in the fileset are ignored by the VCS. For modern merging-based version control systems: If every file in the fileset is not registered for version @@ -35468,16 +35615,34 @@ Normally this compares the currently selected fileset with their working revisions. With a prefix argument HISTORIC, it reads two revision designators specifying which revisions to compare. -The optional argument NOT-URGENT non-nil means it is ok to say no to -saving the buffer. The optional argument FILESET can override the -deduced fileset. +Optional argument NOT-ESSENTIAL non-nil means it is okay to say no to +saving the buffer. +Optional argument FILESET, if non-nil, overrides the fileset. -(fn &optional HISTORIC NOT-URGENT FILESET)" t) +(fn &optional HISTORIC NOT-ESSENTIAL FILESET)" t) (autoload 'vc-diff-mergebase "vc" "\ Report diffs between the merge base of REV1 and REV2 revisions. The merge base is a common ancestor between REV1 and REV2 revisions. (fn FILES REV1 REV2)" t) +(autoload 'vc-root-diff-incoming "vc" "\ +Report diff of all changes that would be pulled from REMOTE-LOCATION. +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. + +(fn &optional REMOTE-LOCATION)" t) +(autoload 'vc-root-diff-outgoing "vc" "\ +Report diff of all changes that would be pushed to REMOTE-LOCATION. +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. + +(fn &optional REMOTE-LOCATION)" t) (autoload 'vc-version-ediff "vc" "\ Show differences between REV1 and REV2 of FILES using ediff. This compares two revisions of the files in FILES. Currently, @@ -35495,10 +35660,10 @@ Normally this compares the currently selected fileset with their working revisions. With a prefix argument HISTORIC, it reads two revision designators specifying which revisions to compare. -The optional argument NOT-URGENT non-nil means it is ok to say no to +Optional argument NOT-ESSENTIAL non-nil means it is okay to say no to saving the buffer. -(fn HISTORIC &optional NOT-URGENT)" t) +(fn HISTORIC &optional NOT-ESSENTIAL)" t) (autoload 'vc-root-diff "vc" "\ Display diffs between VC-controlled whole tree revisions. Normally, this compares the tree corresponding to the current @@ -35506,10 +35671,10 @@ fileset with the working revision. With a prefix argument HISTORIC, prompt for two revision designators specifying which revisions to compare. -The optional argument NOT-URGENT non-nil means it is ok to say no to +Optional argument NOT-ESSENTIAL non-nil means it is okay to say no to saving the buffer. -(fn HISTORIC &optional NOT-URGENT)" t) +(fn HISTORIC &optional NOT-ESSENTIAL)" t) (autoload 'vc-root-dir "vc" "\ Return the root directory for the current VC tree. Return nil if the root directory cannot be identified.") @@ -35743,10 +35908,12 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. (fn FILE NEW-BACKEND)") (autoload 'vc-delete-file "vc" "\ Delete file and mark it as such in the version control system. -If called interactively, read FILE, defaulting to the current +If called interactively, read FILE-OR-FILES, defaulting to the current buffer's file name if it's under version control. +When called from Lisp, FILE-OR-FILES can be a file name or a list of +file names. -(fn FILE)" t) +(fn FILE-OR-FILES)" t) (autoload 'vc-rename-file "vc" "\ Rename file OLD to NEW in both work area and repository. If called interactively, read OLD and NEW, defaulting OLD to the @@ -35812,7 +35979,7 @@ age, and everything that is older than that is shown in blue. If MOVE-POINT-TO is given, move the point to that line. -If VC-BK is given used that VC backend. +If BACKEND is given, use that VC backend. Customization variables: @@ -35823,7 +35990,7 @@ mode-specific menu. `vc-annotate-color-map' and `vc-annotate-background-mode' specifies whether the color map should be applied to the background or to the foreground. -(fn FILE REV &optional DISPLAY-MODE BUF MOVE-POINT-TO VC-BK)" t) +(fn FILE REV &optional DISPLAY-MODE BUF MOVE-POINT-TO BACKEND)" t) (register-definition-prefixes "vc-annotate" '("vc-")) @@ -35851,11 +36018,6 @@ Name of the format file in a .bzr directory.") (vc-cvs-registered f))) (register-definition-prefixes "vc-cvs" '("vc-cvs-")) - -;;; Generated autoloads from vc/vc-dav.el - -(register-definition-prefixes "vc-dav" '("vc-dav-")) - ;;; Generated autoloads from vc/vc-dir.el @@ -38822,75 +38984,6 @@ run a specific program. The program must be a member of (fn &optional PGM)" t) (register-definition-prefixes "zone" '("zone-")) - - -;;; Generated autoloads from pulse.el - -(push '(pulse 1 0) package--builtin-versions) -(autoload 'pulse-momentary-highlight-one-line "pulse" "\ -Highlight the line around POINT, unhighlighting before next command. -If POINT is nil or missing, the current point is used instead. - -Optional argument FACE specifies the face to do the highlighting. - -(fn &optional POINT FACE)") -(autoload 'pulse-momentary-highlight-region "pulse" "\ -Highlight between START and END, unhighlighting before next command. -Optional argument FACE specifies the face to do the highlighting. - -(fn START END &optional FACE)") -(register-definition-prefixes "pulse" '("pulse-")) - - -;;; Generated autoloads from treesit-x.el - -(autoload 'define-treesit-generic-mode "treesit-x" "\ -Create a new treesit generic mode MODE. - -A \"treesit\" mode is a simple major mode with basic support for -Font Lock mode, but otherwise does not have any special keystrokes -or functionality available. - -MODE is the name of the command for the treesit generic mode; don't -quote it. The optional DOCSTRING is the documentation for the mode -command. If you do not supply it, `define-treesit-generic-mode' -uses a default documentation string instead. - -KEYWORD-ARGS are optional arguments in the form of pairs of keyword -and value. The following keyword arguments are currently supported: - - :lang is a language symbol of the corresponding tree-sitter grammar. - - :source is either a string for the URL or a list in the same format - as for elements in `treesit-language-source-alist', i.e. - (URL REVISION SOURCE-DIR CC C++ COMMIT). - - :auto-mode is a regular expression or a list of regular expressions - to add to `auto-mode-alist'. These regular expressions are added - when Emacs runs the macro expansion. - - :parent is the name of the command for the parent mode. - - :name is a string that will appear in the mode line. - -BODY are forms to execute just before running the -hooks for the new mode. Do not use `interactive' here. -These forms do some additional setup. The mode command calls -these functions just before it runs `treesit-major-mode-setup' -and the mode hook `MODE-hook'. - -See at the bottom of the file treesit-x.el for some examples -of `define-treesit-generic-mode'. - -(fn MODE [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)" nil t) -(function-put 'define-treesit-generic-mode 'doc-string-elt 2) -(function-put 'define-treesit-generic-mode 'lisp-indent-function 'defun) -(autoload 'treesit-generic-mode-setup "treesit-x" "\ -Go into the treesit generic mode MODE. - -(fn LANG SOURCE)") -(register-definition-prefixes "treesit-x" '("alpinejs-generic-ts-" "gitattributes-generic-ts-mode" "liquid-generic-ts-mode" "treesit-generic-mode-font-lock-")) - ;;; End of scraped data diff --git a/lisp/loadup.el b/lisp/loadup.el index 6748c0a0750..18f09878f98 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -392,7 +392,8 @@ (compiled-function-p (symbol-function 'macroexpand-all))) (setq internal-make-interpreted-closure-function #'cconv-make-interpreted-closure)) -(load "cus-start") ;Late to reduce customize-rogue (needs loaddefs.el anyway) +(dlet ((cus-start--preload t)) ;; Tell `cus-start' we're preloading. + (load "cus-start")) ;Late to reduce customize-rogue (needs loaddefs.el anyway) (load "tooltip") (load "international/iso-transl") ; Binds Alt-[ and friends. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index ad6f1b7a58b..5ffb86e68b6 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -424,6 +424,20 @@ copy text to your preferred mail program.\n" system-configuration-options "'\n\n") (fill-region (line-beginning-position -1) (point)))) +(defun report-emacs-bug-check-org () + "Warn the user if the bug report mentions org-mode." + (unless report-emacs-bug-no-confirmation + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (let* ((text (buffer-substring-no-properties (point-min) (point))) + (l (length report-emacs-bug-orig-text)) + (text (substring text 0 l)) + (org-regex "\\b[Oo]rg\\(-mode\\)?\\b")) + (when (string-match-p org-regex text) + (when (yes-or-no-p "Is this bug about org-mode?") + (error (substitute-command-keys "\ +Not sending, use \\[org-submit-bug-report] to report an Org-mode bug."))))))) + (defun report-emacs-bug-hook () "Do some checking before sending a bug report." (goto-char (point-max)) @@ -493,6 +507,7 @@ and send the mail again%s." (goto-char (point-min)) (re-search-forward "^From: " nil t) (error "Please edit the From address and try again")))) + (report-emacs-bug-check-org) ;; Bury the help buffer (if it's shown). (when-let* ((help (get-buffer "*Bug Help*"))) (when (get-buffer-window help) diff --git a/lisp/man.el b/lisp/man.el index 397162a7ad1..9e1d294b1ec 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1379,17 +1379,24 @@ Same for the ANSI bold and normal escape sequences." (put-text-property (1- (point)) (point) 'font-lock-face 'Man-underline)))) (goto-char (point-min)) - (while (and (search-forward "_\b" nil t) (not (eobp))) - (delete-char -2) - (put-text-property (point) (1+ (point)) 'font-lock-face 'Man-underline)) - (goto-char (point-min)) - (while (search-forward "\b_" nil t) - (delete-char -2) + (while (and (re-search-forward "_\b\\([^_]\\)" nil t) (not (eobp))) + (replace-match "\\1") (put-text-property (1- (point)) (point) 'font-lock-face 'Man-underline)) (goto-char (point-min)) - (while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t) + (while (re-search-forward "\\([^_]\\)\b_" nil t) + (replace-match "\\1") + (put-text-property (1- (point)) (point) 'font-lock-face 'Man-underline)) + (goto-char (point-min)) + (while (re-search-forward "\\([^_]\\)\\(\b+\\1\\)+" nil t) (replace-match "\\1") (put-text-property (1- (point)) (point) 'font-lock-face 'Man-overstrike)) + ;; Special case for "__": is it an underlined underscore or a bold + ;; underscore? Look at the face after it to know. + (goto-char (point-min)) + (while (search-forward "_\b_" nil t) + (delete-char -2) + (let ((face (get-text-property (point) 'font-lock-face))) + (put-text-property (1- (point)) (point) 'font-lock-face face))) (goto-char (point-min)) (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o") diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 0c770df7c56..508046a163b 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2244,9 +2244,16 @@ to invoke a similar command with `M-x', use `kill-current-buffer'." ;; This colossus of a conditional is necessary to account for the wide ;; variety of this command's callers. (if (let ((lce last-command-event)) - (eq (if (atom lce) ; Selected menu item. - lce - (car lce)) ; Clicked tool bar icon. + (eq (cond + ((atom lce) ; Selected menu item. + lce) + ((mouse-event-p lce) ; Clicked window tool bar icon. + ;; Code from window-tool-bar--call-button. + (let* ((posn (event-start lce)) + (str (posn-string posn))) + (get-text-property (cdr str) 'tool-bar-key (car str)))) + (t + (car lce))) ; Clicked tool bar icon. 'kill-buffer)) (if (let* ((window (or (posn-window (event--posn-at-point)) last-event-frame diff --git a/lisp/mpc.el b/lisp/mpc.el index 7c96bdb3ac7..6e0428ec04e 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -2925,20 +2925,20 @@ playing song is displayed." (let ((inhibit-read-only t)) (erase-buffer) (make-vtable - :columns '(( :name "Tag" + :columns `(( :name "Tag" :align right :min-width 3 :displayer - (lambda (tag &rest _) - (propertize tag 'face 'mpc-table-key))) + ,(lambda (tag &rest _) + (propertize tag 'face 'mpc-table-key))) ( :name "Value" :align left :min-width 5 :displayer - (lambda (value &rest _) - (if (and value (not (string-blank-p value))) - (propertize value 'face 'mpc-table-value) - (propertize "empty" 'face 'mpc-table-empty))))) + ,(lambda (value &rest _) + (if (and value (not (string-blank-p value))) + (propertize value 'face 'mpc-table-value) + (propertize "empty" 'face 'mpc-table-empty))))) :objects (mapcar (lambda (tag) (pcase tag diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 2e02e932234..dd3c14f9aa7 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -109,7 +109,9 @@ (version<= "3" (car (split-string bbdb-version))))) (defun eudc--plist-member (plist prop &optional predicate) - "Like `plist-member', but signal on invalid PLIST." + "Like `plist-member', but signal on invalid PLIST. +Return t if PROP has a value specified in PLIST. The comparison with +PROP is done using PREDICATE, which defaults to `eq'." (or (plistp plist) (signal 'wrong-type-argument `(plistp ,plist))) (plist-member plist prop predicate)) @@ -883,7 +885,8 @@ non-nil, collect results from all servers." ;;;###autoload (defun eudc-format-inline-expansion-result (res query-attrs) - "Format a query result according to `eudc-inline-expansion-format'." + "Format a query result RES according to `eudc-inline-expansion-format'. +QUERY-ATTRS is a list of attributes to include in the expansion." (cond ;; format string ((consp eudc-inline-expansion-format) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 5462b3c78f4..7ba22370a9a 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -862,9 +862,9 @@ This replaces the region with the preprocessed HTML." (plist-put eww-data :source source))) (unless document (let ((dom (eww--parse-html-region (point) (point-max) charset))) - (when (eww-default-readable-p url) - (eww-score-readability dom) - (setq dom (eww-highest-readability dom)) + (when-let* (((eww-default-readable-p url)) + (readable-dom (eww-readable-dom dom))) + (setq dom readable-dom) (with-current-buffer buffer (plist-put eww-data :readable t))) (setq document (eww-document-base url dom)))) @@ -1163,42 +1163,99 @@ adds a new entry to `eww-history'." (eww--parse-html-region (point-min) (point-max)))) (base (plist-get eww-data :url))) (when make-readable - (eww-score-readability dom) - (setq dom (eww-highest-readability dom))) - (when eww-readable-adds-to-history - (eww-save-history) - (eww--before-browse) - (dolist (elem '(:source :url :title :next :previous :up :peer)) - (plist-put eww-data elem (plist-get old-data elem)))) - (eww-display-document (eww-document-base base dom)) - (plist-put eww-data :readable make-readable) - (eww--after-page-change))) + (unless (setq dom (eww-readable-dom dom)) + (message "Unable to find readable content"))) + (when dom + (when eww-readable-adds-to-history + (eww-save-history) + (eww--before-browse) + (dolist (elem '(:source :url :peer)) + (plist-put eww-data elem (plist-get old-data elem)))) + (eww-display-document (eww-document-base base dom)) + (plist-put eww-data :readable make-readable) + (eww--after-page-change)))) -(defun eww-score-readability (node) - (let ((score -1)) - (cond - ((memq (dom-tag node) '(script head comment)) - (setq score -2)) - ((eq (dom-tag node) 'meta) - (setq score -1)) - ((eq (dom-tag node) 'img) - (setq score 2)) - ((eq (dom-tag node) 'a) - (setq score (- (length (split-string (dom-text node)))))) - (t +(defun eww--walk-readability (node callback &optional noscore) + "Walk through all children of NODE to score readability. +After scoring, call CALLBACK with the node and score. If NOSCORE is +non-nil, don't actually compute a score; just call the callback." + (let ((score nil)) + (unless noscore + (cond + ((stringp node) + (setq score (length (split-string node)) + noscore t)) + ((memq (dom-tag node) '(head comment script style template)) + (setq score -2 + noscore t)) + ((eq (dom-tag node) 'meta) + (setq score -1 + noscore t)) + ((eq (dom-tag node) 'img) + (setq score 2 + noscore t)) + ((eq (dom-tag node) 'a) + (setq score (- (length (split-string (dom-text node)))) + noscore t)) + (t + (setq score -1)))) + (when (consp node) (dolist (elem (dom-children node)) - (cond - ((stringp elem) - (setq score (+ score (length (split-string elem))))) - ((consp elem) - (setq score (+ score - (or (cdr (assoc :eww-readability-score (cdr elem))) - (eww-score-readability elem))))))))) - ;; Cache the score of the node to avoid recomputing all the time. - (dom-set-attribute node :eww-readability-score score) + (let ((subscore (eww--walk-readability elem callback noscore))) + (when (and (not noscore) subscore) + (incf score subscore))))) + (funcall callback node score) score)) +(defun eww-readable-dom (dom) + "Return a readable version of DOM. +If EWW can't create a readable version, return nil instead." + (let ((head-nodes nil) + (best-node nil) + (best-score most-negative-fixnum)) + (eww--walk-readability + dom + (lambda (node score) + (when (consp node) + (when (and score (> score best-score) + ;; We set a lower bound to how long we accept that + ;; the readable portion of the page is going to be. + (> (length (split-string (dom-texts node))) 100)) + (setq best-score score + best-node node)) + ;; Keep track of any and <link> tags we find to include + ;; in the final document. EWW uses them for various features, + ;; like renaming the buffer or navigating to "next" and + ;; "previous" pages. NOTE: We could probably filter out + ;; stylesheet <link> tags here, though it doesn't really matter + ;; since we don't *do* anything with stylesheets... + (when (memq (dom-tag node) '(title link base)) + ;; Copy the node, but not any of its (non-text) children. + ;; This way, we can ensure that we don't include a node + ;; directly in our list in addition to as a child of some + ;; other node in the list. This is ok for <title> and <link> + ;; tags, but might need changed if supporting other tags. + (let* ((inner-text (dom-texts node "")) + (new-node `(,(dom-tag node) + ,(dom-attributes node) + ,@(when (length> inner-text 0) + (list inner-text))))) + (push new-node head-nodes)))))) + (when (and best-node (not (eq best-node dom))) + `(html nil + (head nil ,@head-nodes) + (body nil ,best-node))))) + +(defun eww-score-readability (node) + (declare (obsolete 'eww--walk-readability "31.1")) + (eww--walk-readability + node + (lambda (node score) + (when (and score (consp node)) + (dom-set-attribute node :eww-readability-score score))))) + (defun eww-highest-readability (node) + (declare (obsolete 'eww-readable-dom "31.1")) (let ((result node) highest) (dolist (elem (dom-non-text-children node)) @@ -1355,7 +1412,11 @@ within text input fields." ;; Autoload cookie needed by desktop.el. ;;;###autoload -(define-derived-mode eww-mode special-mode "eww" +(define-derived-mode eww-mode special-mode + `("eww" + (:eval (when (plist-get eww-data :readable) + '(:propertize ":readable" + help-echo "Displaying readable content")))) "Mode for browsing the web." :interactive nil (setq-local eww-data (list :title "")) @@ -2203,9 +2264,13 @@ EXTERNAL is the prefix argument. If called interactively with ;; This is a #target url in the same page as the current one. ((and (setq target (url-target (url-generic-parse-url url))) (eww-same-page-p url (plist-get eww-data :url))) - (let ((point (point))) + (let ((old-data eww-data) + (point (point))) (eww-save-history) (eww--before-browse) + ;; Copy previous `eww-data', since everything but the URL will + ;; stay the same, and we don't re-render the document. + (setq eww-data (copy-sequence old-data)) (plist-put eww-data :url url) (goto-char (point-min)) (if-let* ((match (text-property-search-forward 'shr-target-id target #'member))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 9df2b657e91..0a1c44d3673 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -176,8 +176,8 @@ It must be supported by libarchive(3).") It must be supported by libarchive(3).") ;; The definition of `tramp-archive-file-name-regexp' contains calls -;; to `regexp-opt', which cannot be autoloaded while loading -;; loaddefs.el. So we use a macro, which is evaluated only when needed. +;; to `rx', which cannot be autoloaded while loading loaddefs.el. So +;; we use a macro, which is evaluated only when needed. ;;;###autoload (progn (defmacro tramp-archive-autoload-file-name-regexp () "Regular expression matching archive file names." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 3dba7b1bad6..d7cefc870e6 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1516,6 +1516,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (if (not (processp p)) (tramp-error v 'file-notify-error "Monitoring not supported for `%s'" file-name) + ;; Needed for process filter. (process-put p 'tramp-events events) (process-put p 'tramp-watch-name localname) (set-process-filter p #'tramp-gvfs-monitor-process-filter) @@ -1527,9 +1528,9 @@ If FILE-SYSTEM is non-nil, return file system attributes." (unless (process-live-p p) (tramp-error p 'file-notify-error "Monitoring not supported for `%s'" file-name)) - ;; Set "gio-file-monitor" property. We believe, that "gio + ;; Set "file-monitor" property. We believe, that "gio ;; monitor" uses polling when applied for mounted files. - (tramp-set-connection-property p "gio-file-monitor" 'GPollFileMonitor) + (tramp-set-connection-property p "file-monitor" 'GPollFileMonitor) p)))) (defun tramp-gvfs-monitor-process-filter (proc string) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 46666b8657e..41a1cdf3409 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -233,7 +233,7 @@ The string is used in `tramp-methods'.") tramp-terminal-type)) ("%h"))) (tramp-async-args (("-q"))) - (tramp-direct-async t) + (tramp-direct-async ("-t" "-t")) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) @@ -731,18 +731,31 @@ print \"(\\n\"; foreach $f (@files) { ($p = $f) =~ s/\\\"/\\\\\\\"/g; ($q = \"$dir/$f\") =~ s/\\\"/\\\\\\\"/g; - print \"(\", - ((-d \"$q\") ? \"\\\"$p/\\\" \\\"$q\\\" t\" : \"\\\"$p\\\" \\\"$q\\\" nil\"), + print \"(\\\"$q\\\"\", ((-e \"$q\") ? \" t\" : \" nil\"), ((-r \"$q\") ? \" t\" : \" nil\"), + ((-d \"$q\") ? \" t\" : \" nil\"), + ((-x \"$q\") ? \" t\" : \" nil\"), \")\\n\"; } print \")\\n\"; ' \"$1\" %n" "Perl script to produce output suitable for use with -`file-name-all-completions' on the remote file system. -Format specifiers are replaced by `tramp-expand-script', percent -characters need to be doubled.") +`file-name-all-completions' on the remote file system. It returns the +same format as `tramp-bundle-read-file-names'. Format specifiers are +replaced by `tramp-expand-script', percent characters need to be +doubled.") + +(defconst tramp-shell-file-name-all-completions + "cd \"$1\" 2>&1; %l -a %n | while IFS= read file; do + quoted=`echo \"$1/$file\" | sed -e \"s#//#/#g\"` + printf \"%%s\\n\" \"$quoted\" + done | tramp_bundle_read_file_names" + "Shell script to produce output suitable for use with +`file-name-all-completions' on the remote file system. It returns the +same format as `tramp-bundle-read-file-names'. Format specifiers are +replaced by `tramp-expand-script', percent characters need to be +doubled.") ;; Perl script to implement `file-attributes' in a Lisp `read'able ;; output. If you are hacking on this, note that you get *no* output @@ -1172,21 +1185,22 @@ characters need to be doubled.") (defconst tramp-bundle-read-file-names "echo \"(\" -while read file; do - quoted=`echo \"$file\" | sed -e \"s/\\\"/\\\\\\\\\\\\\\\\\\\"/\"` - printf \"(%%b\" \"\\\"$quoted\\\"\" - if %q \"$file\"; then printf \" %%b\" t; else printf \" %%b\" nil; fi - if %m -r \"$file\"; then printf \" %%b\" t; else printf \" %%b\" nil; fi - if %m -d \"$file\"; then printf \" %%b)\n\" t; else printf \" %%b)\n\" nil; fi +while IFS= read file; do + quoted=`echo \"$file\" | sed -e \"s/\\\"/\\\\\\\\\\\\\\\\\\\"/g\"` + printf \"(%%s\" \"\\\"$quoted\\\"\" + if %q \"$file\"; then printf \" %%s\" t; else printf \" %%s\" nil; fi + if %m -r \"$file\"; then printf \" %%s\" t; else printf \" %%s\" nil; fi + if %m -d \"$file\"; then printf \" %%s\" t; else printf \" %%s\" nil; fi + if %m -x \"$file\"; then printf \" %%s)\\n\" t; else printf \" %%s)\\n\" nil; fi done echo \")\"" - "Script to check file attributes of a bundle of files. -It must be sent formatted with three strings; the tests for file -existence, file readability, and file directory. Input shall be -read via here-document, otherwise the command could exceed -maximum length of command line. -Format specifiers \"%s\" are replaced before the script is used, -percent characters need to be doubled.") + "Shell script to check file attributes of a bundle of files. +For every file, it returns a list with the absolute file name, and the +tests for file existence, file readability, file directory, and file +executable. Input shall be read via here-document, otherwise the +command could exceed maximum length of command line. Format specifiers +\"%s\" are replaced before the script is used, percent characters need +to be doubled.") ;; New handlers should be added here. ;;;###tramp-autoload @@ -1945,47 +1959,40 @@ ID-FORMAT valid values are `string' and `integer'." ;; reliably tagging the directories with a trailing "/". ;; Because I rock. --daniel@danann.net (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (setq result - (tramp-send-command-and-read - v (format "tramp_perl_file_name_all_completions %s" - (tramp-shell-quote-argument localname)) - 'noerror)) - ;; Cached values. - (dolist (elt result) - (tramp-set-file-property - v (cadr elt) "file-directory-p" (nth 2 elt)) - (tramp-set-file-property - v (cadr elt) "file-exists-p" (nth 3 elt)) - (tramp-set-file-property - v (cadr elt) "file-readable-p" (nth 4 elt))) - ;; Result. - (mapcar #'car result)) + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + ;; Used in `tramp-shell-file-name-all-completions'. + (tramp-maybe-send-script + v tramp-bundle-read-file-names "tramp_bundle_read_file_names") + (tramp-maybe-send-script + v tramp-shell-file-name-all-completions + "tramp_shell_file_name_all_completions")) - ;; Do it with ls. - (when (tramp-send-command-and-check - v (format (concat - "cd %s 2>&1 && %s -a 2>%s" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>%s;" - " then echo \"$f/\"; else echo \"$f\"; fi;" - " done") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - (tramp-get-remote-null-device v) - (tramp-get-test-command v) - (tramp-get-remote-null-device v))) + (dolist + (elt + (tramp-send-command-and-read + v (format + "%s %s" + (if (tramp-get-remote-perl v) + "tramp_perl_file_name_all_completions" + "tramp_shell_file_name_all_completions") + (tramp-shell-quote-argument localname)) + 'noerror) + result) + ;; Don't cache "." and "..". + (when (string-match-p + directory-files-no-dot-files-regexp + (file-name-nondirectory (car elt))) + (tramp-set-file-property v (car elt) "file-exists-p" (nth 1 elt)) + (tramp-set-file-property v (car elt) "file-readable-p" (nth 2 elt)) + (tramp-set-file-property v (car elt) "file-directory-p" (nth 3 elt)) + (tramp-set-file-property v (car elt) "file-executable-p" (nth 4 elt))) - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - (while (zerop (forward-line -1)) - (push - (buffer-substring (point) (line-end-position)) result))) - result)))))))))) + (push + (concat + (file-name-nondirectory (car elt)) (and (nth 3 elt) "/")) + result)))))))))) ;; cp, mv and ln @@ -3640,7 +3647,8 @@ filled are described in `tramp-bundle-read-file-names'." (tramp-set-file-property vec (car elt) "file-exists-p" (nth 1 elt)) (tramp-set-file-property vec (car elt) "file-readable-p" (nth 2 elt)) - (tramp-set-file-property vec (car elt) "file-directory-p" (nth 3 elt))))) + (tramp-set-file-property vec (car elt) "file-directory-p" (nth 3 elt)) + (tramp-set-file-property vec (car elt) "file-executable-p" (nth 4 elt))))) (defvar tramp-vc-registered-file-names nil "List used to collect file names, which are checked during `vc-registered'.") @@ -3877,9 +3885,9 @@ Fall back to normal file name handler if no Tramp handler exists." (throw 'doesnt-work nil)) ;; Determine monitor name. - (unless (tramp-connection-property-p proc "gio-file-monitor") + (unless (tramp-connection-property-p proc "file-monitor") (tramp-set-connection-property - proc "gio-file-monitor" + proc "file-monitor" (cond ;; We have seen this on cygwin gio and on emba. Let's make ;; some assumptions. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index db961c97523..b292f686500 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -127,10 +127,10 @@ this variable \"client min protocol=NT1\"." "ERRnomem" "ERRnosuchshare" ;; See /usr/include/samba-4.0/core/ntstatus.h. - ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), - ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003), - ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7), - ;; Windows 6.3 (Windows Server 2012, Windows 10). + ;; <https://learn.microsoft.com/en-us/windows/win32/sysinfo/operating-system-version> + ;; Tested with Windows NT, Windows 2000, Windows XP, Windows + ;; Server 2003, Windows Vista, Windows 7, Windows Server 2012, + ;; Windows 10, Windows 11. "NT_STATUS_ACCESS_DENIED" "NT_STATUS_ACCOUNT_LOCKED_OUT" "NT_STATUS_BAD_NETWORK_NAME" @@ -261,7 +261,7 @@ See `tramp-actions-before-shell' for more info.") (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) - (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-add-watch . tramp-smb-handle-file-notify-add-watch) (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) (file-notify-valid-p . tramp-handle-file-notify-valid-p) (file-ownership-preserved-p . ignore) @@ -686,8 +686,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-error v 'file-error "%s `%s'" (match-string 0) directory))) ;; "rmdir" does not report an error. So we check ourselves. - (when (file-exists-p directory) - (tramp-error v 'file-error "`%s' not removed" directory))))) + ;; Deletion of a watched directory could be pending. + (when (and (not (tramp-directory-watched directory)) + (file-exists-p directory)) + (tramp-error v 'file-error "`%s' not removed" directory))))) (defun tramp-smb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." @@ -964,6 +966,108 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-error v 'file-error "Cannot make local copy of file `%s'" filename))))) +;; The "notify" command has been added to smbclient 4.3.0. +(defun tramp-smb-handle-file-notify-add-watch (file-name flags _callback) + "Like `file-notify-add-watch' for Tramp files." + (setq file-name (expand-file-name file-name)) + (with-parsed-tramp-file-name file-name nil + (let ((default-directory (file-name-directory file-name)) + (command (format "notify %s" (tramp-smb-shell-quote-localname v))) + (events + (cond + ((memq 'change flags) + '(added removed modified renamed-from renamed-to)) + ((memq 'attribute-change flags) '(modified)))) + p) + ;; Start process. + (with-tramp-saved-connection-properties + v '(" process-name" " process-buffer") + ;; Set the new process properties. + (tramp-set-connection-property + v " process-name" (tramp-get-unique-process-name "smb-notify")) + (tramp-set-connection-property + v " process-buffer" (generate-new-buffer " *smb-notify*")) + (tramp-flush-connection-property v " process-exit-status") + (tramp-smb-send-command v command 'nooutput) + (setq p (tramp-get-connection-process v)) + ;; Return the process object as watch-descriptor. + (if (not (processp p)) + (tramp-error + v 'file-notify-error + "`%s' failed to start on remote host" command) + ;; Needed for process filter. + (process-put p 'tramp-events events) + (process-put p 'tramp-watch-name localname) + (set-process-filter p #'tramp-smb-notify-process-filter) + (set-process-sentinel p #'tramp-file-notify-process-sentinel) + (tramp-post-process-creation p v) + ;; There might be an error if the monitor is not supported. + ;; Give the filter a chance to read the output. + (while (tramp-accept-process-output p)) + (unless (process-live-p p) + (tramp-error + p 'file-notify-error "Monitoring not supported for `%s'" file-name)) + ;; Set "file-monitor" property. The existence of the "ADMIN$" + ;; share is an indication for a remote MS Windows host. + (tramp-set-connection-property + p "file-monitor" + (if (member + "ADMIN$" (directory-files (tramp-make-tramp-file-name v "/"))) + 'SMBWindows 'SMBSamba)) + p))))) + +;; FileChangeNotify subsystem was added to Smaba 4.3.0. +;; <https://www.samba.org/samba/history/samba-4.3.0.html> +(defun tramp-smb-notify-process-filter (proc string) + "Read output from \"notify\" and add corresponding `file-notify' events." + (let ((events (process-get proc 'tramp-events))) + (tramp-message proc 6 "%S\n%s" proc string) + (dolist (line (split-string string (rx (+ (any "\r\n"))) 'omit)) + (catch 'next + ;; Watched directory is removed. + (when (string-match-p "NT_STATUS_DELETE_PENDING" line) + (setq line (concat "0002 " (process-get proc 'tramp-watch-name)))) + ;; Stopped. + (when (string-match-p tramp-smb-prompt line) + (throw 'next 'next)) + + ;; Check, whether there is a problem. + (unless (string-match + (rx bol (group (+ digit)) + (+ blank) (group (+ (not (any "\r\n"))))) + line) + (tramp-error proc 'file-notify-error line)) + + ;; See libsmbclient.h. + ;; #define SMBC_NOTIFY_ACTION_ADDED 1 + ;; #define SMBC_NOTIFY_ACTION_REMOVED 2 + ;; #define SMBC_NOTIFY_ACTION_MODIFIED 3 + ;; #define SMBC_NOTIFY_ACTION_OLD_NAME 4 + ;; #define SMBC_NOTIFY_ACTION_NEW_NAME 5 + ;; #define SMBC_NOTIFY_ACTION_ADDED_STREAM 6 + ;; #define SMBC_NOTIFY_ACTION_REMOVED_STREAM 7 + ;; #define SMBC_NOTIFY_ACTION_MODIFIED_STREAM 8 + (let ((object + (list + proc + (pcase (string-to-number (match-string 1 line)) + (1 '(added)) + (2 '(removed)) + (3 '(modified)) + (4 '(renamed-from)) + (5 '(renamed-to)) + ;; Ignore stream events. + (_ (throw 'next 'next))) + (string-replace "\\" "/" (match-string 2 line))))) + ;; Add an Emacs event now. + ;; `insert-special-event' exists since Emacs 31. + (when (member (caadr object) events) + (tramp-compat-funcall + (if (fboundp 'insert-special-event) + 'insert-special-event + (lookup-key special-event-map [file-notify])) + `(file-notify ,object file-notify-callback)))))))) + ;; This function should return "foo/" for directories and "bar" for ;; files. (defun tramp-smb-handle-file-name-all-completions (filename directory) @@ -1823,13 +1927,14 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." ;; Connection functions. -(defun tramp-smb-send-command (vec command) +(defun tramp-smb-send-command (vec command &optional nooutput) "Send the COMMAND to connection VEC. -Returns nil if there has been an error message from smbclient." +Returns nil if there has been an error message from smbclient. The +function waits for output unless NOOUTPUT is set." (tramp-smb-maybe-open-connection vec) (tramp-message vec 6 "%s" command) (tramp-send-string vec command) - (tramp-smb-wait-for-output vec)) + (unless nooutput (tramp-smb-wait-for-output vec))) (defun tramp-smb-maybe-open-connection (vec &optional argument) "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'. @@ -2003,7 +2108,7 @@ Removes smb prompt. Returns nil if an error message has appeared." (while (not (search-forward-regexp tramp-smb-prompt nil t)) (while (tramp-accept-process-output p)) (goto-char (point-min))) - (tramp-message vec 6 "\n%s" (buffer-string)) + (tramp-message vec 6 "%S\n%s" p (buffer-string)) ;; Remove prompt. (goto-char (point-min)) @@ -2084,4 +2189,6 @@ Removes smb prompt. Returns nil if an error message has appeared." ;; ;; * Keep a permanent connection process for `process-file'. +;; * Implement "scopy" (since Samba 4.3.0). + ;;; tramp-smb.el ends here diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 0f7b945f84a..d64f6ba37ac 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2218,7 +2218,7 @@ This shouldn't be changed globally, but let-bind where needed.") (defmacro with-tramp-suspended-timers (&rest body) "Run BODY with suspended timers. Obey `tramp-dont-suspend-timers'." - (declare (indent 0) (debug ((form body) body))) + (declare (indent 0) (debug t)) `(if tramp-dont-suspend-timers (progn ,@body) (let ((stimers (with-timeout-suspend)) @@ -2759,7 +2759,7 @@ whether HANDLER is to be called. Add operations defined in (progn (defmacro without-remote-files (&rest body) "Deactivate remote file names temporarily. Run BODY." - (declare (indent 0) (debug ((form body) body))) + (declare (indent 0) (debug t)) `(let ((file-name-handler-alist (copy-tree file-name-handler-alist)) tramp-mode) (tramp-unload-file-name-handlers) @@ -5743,6 +5743,16 @@ of." (tramp-message proc 5 "Sentinel called: `%S' `%s'" proc event) (file-notify-rm-watch proc))) +(defun tramp-directory-watched (directory) + "Check, whether a directory is watched." + (let (result) + (dolist (p (process-list) result) + (setq result + (or result + (and-let* ((dir (process-get p 'tramp-watch-name)) + ((string-equal + dir (tramp-file-local-name directory)))))))))) + ;;; Functions for establishing connection: ;; The following functions are actions to be taken when seeing certain @@ -6120,7 +6130,7 @@ If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." (if (with-local-quit (setq result (accept-process-output proc 0 nil t)) t) (tramp-message - proc 10 "%s %s %s\n%s" + proc 10 "%S %S %s\n%s" proc (process-status proc) result (buffer-string)) ;; Propagate quit. (keyboard-quit))) @@ -6197,7 +6207,7 @@ nil." ;; timeout of sudo. The process buffer does not exist any longer then. (ignore-errors (tramp-message - proc 6 "\n%s" (tramp-get-buffer-string (process-buffer proc)))) + proc 6 "%S\n%s" proc (tramp-get-buffer-string (process-buffer proc)))) (unless found (if timeout (tramp-error diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 1100b349283..65e60c0464a 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.8.0-pre +;; Version: 2.8.0 ;; Package-Requires: ((emacs "28.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.8.0-pre" +(defconst tramp-version "2.8.0" "This version of Tramp.") ;;;###tramp-autoload @@ -76,7 +76,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "28.1")) "ok" - (format "Tramp 2.8.0-pre is not fit for %s" + (format "Tramp 2.8.0 is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) diff --git a/lisp/emacs-lisp/elint.el b/lisp/obsolete/elint.el similarity index 99% rename from lisp/emacs-lisp/elint.el rename to lisp/obsolete/elint.el index 5ae8880167d..f3d52ba0faf 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/obsolete/elint.el @@ -5,6 +5,7 @@ ;; Author: Peter Liljenberg <petli@lysator.liu.se> ;; Maintainer: emacs-devel@gnu.org ;; Created: May 1997 +;; Obsolete-since: 31.1 ;; Keywords: lisp ;; This file is part of GNU Emacs. @@ -24,6 +25,8 @@ ;;; Commentary: +;; *Note: This package is obsolete. Use the byte-compiler instead.* + ;; This is a linter for Emacs Lisp. Currently, it mainly catches ;; misspellings and undefined variables, although it can also catch ;; function calls with the wrong number of arguments. @@ -243,7 +246,11 @@ This environment can be passed to `macroexpand'." ;;;###autoload (defun elint-file (file) "Lint the file FILE." + (declare (obsolete nil "31.1")) (interactive "fElint file: ") + (elint--file file)) + +(defun elint--file (file) (setq file (expand-file-name file)) (or elint-builtin-variables (elint-initialize)) @@ -277,6 +284,7 @@ This environment can be passed to `macroexpand'." (defun elint-directory (directory) "Lint all the .el files in DIRECTORY. A complicated directory may require a lot of memory." + (declare (obsolete nil "31.1")) (interactive "DElint directory: ") (let ((elint-running t)) (dolist (file (directory-files directory t)) @@ -286,13 +294,14 @@ A complicated directory may require a lot of memory." (not (auto-save-file-name-p file))) (if (string-match elint-directory-skip-re file) (message "Skipping file %s" file) - (elint-file file))))) + (elint--file file))))) (elint-set-mode-line)) ;;;###autoload (defun elint-current-buffer () "Lint the current buffer. If necessary, this first calls `elint-initialize'." + (declare (obsolete nil "31.1")) (interactive) (or elint-builtin-variables (elint-initialize)) @@ -312,6 +321,7 @@ If necessary, this first calls `elint-initialize'." (defun elint-defun () "Lint the function at point. If necessary, this first calls `elint-initialize'." + (declare (obsolete nil "31.1")) (interactive) (or elint-builtin-variables (elint-initialize)) diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el index d92e94a050e..239500c37dd 100644 --- a/lisp/pcmpl-rpm.el +++ b/lisp/pcmpl-rpm.el @@ -381,43 +381,41 @@ ;;; DNF -(defvar pcmpl-rpm-dnf-cache-file "/var/cache/dnf/packages.db" - "Location of the DNF cache.") - (defun pcmpl-rpm--dnf-packages (status) - (when (and (file-exists-p pcmpl-rpm-dnf-cache-file) - (executable-find "sqlite3")) - (with-temp-message - "Getting list of packages..." - (process-lines "sqlite3" "-batch" "-init" "/dev/null" - pcmpl-rpm-dnf-cache-file - (pcase-exhaustive status - ('available "select pkg from available") - ('installed "select pkg from installed") - ('not-installed "\ -select pkg from available where pkg not in (select pkg from installed)")))))) + "Return packages matching STATUS. +STATUS should be one of --available or --installed." + (with-temp-message + "Getting list of packages..." + (process-lines "dnf" "--cacheonly" "repoquery" "--queryformat=%{name}\\n" + status))) ;;;###autoload (defun pcomplete/dnf () "Completion for the `dnf' command." - (let ((subcmds (pcomplete-from-help "dnf help" - :margin "^\\(\\)[a-z-]+ " - :argument "[a-z-]+"))) + (let ((subcmds (pcomplete-from-help "dnf --help" + :margin (rx bol (group (* " ")) + (one-or-more (any "a-z" "-")) " ") + :argument (rx (not "-") (1+ (any "a-z" "-")))))) (while (not (member (pcomplete-arg 1) subcmds)) (pcomplete-here (completion-table-merge subcmds - (pcomplete-from-help "dnf help")))) + (pcomplete-from-help "dnf --help")))) (let ((subcmd (pcomplete-arg 1))) (while (pcase subcmd ((guard (pcomplete-match "\\`-" 0)) - (pcomplete-here - (pcomplete-from-help `("dnf" "help" ,subcmd)))) - ((or "downgrade" "reinstall" "remove") - (pcomplete-here (pcmpl-rpm--dnf-packages 'installed))) - ((or "install" "mark" "reinstall" "upgrade") - (pcomplete-here (pcmpl-rpm--dnf-packages 'not-installed))) - ((or "builddep" "changelog" "info" "list" "repoquery" "updateinfo") - (pcomplete-here (pcmpl-rpm--dnf-packages 'available)))))))) + (if-let* (((pcomplete-match (rx bos "--what" (* (not "=")) "=" + (group (* any)) eos) + 0)) + (stub (pcomplete-match-string 1 0))) + (pcomplete-here (pcmpl-rpm--dnf-packages "--available") stub) + (pcomplete-here + (pcomplete-from-help `("dnf" ,subcmd "--help"))))) + ((or "downgrade" "dg" "upgrade" "up" "update" "reinstall" "rei" + "remove" "rm") + (pcomplete-here (pcmpl-rpm--dnf-packages "--installed"))) + ((or "builddep" "changelog" "info" "if" "install" "in" "list" "ls" + "mark" "repoquery" "rq" "advisory" "updateinfo") + (pcomplete-here (pcmpl-rpm--dnf-packages "--available")))))))) (provide 'pcmpl-rpm) diff --git a/lisp/proced.el b/lisp/proced.el index e68383df10e..02b31fb3c4c 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -2027,7 +2027,7 @@ After updating a displayed Proced buffer run the normal hook (setq mode-name (concat "Proced" (if proced-filter - (concat ": " (symbol-name proced-filter)) + (concat ": " (format "%s" proced-filter)) "") (if proced-sort (let* ((key (if (consp proced-sort) (car proced-sort) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index f63b71f89a3..5155193c603 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -24,14 +24,14 @@ ;;; Tree-sitter language versions ;; -;; c-ts-mode is known to work with the following languages and version: +;; c-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-c: v0.23.4-1-g3aa2995 ;; -;; c++-ts-mode is known to work with the following languages and version: +;; c++-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-cpp: v0.23.4-1-gf41b4f6 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -88,15 +88,18 @@ (add-to-list 'treesit-language-source-alist - '(c "https://github.com/tree-sitter/tree-sitter-c" "v0.23.4") + '(c "https://github.com/tree-sitter/tree-sitter-c" + :commit "3aa2995549d5d8b26928e8d3fa2770fd4327414e") t) (add-to-list 'treesit-language-source-alist - '(cpp "https://github.com/tree-sitter/tree-sitter-cpp" "v0.23.4") + '(cpp "https://github.com/tree-sitter/tree-sitter-cpp" + :commit "f41b4f66a42100be405f96bdc4ebc4a61095d3e8") t) (add-to-list 'treesit-language-source-alist - '(doxygen "https://github.com/tree-sitter-grammars/tree-sitter-doxygen" "v1.1.0") + '(doxygen "https://github.com/tree-sitter-grammars/tree-sitter-doxygen" + :commit "1e28054cb5be80d5febac082706225e42eff14e6") t) ;;; Custom variables @@ -199,7 +202,7 @@ To set the default indent style globally, use (if (functionp style) (funcall style) (c-ts-mode--simple-indent-rules - (if (derived-mode-p 'c-ts-mode) 'c 'c++) + (if (derived-mode-p 'c-ts-mode) 'c 'cpp) style))))) (defcustom c-ts-mode-emacs-sources-support t @@ -1484,8 +1487,10 @@ in your init files." (setq-local comment-end " */") ;; Indent. (setq-local treesit-simple-indent-rules - (c-ts-mode--simple-indent-rules - 'c c-ts-mode-indent-style)) + (if (functionp c-ts-mode-indent-style) + (funcall c-ts-mode-indent-style) + (c-ts-mode--simple-indent-rules + 'c c-ts-mode-indent-style))) ;; (setq-local treesit-simple-indent-rules ;; `((c . ,(alist-get 'gnu (c-ts-mode--indent-styles 'c))))) ;; Font-lock. @@ -1557,8 +1562,10 @@ recommended to enable `electric-pair-mode' with this mode." ;; Indent. (setq-local treesit-simple-indent-rules - (c-ts-mode--simple-indent-rules - 'cpp c-ts-mode-indent-style)) + (if (functionp c-ts-mode-indent-style) + (funcall c-ts-mode-indent-style) + (c-ts-mode--simple-indent-rules + 'cpp c-ts-mode-indent-style))) ;; Font-lock. (setq-local treesit-font-lock-settings diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 556730fce0b..a293fd858b7 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -117,7 +117,7 @@ Works with: topmost-intro-cont." (save-excursion (let (case-fold-search) (goto-char (c-langelem-pos langelem)) - (if (looking-at "\\<DEFUN\\>") + (if (looking-at "\\_<DEFUN\\_>") c-basic-offset)))) (defun c-block-in-arglist-dwim (arglist-start) @@ -554,7 +554,7 @@ Works with: func-decl-cont." (throws (catch 'done (goto-char (c-langelem-pos langelem)) (while (zerop (c-forward-token-2 1 t lim)) - (if (looking-at "throws\\>[^_]") + (if (looking-at "throws\\_>") (throw 'done t)))))) (if throws (if (zerop (c-forward-token-2 1 nil (c-point 'eol))) @@ -1513,7 +1513,7 @@ ACTION associated with `block-close' syntax." (progn (goto-char (c-langelem-pos langelem)) (if (eq (char-after) ?{) (c-safe (c-forward-sexp -1))) - (looking-at "\\<do\\>[^_]"))) + (looking-at "\\_<do\\_>"))) '(before) '(before after))))) diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index d9172bce8fc..245901c6e6d 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -244,9 +244,7 @@ ;; will only work when there won't be a preceding " or / before the sought / ;; to foul things up. (defconst c-awk-pre-exp-alphanum-kwd-re - (concat "\\(^\\|\\=\\|[^_\n\r]\\)\\<" - (regexp-opt '("print" "return" "case") t) - "\\>\\([^_\n\r]\\|$\\)")) + (regexp-opt '("print" "return" "case") 'symbols)) ;; Matches all AWK keywords which can precede expressions (including ;; /regexp/). (defconst c-awk-kwd-regexp-sign-re @@ -343,12 +341,12 @@ (save-excursion (let ((par-pos (c-safe (scan-lists (point) -1 0)))) (when par-pos - (goto-char par-pos) ; back over "(...)" - (c-backward-token-1) ; BOB isn't a problem. - (or (looking-at "\\(if\\|for\\)\\>\\([^_]\\|$\\)") - (and (looking-at "while\\>\\([^_]\\|$\\)") ; Ensure this isn't a do-while. - (not (eq (c-beginning-of-statement-1 do-lim) - 'beginning))))))))) + (goto-char par-pos) ; back over "(...)" + (c-backward-token-1) ; BOB isn't a problem. + (or (looking-at "\\(if\\|for\\)\\_>") + (and (looking-at "while\\_>") ; Ensure this isn't a do-while. + (not (eq (c-beginning-of-statement-1 do-lim) + 'beginning))))))))) (defun c-awk-after-function-decl-param-list () ;; Are we just after the ) in "function foo (bar)" ? @@ -360,9 +358,10 @@ (when par-pos (goto-char par-pos) ; back over "(...)" (c-backward-token-1) ; BOB isn't a problem - (and (looking-at "[_a-zA-Z][_a-zA-Z0-9]*\\>") + (and (looking-at "[_a-zA-Z][_a-zA-Z0-9]*\\_>" + ) (progn (c-backward-token-1) - (looking-at "func\\(tion\\)?\\>")))))))) + (looking-at "func\\(tion\\)?\\_>")))))))) ;; 2002/11/8: FIXME! Check c-backward-token-1/2 for success (0 return code). (defun c-awk-after-continue-token () @@ -374,7 +373,7 @@ (c-backward-token-1) ; FIXME 2002/10/27. What if this fails? (if (and (looking-at "[&|]") (not (bobp))) (backward-char)) ; c-backward-token-1 doesn't do this :-( - (looking-at "[,{?:]\\|&&\\|||\\|do\\>\\|else\\>"))) + (looking-at "[,{?:]\\|&&\\|||\\|do\\_>\\|else\\_>"))) (defun c-awk-after-rbrace-or-statement-semicolon () ;; Are we just after a } or a ; which closes a statement? @@ -390,7 +389,7 @@ (goto-char par-pos) ; go back to containing ( (not (and (looking-at "(") (c-backward-token-1) ; BOB isn't a problem - (looking-at "for\\>"))))))))) + (looking-at "for\\_>"))))))))) (defun c-awk-back-to-contentful-text-or-NL-prop () ;; Move back to just after the first found of either (i) an EOL which has @@ -982,18 +981,19 @@ 'font-lock-warning-face))) nil)))) + ;; Variable names. ,(cons - (concat "\\<" - (regexp-opt - '("ARGC" "ARGIND" "ARGV" "BINMODE" "CONVFMT" "ENVIRON" - "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR" "FPAT" "FS" "FUNCTAB" - "IGNORECASE" "LINT" "NF" "NR" "OFMT" "OFS" "ORS" "PREC" - "PROCINFO" "RLENGTH" "ROUNDMODE" "RS" "RSTART" "RT" "SUBSEP" - "SYMTAB" "TEXTDOMAIN") t) "\\>") - 'font-lock-variable-name-face) + (regexp-opt + '("ARGC" "ARGIND" "ARGV" "BINMODE" "CONVFMT" "ENVIRON" + "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR" "FPAT" "FS" "FUNCTAB" + "IGNORECASE" "LINT" "NF" "NR" "OFMT" "OFS" "ORS" "PREC" + "PROCINFO" "RLENGTH" "ROUNDMODE" "RS" "RSTART" "RT" "SUBSEP" + "SYNTAB" "TEXTDOMAIN") + 'symbols) + 'font-lock-variable-name-face) - ;; Special file names. (acm, 2002/7/22) + ;; Special file names. (acm, 2002/7/22) ;; The following regexp was created by first evaluating this in GNU Emacs 21.1: ;; (regexp-opt '("/dev/stdin" "/dev/stdout" "/dev/stderr" "/dev/fd/n" "/dev/pid" ;; "/dev/ppid" "/dev/pgrpid" "/dev/user") 'words) @@ -1004,7 +1004,7 @@ ;; The surrounding quotes are fontified along with the filename, since, semantically, ;; they are an indivisible unit. ("\\(\"/dev/\\(fd/[0-9]+\\|p\\(\\(\\(gr\\)?p\\)?id\\)\\|\ -std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\ +std\\(err\\|in\\|out\\)\\|user\\)\\)\\_>\ \\(\\(\"\\)\\|\\([^\"/\n\r][^\"\n\r]*\\)?$\\)" (1 font-lock-variable-name-face t) (8 font-lock-variable-name-face t t)) @@ -1015,38 +1015,34 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\ ;; , replacing "lport", "rhost", and "rport" with "[[:alnum:]]+". ;; This cannot be combined with the above pattern, because the match number ;; for the (optional) closing \" would then exceed 9. - ("\\(\"/inet[46]?/\\(\\(raw\\|\\(tc\\|ud\\)p\\)/[[:alnum:]]+/[[:alnum:]]+/[[:alnum:]]+\\)\\)\\>\ + ("\\(\"/inet[46]?/\\(\\(raw\\|\\(tc\\|ud\\)p\\)/[[:alnum:]]+/[[:alnum:]]+/[[:alnum:]]+\\)\\)\\_>\ \\(\\(\"\\)\\|\\([^\"/\n\r][^\"\n\r]*\\)?$\\)" (1 font-lock-variable-name-face t) (6 font-lock-variable-name-face t t)) ;; Keywords. - ,(concat "\\<" - (regexp-opt - '("BEGIN" "BEGINFILE" "END" "ENDFILE" - "break" "case" "continue" "default" "delete" - "do" "else" "exit" "for" "getline" "if" "in" "next" - "nextfile" "return" "switch" "while") - t) "\\>") + ,(regexp-opt + '("BEGIN" "BEGINFILE" "END" "ENDFILE" + "break" "case" "continue" "default" "delete" + "do" "else" "exit" "for" "getline" "if" "in" "next" + "nextfile" "return" "switch" "while") + 'symbols) ;; Builtins. (eval . (list - ,(concat - "\\<" - (regexp-opt - '("adump" "and" "asort" "asorti" "atan2" "bindtextdomain" "close" - "compl" "cos" "dcgettext" "dcngettext" "exp" "extension" "fflush" - "gensub" "gsub" "index" "int" "isarray" "length" "log" "lshift" - "match" "mkbool" "mktime" "or" "patsplit" "print" "printf" "rand" - "rshift" "sin" "split" "sprintf" "sqrt" "srand" "stopme" - "strftime" "strtonum" "sub" "substr" "system" - "systime" "tolower" "toupper" "typeof" "xor") - t) - "\\>") + ,(regexp-opt + '("adump" "and" "asort" "asorti" "atan2" "bindtextdomain" "close" + "compl" "cos" "dcgettext" "dcngettext" "exp" "extension" "fflush" + "gensub" "gsub" "index" "int" "isarray" "length" "log" "lshift" + "match" "mkbool" "mktime" "or" "patsplit" "print" "printf" "rand" + "rshift" "sin" "split" "sprintf" "sqrt" "srand" "stopme" + "strftime" "strtonum" "sub" "substr" "system" + "systime" "tolower" "toupper" "typeof" "xor") + 'symbols) 0 c-preprocessor-face-name)) ;; Directives - (eval . '("@\\(include\\|load\\|namespace\\)\\>" 0 ,c-preprocessor-face-name)) + (eval . '("@\\(include\\|load\\|namespace\\)\\_>" 0 ,c-preprocessor-face-name)) ;; gawk debugging keywords. (acm, 2002/7/21) ;; (Removed, 2003/6/6. These functions are now fontified as built-ins) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 9230faa56da..d5881f808ff 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -2105,7 +2105,7 @@ with a brace block." ;; Pick out the defun name, according to the type of defun. (cond - ((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs! + ((looking-at "DEFUN\\_>") ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory ;; DEFUN(POSIX::STREAM-LOCK, stream lockp &key BLOCK SHARED START LENGTH) ==> POSIX::STREAM-LOCK (down-list 1) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index e806fb754aa..22e68a748d1 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2143,103 +2143,48 @@ Notably, null elements in LIST are ignored." (mapconcat 'identity (delete nil (append list nil)) separator)) (defun c-make-keywords-re (adorn list &optional mode) - "Make a regexp that matches all the strings the list. + "Make a regexp that matches any string in LIST. Duplicates and nil elements in the list are removed. The resulting regexp may contain zero or more submatch expressions. -If ADORN is t there will be at least one submatch and the first -surrounds the matched alternative, and the regexp will also not match -a prefix of any identifier. Adorned regexps cannot be appended. The -language variable `c-nonsymbol-key' is used to make the adornment. +In the typical case when all members of LIST are valid symbols, the +resulting regexp is bracketed in \\_<\\( .... \\)\\_>. -A value `appendable' for ADORN is like above, but all alternatives in -the list that end with a word constituent char will have \\> appended -instead, so that the regexp remains appendable. Note that this -variant doesn't always guarantee that an identifier prefix isn't -matched since the symbol constituent `_' is normally considered a -nonword token by \\>. +Otherwise, if ADORN is t there will be at least one submatch and the +first surrounds the matched alternative, and the regexp will also not +match a prefix of any identifier. Adorned regexps can now (2025-06) be +appended to. In versions prior to 2025-06, there was also the value +`appendable' for ADORN. Since normal adorned regexps can now be +appended to anyway, this is no longer needed, but older code using it +will still work. -The optional MODE specifies the language to get `c-nonsymbol-key' from -when it's needed. The default is the current language taken from -`c-buffer-is-cc-mode'." - - (setq list (delete nil (delete-dups list))) - (if list - (let (re) - - (if (eq adorn 'appendable) - ;; This is kludgy but it works: Search for a string that - ;; doesn't occur in any word in LIST. Append it to all - ;; the alternatives where we want to add \>. Run through - ;; `regexp-opt' and then replace it with \>. - (let ((unique "") (list1 (copy-tree list)) pos) - (while (let (found) - (setq unique (concat unique "@") - pos list) - (while (and pos - (if (string-match unique (car pos)) - (progn (setq found t) - nil) - t)) - (setq pos (cdr pos))) - found)) - (setq pos list1) - (while pos - (if (string-match "\\w\\'" (car pos)) - (setcar pos (concat (car pos) unique))) - (setq pos (cdr pos))) - (setq re (regexp-opt list1)) - (setq pos 0) - (while (string-match unique re pos) - (setq pos (+ (match-beginning 0) 2) - re (replace-match "\\>" t t re)))) - - (setq re (regexp-opt list))) - - ;; Emacs 20 and XEmacs (all versions so far) has a buggy - ;; regexp-opt that doesn't always cope with strings containing - ;; newlines. This kludge doesn't handle shy parens correctly - ;; so we can't advice regexp-opt directly with it. - (let (fail-list) - (while list - (and (string-match "\n" (car list)) ; To speed it up a little. - (not (string-match (concat "\\`\\(" re "\\)\\'") - (car list))) - (setq fail-list (cons (car list) fail-list))) - (setq list (cdr list))) - (when fail-list - (setq re (concat re - "\\|" - (mapconcat - (if (eq adorn 'appendable) - (lambda (str) - (if (string-match "\\w\\'" str) - (concat (regexp-quote str) - "\\>") - (regexp-quote str))) - 'regexp-quote) - (sort fail-list - (lambda (a b) - (> (length a) (length b)))) - "\\|"))))) - - ;; Add our own grouping parenthesis around re instead of - ;; passing adorn to `regexp-opt', since in XEmacs it makes the - ;; top level grouping "shy". - (cond ((eq adorn 'appendable) - (concat "\\(" re "\\)")) - (adorn - (concat "\\(" re "\\)" - "\\(" - (c-get-lang-constant 'c-nonsymbol-key nil mode) - "\\|$\\)")) - (t - re))) - - ;; Produce a regexp that doesn't match anything. - (if adorn - (concat "\\(" regexp-unmatchable "\\)") - regexp-unmatchable))) +The optional MODE specifies the language whose syntax table will be used +to characterize the input strings. The default is the current language +taken from `c-buffer-is-cc-mode'." + (c-with-syntax-table + ;; If we're being called at run time, we use the mode's run time syntax + ;; table. Otherwise, generate one as needed for the current MODE. + (let ((cur-syn-tab-sym + (intern (concat (symbol-name (or mode c-buffer-is-cc-mode)) + "-syntax-table")))) + (if (and (boundp cur-syn-tab-sym) + (syntax-table-p (symbol-value cur-syn-tab-sym))) + (symbol-value cur-syn-tab-sym) + (funcall (c-get-lang-constant 'c-make-mode-syntax-table nil mode)))) + (let ((liszt (remq nil list))) + (cond + ((null liszt) + (if adorn + "\\(\\`a\\`\\)" + "\\`a\\`")) + ((catch 'symbols + (dolist (elt liszt) + (unless (string-match "\\`\\(\\sw\\|\\s_\\)*\\'" elt) + (throw 'symbols nil))) + t) + (regexp-opt liszt 'symbols)) + (adorn (regexp-opt liszt t)) + (t (regexp-opt liszt)))))) (put 'c-make-keywords-re 'lisp-indent-function 1) @@ -2362,12 +2307,26 @@ non-nil, a caret is prepended to invert the set." ;; Find out if "\\s|" (generic string delimiters) work. (c-safe (modify-syntax-entry ?x "|") - (if (string-match "\\s|" "x") - (setq list (cons 'gen-string-delim list)))) + (if (string-match "\\s|" "x") + (setq list (cons 'gen-string-delim list)))) - ;; See if POSIX char classes work. - (when (and (string-match "[[:alpha:]]" "a") - ;; All versions of Emacs 21 so far haven't fixed + ;; Check that "\\_<" and "\\_>" work in regular expressions. + (modify-syntax-entry ?_ "_") + (modify-syntax-entry ?* ".") + (modify-syntax-entry ?a "w") + (let ((s "*aaa_aaa*")) + (unless + (and + (c-safe (string-match "\\_<.*\\_>" s)) + (equal (match-string 0 s) "aaa_aaa")) + (error (concat + "CC Mode is incompatible with this version of Emacs - " + "support for \"\\_<\" and \"\\_>\" in regular expressions " + "is required.")))) + + ;; See if POSIX char classes work. + (when (and (string-match "[[:alpha:]]" "a") + ;; All versions of Emacs 21 so far haven't fixed ;; char classes in `skip-chars-forward' and ;; `skip-chars-backward'. (progn diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index b5e2ce4a0d5..361b2967c5d 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1012,12 +1012,12 @@ comment at the start of cc-engine.el for more info." (setq ret 'previous pos saved) - ;; Begin at start and not pos to detect macros if we stand - ;; directly after the #. - (goto-char start) - (if (looking-at "\\<\\|\\W") - ;; Record this as the first token if not starting inside it. - (setq tok start)) + ;; Begin at start and not pos to detect macros if we stand + ;; directly after the #. + (goto-char start) + (if (looking-at "\\_<\\|\\W") + ;; Record this as the first token if not starting inside it. + (setq tok start)) ;; The following while loop goes back one sexp (balanced parens, ;; etc. with contents, or symbol or suchlike) each iteration. This @@ -2594,7 +2594,7 @@ comment at the start of cc-engine.el for more info." ;; can be cached. (setq next-rung-pos (point)) (c-skip-ws-chars-backward " \t\f\v ") - + (if (or ;; Cache if we started either from a marked rung or from a ;; completely uncached position. @@ -8835,7 +8835,7 @@ multi-line strings (but not C++, for example)." (if (and (c-major-mode-is 'c++-mode) (save-excursion (and (zerop (c-backward-token-2)) - (looking-at "import\\>\\(?:[^_$]\\|$\\)")))) + (looking-at "import\\_>")))) (when (looking-at "<\\(?:\\\\.\\|[^\\\n\r\t>]\\)*\\(>\\)?") (if (match-beginning 1) ; A terminated <..> (progn @@ -11995,9 +11995,8 @@ This function might do hidden buffer changes." ((and (c-major-mode-is 'c++-mode) (search-forward-regexp - "\\=p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\>[^_]" nil t) - (progn (backward-char) - (c-forward-syntactic-ws limit) + "\\=p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\_>" nil t) + (progn (c-forward-syntactic-ws limit) (looking-at ":\\([^:]\\|\\'\\)"))) ; A single colon. (forward-char) (setq label-type t)) @@ -12010,7 +12009,7 @@ This function might do hidden buffer changes." (setq qt-symbol-idx (and (c-major-mode-is 'c++-mode) (string-match - "\\(p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|more\\)\\>" + "\\(p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|more\\)\\_>" (buffer-substring start (point))))) (c-forward-syntactic-ws limit) (cond @@ -12023,7 +12022,7 @@ This function might do hidden buffer changes." 'qt-1kwd-colon 'goto-target))) ((and qt-symbol-idx - (search-forward-regexp "\\=\\(slots\\|Q_SLOTS\\)\\>" limit t) + (search-forward-regexp "\\=\\(slots\\|Q_SLOTS\\)\\_>" limit t) (progn (c-forward-syntactic-ws limit) (looking-at ":\\([^:]\\|\\'\\)"))) ; A single colon (forward-char) @@ -12439,14 +12438,14 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (c-forward-sexp (cond ;; else if() - ((looking-at (concat "\\<else" + ((looking-at (concat "\\_<else\\_>" "\\([ \t\n]\\|\\\\\n\\)+" - "if\\>\\([^_]\\|$\\)")) + "\\_<if\\_>")) 3) ;; do, else, try, finally - ((looking-at (concat "\\<\\(" + ((looking-at (concat "\\_<\\(" "do\\|else\\|try\\|finally" - "\\)\\>\\([^_]\\|$\\)")) + "\\)\\_>")) 1) ;; for, if, while, switch, catch, synchronized, foreach (t 2)))) @@ -12730,9 +12729,11 @@ comment at the start of cc-engine.el for more info." ;; ;; If the check is successful, the return value is the start of the ;; keyword that tells what kind of construct it is, i.e. typically - ;; what `c-decl-block-key' matched. Also, if GOTO-START is set then - ;; the point will be at the start of the construct, before any - ;; leading specifiers, otherwise it's at the returned position. + ;; what `c-decl-block-key' matched. Also, if GOTO-START is set then point + ;; will be left at the start of the construct. This is often at the + ;; return value, but if there is a template preceding it, point will be + ;; left at its start. If there are Java annotations preceding it, point + ;; will be left at the last of these. ;; ;; The point is clobbered if the check is unsuccessful. ;; @@ -12875,7 +12876,9 @@ comment at the start of cc-engine.el for more info." ;; but that'd only occur in invalid code so there's ;; no use spending effort on it. (let ((end (match-end 0)) - (kwd-sym (c-keyword-sym (match-string 0)))) + (kwd-sym (c-keyword-sym (match-string 0))) + (annotation (and c-annotation-re + (looking-at c-annotation-re)))) (unless (and kwd-sym ;; Moving over a protection kwd and the following @@ -12885,7 +12888,12 @@ comment at the start of cc-engine.el for more info." (not (c-keyword-member kwd-sym 'c-protection-kwds)) (c-forward-keyword-clause 0)) (goto-char end) - (c-forward-syntactic-ws)))) + (c-forward-syntactic-ws) + (when annotation + (setq first-specifier-pos (match-beginning 0)) + (when (and (eq (char-after) ?\() + (c-go-list-forward (point) kwd-start)) + (c-forward-syntactic-ws)))))) ((c-syntactic-re-search-forward c-symbol-start kwd-start 'move t) @@ -14101,7 +14109,7 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws lim) (when (looking-at c-requires-clause-key) (c-forward-c++-requires-clause lim nil))) - (when (looking-at "\\(alignas\\)\\([^a-zA-Z0-9_$]\\|$\\)") + (when (looking-at "\\_<\\(alignas\\)\\_>") (c-forward-keyword-clause 1)) (when (and (eq (char-after) ?\() (c-go-list-forward nil lim)) @@ -14115,7 +14123,7 @@ comment at the start of cc-engine.el for more info." (and (<= (point) lim-or-max) (cond ((save-excursion - (and (looking-at "throw\\([^a-zA-Z0-9_]\\|$\\)") + (and (looking-at "\\_<throw\\_>") (progn (goto-char (match-beginning 1)) (c-forward-syntactic-ws lim) (eq (char-after) ?\()) @@ -14357,10 +14365,10 @@ comment at the start of cc-engine.el for more info." ((and (eq step-type 'up) (>= (point) old-boi) - (looking-at "else\\>[^_]") + (looking-at "else\\_>") (save-excursion (goto-char old-pos) - (looking-at "if\\>[^_]"))) + (looking-at "if\\_>"))) ;; Special case to avoid deeper and deeper indentation ;; of "else if" clauses. ) @@ -14427,7 +14435,7 @@ comment at the start of cc-engine.el for more info." (if (and c-recognize-paren-inexpr-blocks (progn (c-backward-syntactic-ws containing-sexp) - (or (not (looking-at "\\>")) + (or (not (looking-at "\\_>")) (not (c-on-identifier)))) (save-excursion (goto-char (1+ paren-pos)) @@ -14892,13 +14900,13 @@ comment at the start of cc-engine.el for more info." (setq macro-start nil)) ;; CASE 11: an else clause? - ((looking-at "else\\>[^_]") + ((looking-at "else\\_>") (c-beginning-of-statement-1 containing-sexp) (c-add-stmt-syntax 'else-clause nil t containing-sexp paren-state)) ;; CASE 12: while closure of a do/while construct? - ((and (looking-at "while\\>[^_]") + ((and (looking-at "while\\_>") (save-excursion (prog1 (eq (c-beginning-of-statement-1 containing-sexp) 'beginning) @@ -14912,9 +14920,9 @@ comment at the start of cc-engine.el for more info." ;; after every try, catch and finally. ((save-excursion (and (cond ((c-major-mode-is 'c++-mode) - (looking-at "catch\\>[^_]")) + (looking-at "catch\\_>")) ((c-major-mode-is 'java-mode) - (looking-at "\\(catch\\|finally\\)\\>[^_]"))) + (looking-at "\\(catch\\|finally\\)\\_>"))) (and (c-safe (c-backward-syntactic-ws) (c-backward-sexp) t) @@ -14925,7 +14933,7 @@ comment at the start of cc-engine.el for more info." (if (eq (char-after) ?\() (c-safe (c-backward-sexp) t) t)) - (looking-at "\\(try\\|catch\\)\\>[^_]") + (looking-at "\\(try\\|catch\\)\\_>") (setq placeholder (point)))) (goto-char placeholder) (c-add-stmt-syntax 'catch-clause nil t @@ -15046,7 +15054,7 @@ comment at the start of cc-engine.el for more info." (save-excursion (setq tmpsymbol (if (and (eq (c-beginning-of-statement-1 lim) 'up) - (looking-at "switch\\>[^_]")) + (looking-at "switch\\_>")) ;; If the surrounding statement is a switch then ;; let's analyze all labels as switch labels, so ;; that they get lined up consistently. @@ -15341,7 +15349,7 @@ comment at the start of cc-engine.el for more info." (let ((where (cdr injava-inher)) (cont (car injava-inher))) (goto-char where) - (cond ((looking-at "throws\\>[^_]") + (cond ((looking-at "throws\\_>") (c-add-syntax 'func-decl-cont (progn (c-beginning-of-statement-1 lim) (c-point 'boi)))) @@ -15480,7 +15488,7 @@ comment at the start of cc-engine.el for more info." (save-excursion (c-beginning-of-statement-1 lim) (setq placeholder (point)) - (if (looking-at "static\\>[^_]") + (if (looking-at "static\\_>") (c-forward-token-2 1 nil indent-point)) (and (looking-at c-class-key) (zerop (c-forward-token-2 2 nil indent-point)) @@ -15553,7 +15561,7 @@ comment at the start of cc-engine.el for more info." (eq containing-decl-open containing-sexp)) (save-excursion (goto-char containing-decl-open) - (setq tmp-pos (c-looking-at-decl-block t))) + (setq tmp-pos (c-looking-at-decl-block nil))) (c-add-class-syntax 'class-close containing-decl-open containing-decl-start @@ -15930,7 +15938,7 @@ comment at the start of cc-engine.el for more info." ((progn (goto-char containing-sexp) (and (c-safe (c-forward-sexp -1) t) - (looking-at "\\<for\\>[^_]"))) + (looking-at "\\_<for\\_>"))) (goto-char (1+ containing-sexp)) (c-forward-syntactic-ws indent-point) (if (eq char-before-ip ?\;) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 76a60ae110c..76db492b2c7 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -683,7 +683,7 @@ stuff. Used on level 1 and higher." (eval . (list ,(c-make-syntactic-matcher (concat noncontinued-line-end (c-lang-const c-opt-cpp-prefix) - "if\\(n\\)def\\>")) + "if\\(n\\)def\\_>")) ,(+ ncle-depth 1) c-negation-char-face-name 'append)) @@ -817,18 +817,18 @@ casts and declarations are fontified. Used on level 2 and higher." (if (c-major-mode-is 'pike-mode) ;; No symbol is a keyword after "->" in Pike. `((eval . (list ,(concat "\\(\\=.?\\|[^>]\\|[^-]>\\)" - "\\<\\(" re "\\)\\>") + "\\_<\\(" re "\\)\\_>") 2 c-constant-face-name))) - `((eval . (list ,(concat "\\<\\(" re "\\)\\>") + `((eval . (list ,(concat "\\_<\\(" re "\\)\\_>") 1 c-constant-face-name)))))) ;; Fontify all keywords except the primitive types. ,(if (c-major-mode-is 'pike-mode) ;; No symbol is a keyword after "->" in Pike. `(,(concat "\\(\\=.?\\|[^>]\\|[^-]>\\)" - "\\<" (c-lang-const c-regular-keywords-regexp)) + "\\_<" (c-lang-const c-regular-keywords-regexp)) 2 font-lock-keyword-face) - `(,(concat "\\<" (c-lang-const c-regular-keywords-regexp)) + `(,(concat "\\_<" (c-lang-const c-regular-keywords-regexp)) 1 font-lock-keyword-face)) ;; Fontify leading identifiers in fully qualified names like @@ -879,7 +879,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; places). `(lambda (limit) (while (re-search-forward - ,(concat "\\(\\<" ; 1 + ,(concat "\\(\\_<" "\\(" (c-lang-const c-symbol-key) "\\)" ; 2 (c-lang-const c-simple-ws) "*" (c-lang-const c-opt-identifier-concat-key) @@ -902,22 +902,14 @@ casts and declarations are fontified. Used on level 2 and higher." ,@(when (c-major-mode-is 'c++-mode) '(c-font-lock-c++-modules)) - ;; The next regexp is highlighted with narrowing. This is so that the - ;; final "context" bit of the regexp, "\\(?:[^=]\\|$\\)", which cannot - ;; match anything non-empty at LIMIT, will match "$" instead. ,@(when (c-lang-const c-equals-nontype-decl-kwds) - `((,(byte-compile - `(lambda (limit) - (save-restriction - (narrow-to-region (point-min) limit) - ,(c-make-font-lock-search-form - (concat (c-lang-const c-equals-nontype-decl-key) ;no \\( - (c-lang-const c-simple-ws) "+\\(" - (c-lang-const c-symbol-key) "\\)" - (c-lang-const c-simple-ws) "*" - "=\\(?:[^=]\\|$\\)") - `((,(+ 1 (c-lang-const c-simple-ws-depth)) - 'font-lock-type-face t))))))))) + `((,(concat (c-lang-const c-equals-nontype-decl-key) + (c-lang-const c-simple-ws) "+\\(" + (c-lang-const c-symbol-key) "\\)") + (,(+ 1 (regexp-opt-depth + (c-lang-const c-equals-nontype-decl-key)) + (c-lang-const c-simple-ws-depth)) + font-lock-type-face t)))) ;; Fontify the special declarations in Objective-C. ,@(when (c-major-mode-is 'objc-mode) @@ -936,11 +928,9 @@ casts and declarations are fontified. Used on level 2 and higher." ;; The @interface/@implementation/@protocol directives. ,(c-make-font-lock-search-function - (concat "\\<" - (regexp-opt - '("@interface" "@implementation" "@protocol") - t) - "\\>") + (regexp-opt + '("@interface" "@implementation" "@protocol") + 'symbols) '((c-fontify-types-and-refs (;; The font-lock package in Emacs is known to clobber ;; `parse-sexp-lookup-properties' (when it exists). @@ -1634,8 +1624,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; We skip over it to prevent recognition of "more slots: <symbol>" ;; as a bitfield declaration. (when (and (c-major-mode-is 'c++-mode) - (looking-at - (concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)"))) + (looking-at "\\_<\\(more\\)\\_>")) (goto-char (match-end 1)) (c-forward-syntactic-ws)) @@ -2170,9 +2159,8 @@ casts and declarations are fontified. Used on level 2 and higher." ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; Fontification". (while (and (< (point) limit) - (re-search-forward - "\\<\\(module\\|export\\|import\\)\\>\\(?:[^_$]\\|$\\)" - limit t)) + (re-search-forward "\\_<\\(module\\|export\\|import\\)\\_>" + limit t)) (goto-char (match-end 1)) (let (name-bounds pos beg end module-names) ; A list of conses of start and end @@ -2185,8 +2173,7 @@ casts and declarations are fontified. Used on level 2 and higher." ((save-excursion (when (equal (match-string-no-properties 1) "export") (c-forward-syntactic-ws limit) - (re-search-forward "\\=\\(module\\)\\>\\(?:[^_$]\\|$\\)" - limit t)) + (re-search-forward "\\=\\_<\\(module\\)\\_>" limit t)) (and (equal (match-string-no-properties 1) "module") (< (point) limit) (progn (c-forward-syntactic-ws limit) @@ -2205,8 +2192,7 @@ casts and declarations are fontified. Used on level 2 and higher." ((save-excursion (when (equal (match-string-no-properties 1) "export") (c-forward-syntactic-ws limit) - (re-search-forward "\\=\\(import\\)\\>\\(?:[^_$]\\|$\\)" - limit t)) + (re-search-forward "\\=\\_<\\(import\\)\\_>" limit t)) (and (equal (match-string-no-properties 1) "import") (< (point) limit) (progn (c-forward-syntactic-ws limit) @@ -2327,7 +2313,7 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." (regexp-opt-depth prefix-re) (c-lang-const c-simple-ws-depth)))) `((,(c-make-font-lock-search-function - (concat "\\<\\(" prefix-re "\\)" ; 1 + (concat "\\_<\\(" prefix-re "\\)" ; 1 (c-lang-const c-simple-ws) "+" (concat "\\(" ; 2 + prefix-re + c-simple-ws (c-lang-const c-symbol-key) @@ -2343,9 +2329,7 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." ;; Fontify special declarations that lack a type. ,@(when (c-lang-const c-typeless-decl-kwds) `((,(c-make-font-lock-search-function - (concat "\\<\\(" - (regexp-opt (c-lang-const c-typeless-decl-kwds)) - "\\)\\>") + (regexp-opt (c-lang-const c-typeless-decl-kwds) 'symbols) '((c-font-lock-declarators limit t nil nil) (save-match-data (goto-char (match-end 1)) @@ -2428,15 +2412,15 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." (if (c-major-mode-is 'pike-mode) ;; No symbol is a keyword after "->" in Pike. `(,(concat "\\(\\=.?\\|[^>]\\|[^-]>\\)" - "\\<\\(" re "\\)\\>") + "\\_<\\(" re "\\)\\_>") 2 font-lock-type-face) - `(,(concat "\\<\\(" re "\\)\\>") + `(,(concat "\\_<\\(" re "\\)\\_>") 1 'font-lock-type-face))) ;; Fontify the type in C++ "new" expressions. ,@(when (c-major-mode-is 'c++-mode) ;; This pattern is a probably a "(MATCHER . ANCHORED-HIGHLIGHTER)" ;; (see Elisp page "Search-based Fontification"). - '(("\\<new\\>" + `(("\\_<new\\_>" (c-font-lock-c++-new)))) ;; Maybe fontify identifiers containing a dollar sign with @@ -2528,7 +2512,7 @@ higher." (c-make-keywords-re nil (c-lang-const c-before-label-kwds)))) `(list - ,(concat "\\<\\(" c-before-label-re "\\)\\>" + ,(concat "\\_<\\(" c-before-label-re "\\)\\_>" "\\s *" "\\(" ; identifier-offset (c-lang-const c-symbol-key) @@ -2541,29 +2525,29 @@ higher." (c-lang-const c-ref-list-kwds) (c-lang-const c-colon-type-list-kwds)) `((,(c-make-font-lock-BO-decl-search-function - (concat "\\<\\(" + (concat "\\_<\\(" (c-make-keywords-re nil (append (c-lang-const c-type-list-kwds) (c-lang-const c-ref-list-kwds) (c-lang-const c-colon-type-list-kwds))) - "\\)\\>") + "\\)\\_>") '((c-fontify-types-and-refs ((c-promote-possible-types t)) (c-forward-keyword-clause 1) (if (> (point) limit) (goto-char limit)))))))) ,@(when (c-lang-const c-paren-type-kwds) `((,(c-make-font-lock-search-function - (concat "\\<\\(" + (concat "\\_<\\(" (c-make-keywords-re nil (c-lang-const c-paren-type-kwds)) - "\\)\\>") + "\\)\\_>") '((c-fontify-types-and-refs ((c-promote-possible-types t)) (c-forward-keyword-clause 1) (if (> (point) limit) (goto-char limit)))))))) ,@(when (c-major-mode-is 'java-mode) - '((eval . (list "\\<\\(@[a-zA-Z0-9]+\\)\\>" 1 c-annotation-face)))) - )) + '((eval . (list "\\_<\\(@[a-zA-Z0-9]+\\)\\_>" 1 c-annotation-face)))) + )) (c-lang-defconst c-matchers-1 t (c-lang-const c-cpp-matchers)) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index dc9b8b7aed9..2296cbdd7a3 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -382,7 +382,8 @@ The syntax tables aren't stored directly since they're quite large." ;; every keyword is a single symbol. '(modify-syntax-entry ?@ "_" table)) ((c-major-mode-is 'java-mode) - '(modify-syntax-entry ?@ "'" table)) + ;; In Java, @ can be the start of an annotation symbol. + `(modify-syntax-entry ?@ "_" table)) ((c-major-mode-is 'pike-mode) '(modify-syntax-entry ?@ "." table))) table))) @@ -951,7 +952,7 @@ This value is by default merged into `c-operators'." '(left-assoc right-assoc) t))) (when ops - (c-make-keywords-re 'appendable ops)))) + (c-make-keywords-re t ops)))) (c-lang-defvar c-opt-identifier-concat-key (c-lang-const c-opt-identifier-concat-key)) @@ -967,7 +968,7 @@ This value is by default merged into `c-operators'." '(prefix) t))) (when ops - (c-make-keywords-re 'appendable ops)))) + (c-make-keywords-re t ops)))) (c-lang-defvar c-opt-identifier-prefix-key (c-lang-const c-opt-identifier-prefix-key)) @@ -996,7 +997,7 @@ it's not taken care of by default." ;; considered internal - change `c-after-id-concat-ops' instead. t (concat (c-lang-const c-symbol-start) (if (c-lang-const c-after-id-concat-ops) - (concat "\\|" (c-make-keywords-re 'appendable + (concat "\\|" (c-make-keywords-re t (c-lang-const c-after-id-concat-ops))) ""))) @@ -1036,7 +1037,7 @@ e.g. identifiers with template arguments such as \"A<X,Y>\" in C++." (if (c-lang-const c-after-id-concat-ops) (concat "\\(" - (c-make-keywords-re 'appendable + (c-make-keywords-re t (c-lang-const c-after-id-concat-ops)) (concat ;; For flexibility, consider the symbol match @@ -1056,6 +1057,13 @@ e.g. identifiers with template arguments such as \"A<X,Y>\" in C++." ""))) (c-lang-defvar c-identifier-key (c-lang-const c-identifier-key)) +(c-lang-defconst c-annotation-re + "Regexp that matches the first token of an annotation or nil. +Currently only used in Java Mode." + t nil + java "\\_<@[[:alnum:]]+\\_>") +(c-lang-defvar c-annotation-re (c-lang-const c-annotation-re)) + (c-lang-defconst c-module-name-re "This regexp matches (a component of) a module name. Currently (2022-09) just C++ Mode uses this." @@ -1174,7 +1182,7 @@ string message." (c-lang-defconst c-cpp-message-directives-re ;; Appendable regexp matching any of the tokens in `c-cpp-message-directives'. - t (c-make-keywords-re 'appendable (c-lang-const c-cpp-message-directives))) + t (c-make-keywords-re t (c-lang-const c-cpp-message-directives))) (c-lang-defconst noncontinued-line-end t "\\(\\=\\|\\(\\=\\|[^\\]\\)[\n\r]\\)") @@ -1212,8 +1220,7 @@ file name in angle brackets or quotes." (c-lang-const c-cpp-include-directives)) (concat (c-lang-const c-anchored-cpp-prefix) - (c-make-keywords-re 'appendable - (c-lang-const c-cpp-include-directives)) + (c-make-keywords-re t (c-lang-const c-cpp-include-directives)) "[ \t]*") regexp-unmatchable)) (c-lang-defvar c-cpp-include-key (c-lang-const c-cpp-include-key)) @@ -1825,7 +1832,7 @@ This doesn't count the merely contextual bits of the regexp match." t nil c++ '("...")) (c-lang-defconst c-pack-key - t (c-make-keywords-re 'appendable (c-lang-const c-pack-ops))) + t (c-make-keywords-re t (c-lang-const c-pack-ops))) (c-lang-defvar c-pack-key (c-lang-const c-pack-key)) (c-lang-defconst c-auto-ops @@ -2260,8 +2267,8 @@ This works in Emacs >= 25.1." (c-lang-defconst c-paragraph-start "Regexp to append to `paragraph-start'." t "$" - java "\\(@[a-zA-Z]+\\>\\|$\\)" ; For Javadoc. - pike "\\(@[a-zA-Z_-]+\\>\\([^{]\\|$\\)\\|$\\)") ; For Pike refdoc. + java "\\(@[a-zA-Z]+\\_>\\|$\\)" ; For Javadoc. + pike "\\(@[a-zA-Z_-]+\\_>\\([^{]\\|$\\)\\|$\\)") ; For Pike refdoc. (c-lang-defvar c-paragraph-start (c-lang-const c-paragraph-start)) (c-lang-defconst c-paragraph-separate @@ -2796,12 +2803,9 @@ Not to be confused with `c-requires-clause-kwds'." c++ '("requires")) (c-lang-defconst c-fun-name-substitute-key - ;; An unadorned regular expression which matches any member of + ;; An adorned regular expression which matches any member of ;; `c-fun-name-substitute-kwds'. t (c-make-keywords-re t (c-lang-const c-fun-name-substitute-kwds))) -;; We use 'appendable, so that we get "\\>" on the regexp, but without a further -;; character, which would mess up backward regexp search from just after the -;; keyword. If only XEmacs had \\_>. ;-( (c-lang-defvar c-fun-name-substitute-key (c-lang-const c-fun-name-substitute-key)) @@ -2814,7 +2818,6 @@ This should not be confused with `c-fun-name-substitute-kwds'." (c-lang-defconst c-requires-clause-key ;; A regexp matching any member of `c-requires-clause-kwds'. t (c-make-keywords-re t (c-lang-const c-requires-clause-kwds))) -;; See `c-fun-name-substitute-key' for the justification of appendable. (c-lang-defvar c-requires-clause-key (c-lang-const c-requires-clause-key)) (c-lang-defconst c-modifier-kwds @@ -3499,7 +3502,7 @@ Note that Java specific rules are currently applied to tell this from (c-lang-defconst c-brace-stack-thing-key ;; Regexp matching any keyword or operator relevant to the brace stack (see ;; `c-update-brace-stack' in cc-engine.el). - t (c-make-keywords-re 'appendable + t (c-make-keywords-re t (append (c-lang-const c-flat-decl-block-kwds) (if (c-lang-const c-recognize-<>-arglists) @@ -3511,7 +3514,7 @@ Note that Java specific rules are currently applied to tell this from ;; Regexp matching any keyword or operator relevant to the brace stack when ;; a semicolon is not relevant (see `c-update-brace-stack' in ;; cc-engine.el). - t (c-make-keywords-re 'appendable + t (c-make-keywords-re t (append (c-lang-const c-flat-decl-block-kwds) (if (c-lang-const c-recognize-<>-arglists) @@ -3627,7 +3630,7 @@ Note that Java specific rules are currently applied to tell this from (c-lang-defconst c-stmt-block-only-keywords-regexp ;; A regexp matching a keyword in `c-stmt-block-only-keywords'. Such a ;; match can start and end only at token boundaries. - t (concat "\\(\\<\\|\\=\\)" + t (concat "\\(\\_<\\|\\=\\)" (c-make-keywords-re t (c-lang-const c-stmt-block-only-keywords)))) (c-lang-defvar c-stmt-block-only-keywords-regexp (c-lang-const c-stmt-block-only-keywords-regexp)) @@ -3684,12 +3687,9 @@ Note that Java specific rules are currently applied to tell this from ;; Emacs has an odd bug that causes `mapcan' to fail ;; with unintelligible errors. (XEmacs works.) ;; (2015-06-24): This bug has not yet been fixed. - ;;(mapcan (lambda (lang-const) - ;; (list lang-const t)) - ;; lang-const-list) - (apply 'nconc (mapcar (lambda (lang-const) - (list lang-const t)) - lang-const-list)))) + (c--mapcan (lambda (lang-const) + (list lang-const t)) + lang-const-list))) obarray)) (c-lang-defconst c-regular-keywords-regexp @@ -4073,16 +4073,13 @@ possible for good performance." (c-lang-defconst c-type-decl-prefix-keywords-key ;; Regexp matching any keyword operator that might precede the identifier in - ;; a declaration, e.g. "const" or nil. It doesn't test there is no "_" - ;; following the keyword. + ;; a declaration, e.g. "const" or nil. t (if (or (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds)) - (concat (regexp-opt (c--delete-duplicates (append (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds)) :test 'string-equal) - t) - "\\>"))) + 'symbols))) (c-lang-defconst c-maybe-typeless-specifier-re "Regexp matching keywords which might, but needn't, declare variables with @@ -4100,16 +4097,14 @@ The operator found is either the first submatch (if it is not a keyword) or the second submatch (if it is)." t (if (c-lang-const c-type-decl-prefix-keywords-key) (concat "\\(\\`a\\`\\)\\|" ; 1 - will never match. - (c-lang-const c-type-decl-prefix-keywords-key) ; 2 - "\\([^_]\\|$\\)") ; 3 + (c-lang-const c-type-decl-prefix-keywords-key)) ; 2 "\\`a\\`") ;; Default to a regexp that never matches. ;; Check that there's no "=" afterwards to avoid matching tokens ;; like "*=". (c objc) (concat "\\(" ; 1 "[*(]" "\\)\\|" - (c-lang-const c-type-decl-prefix-keywords-key) ; 2 - "\\([^=_]\\|$\\)") ; 3 + (c-lang-const c-type-decl-prefix-keywords-key)) ; 2 c++ (concat "\\(" ; 1 "&&" "\\|" @@ -4124,10 +4119,10 @@ keyword) or the second submatch (if it is)." ;; `c-font-lock-declarators' and ;; `c-font-lock-declarations' that check for a ;; complete name followed by ":: *". - (c-lang-const c-identifier-start) + (c-lang-const c-identifier-start) ; 5 "\\)") - "\\)" - "\\([^=_]\\|$\\)") ; 5 + "\\)" ; 2 + "\\([^=_]\\|$\\)") ; 6 pike "\\(\\*\\)\\([^=]\\|$\\)") (c-lang-defvar c-type-decl-prefix-key (c-lang-const c-type-decl-prefix-key) @@ -4167,7 +4162,7 @@ is in effect when this is matched (see `c-identifier-syntax-table')." ;; function argument list parenthesis. t (if (c-lang-const c-type-modifier-kwds) (concat "\\((\\|" - (regexp-opt (c-lang-const c-type-modifier-kwds) t) "\\>" + (regexp-opt (c-lang-const c-type-modifier-kwds) 'symbols) "\\)") "\\((\\)") (c c++ objc) (concat @@ -4182,8 +4177,7 @@ is in effect when this is matched (see `c-identifier-syntax-table')." (regexp-opt (append (c-lang-const c-fun-name-substitute-kwds) (c-lang-const c-type-modifier-kwds)) - t) - "\\>") + 'symbols)) "") "\\)") java "\\([[()]\\)" @@ -4261,8 +4255,8 @@ is in effect or not." ;; Regexp matching the known type identifiers. This is initialized ;; from the type keywords and `*-font-lock-extra-types'. The first ;; submatch is the one that matches the type. Note that this regexp - ;; assumes that symbol constituents like '_' and '$' have word - ;; syntax. + ;; assumes that symbol constituents like '_' and '$' have word or + ;; symbol syntax. (let* ((extra-types (when (boundp (c-mode-symbol "font-lock-extra-types")) (c-mode-var "font-lock-extra-types"))) @@ -4276,14 +4270,14 @@ is in effect or not." (unless (string-match "[][.*+?^$\\]" re) re)) extra-types)))) - (concat "\\<\\(" + (concat "\\_<\\(" (c-concat-separated (append (list (c-make-keywords-re nil (append (c-lang-const c-primitive-type-kwds) plain-strings))) regexp-strings) "\\|") - "\\)\\>"))) + "\\)\\_>"))) (c-lang-defconst c-special-brace-lists "List of open- and close-chars that makes up a pike-style brace list, @@ -4370,9 +4364,7 @@ the invalidity of the putative template construct." ;; needed. t (if (c-lang-const c-enum-list-kwds) (concat - "\\<\\(" - (c-make-keywords-re nil (c-lang-const c-enum-list-kwds)) - "\\)\\>" + (c-make-keywords-re t (c-lang-const c-enum-list-kwds)) ;; Disallow various common punctuation chars that can't come ;; before the '{' of the enum list, to avoid searching too far. "[^][{};/#=]*" diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index b3c50aa04d9..9881617e20f 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -85,13 +85,13 @@ A sample value might look like: `\\(_P\\|_PROTO\\)'.") ;; work by backtracking from the end of the definition. (nil ,(concat - "^\\<.*" - "[^" c-alnum "_:<>~]" ; match any non-identifier char - ; (note: this can be `\n') + "^\\_<.*" + "[^" c-alnum "_:<>~]" ; match any non-identifier char + ; (note: this can be `\n') "\\(" "\\([" c-alnum "_:<>~]*::\\)?" ; match an operator - "operator\\>[ \t]*" - "\\(()\\|[^(]*\\)" ; special case for `()' operator + "operator\\_>[ \t]*" + "\\(()\\|[^(]*\\)" ; special case for `()' operator "\\)" "[ \t]*([^)]*)[ \t]*[^ \t;]" ; followed by ws, arg list, @@ -116,7 +116,7 @@ A sample value might look like: `\\(_P\\|_PROTO\\)'.") ;; General function name regexp (nil ,(concat - "^\\<" ; line MUST start with word char + "^\\_<" ; line MUST start with symbol char ;; \n added to prevent overflow in regexp matcher. ;; https://lists.gnu.org/r/emacs-pretest-bug/2007-02/msg00021.html "[^()\n]*" ; no parentheses before @@ -136,7 +136,7 @@ A sample value might look like: `\\(_P\\|_PROTO\\)'.") ,@(if cc-imenu-c-prototype-macro-regexp `((nil ,(concat - "^\\<.*" ; line MUST start with word char + "^\\_<.*" ; line MUST start with symbol char "[^" c-alnum "_]" ; match any non-identifier char "\\([" c-alpha "_][" c-alnum "_]*\\)" ; match function name "[ \t]*" ; whitespace before macro name diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 2b62ace76bf..4df6017bc56 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1765,8 +1765,7 @@ this implicitly by reinitializing C/C++/Objc Mode on any buffer)." (setq c-noise-macro-with-parens-name-re (cond ((null c-noise-macro-with-parens-names) regexp-unmatchable) ((consp c-noise-macro-with-parens-names) - (concat (regexp-opt c-noise-macro-with-parens-names t) - "\\([^[:alnum:]_$]\\|$\\)")) + (regexp-opt c-noise-macro-with-parens-names 'symbols)) ((stringp c-noise-macro-with-parens-names) (copy-sequence c-noise-macro-with-parens-names)) (t (error "c-make-noise-macro-regexps: \ @@ -1774,8 +1773,7 @@ c-noise-macro-with-parens-names is invalid: %s" c-noise-macro-with-parens-names) (setq c-noise-macro-name-re (cond ((null c-noise-macro-names) regexp-unmatchable) ((consp c-noise-macro-names) - (concat (regexp-opt c-noise-macro-names t) - "\\([^[:alnum:]_$]\\|$\\)")) + (regexp-opt c-noise-macro-names 'symbols)) ((stringp c-noise-macro-names) (copy-sequence c-noise-macro-names)) (t (error "c-make-noise-macro-regexps: \ @@ -1819,11 +1817,7 @@ variables.") ((stringp c-macro-names-with-semicolon) (copy-sequence c-macro-names-with-semicolon)) ((consp c-macro-names-with-semicolon) - (concat - "\\<" - (regexp-opt c-macro-names-with-semicolon) - "\\>")) ; N.B. the PAREN param of regexp-opt isn't supported by - ; all XEmacsen. + (regexp-opt c-macro-names-with-semicolon 'symbols)) ((null c-macro-names-with-semicolon) nil) (t (error "c-make-macro-with-semi-re: Invalid \ diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index d5008fcc102..2f2d1b6e2a0 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -24,11 +24,11 @@ ;;; Tree-sitter language versions ;; -;; cmake-ts-mode is known to work with the following languages and version: +;; cmake-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-cmake: v0.5.0-5-ge409ae3 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -42,7 +42,8 @@ (add-to-list 'treesit-language-source-alist - '(cmake "https://github.com/uyha/tree-sitter-cmake" "v0.5.0") + '(cmake "https://github.com/uyha/tree-sitter-cmake" + :commit "e409ae33f00e04cde30f2bcffb979caf1a33562a") t) (defcustom cmake-ts-mode-indent-offset 2 diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index bec94eed35c..958ccf05672 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -651,7 +651,8 @@ compilation and evaluation time conflicts." (add-to-list 'treesit-language-source-alist - '(c-sharp "https://github.com/tree-sitter/tree-sitter-c-sharp" "v0.23.1") + '(c-sharp "https://github.com/tree-sitter/tree-sitter-c-sharp" + :commit "362a8a41b265056592a0c3771664a21d23a71392") t) (defcustom csharp-ts-mode-indent-offset 4 diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index 5dcc5704c34..fe0c9e23acc 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -24,11 +24,11 @@ ;;; Tree-sitter language versions ;; -;; dockerfile-ts-mode is known to work with the following languages and version: +;; dockerfile-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-dockerfile: v0.2.0-1-g087daa2 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -42,7 +42,8 @@ (add-to-list 'treesit-language-source-alist - '(dockerfile "https://github.com/camdencheek/tree-sitter-dockerfile" "v0.2.0") + '(dockerfile "https://github.com/camdencheek/tree-sitter-dockerfile" + :commit "087daa20438a6cc01fa5e6fe6906d77c869d19fe") t) (defvar dockerfile-ts-mode--syntax-table diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 5a43d494e56..4a7c525003c 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -275,7 +275,8 @@ automatically)." (tuareg-mode :language-id "ocaml") reason-mode) . ("ocamllsp")) ((ruby-mode ruby-ts-mode) - . ("solargraph" "socket" "--port" :autoport)) + . ,(eglot-alternatives + '(("solargraph" "socket" "--port" :autoport) "ruby-lsp"))) (haskell-mode . ("haskell-language-server-wrapper" "--lsp")) (elm-mode . ("elm-language-server")) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index e3b17f9b4fc..aa2daf6820a 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -106,15 +106,6 @@ All commands in `lisp-mode-shared-map' are inherited by this map." :help "Go to the start of the current function definition"] ["Up List" up-list :help "Go one level up and forward"]) - ("Linting" - ["Lint Defun" elint-defun - :help "Lint the function at point"] - ["Lint Buffer" elint-current-buffer - :help "Lint the current buffer"] - ["Lint File..." elint-file - :help "Lint a file"] - ["Lint Directory..." elint-directory - :help "Lint a directory"]) ("Profiling" ;; Maybe this should be in a separate submenu from the ELP stuff? ["Start Native Profiler..." profiler-start diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index d1a78ca1018..8b43c032424 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -23,12 +23,12 @@ ;;; Tree-sitter language versions ;; -;; elixir-ts-mode is known to work with the following languages and version: -;; - tree-sitter-heex: v0.7.0 +;; elixir-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-elixir: v0.3.3 +;; - tree-sitter-heex: v0.7.0 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -59,11 +59,13 @@ (add-to-list 'treesit-language-source-alist - '(elixir "https://github.com/elixir-lang/tree-sitter-elixir" "v0.3.3") + '(elixir "https://github.com/elixir-lang/tree-sitter-elixir" + :commit "02a6f7fd4be28dd94ee4dd2ca19cb777053ea74e") t) (add-to-list 'treesit-language-source-alist - '(heex "https://github.com/phoenixframework/tree-sitter-heex" "v0.7.0") + '(heex "https://github.com/phoenixframework/tree-sitter-heex" + :commit "f6b83f305a755cd49cf5f6a66b2b789be93dc7b9") t) (defgroup elixir-ts nil diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 8cabaa9f34d..e8e4c9af29d 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -24,13 +24,13 @@ ;;; Tree-sitter language versions ;; -;; go-ts-mode is known to work with the following languages and version: +;; go-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-go: v0.23.4-1-g12fe553 ;; - tree-sitter-go-mod: v1.1.0-3b01edce ;; - tree-sitter-go-work: 949a8a47 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -48,15 +48,18 @@ (add-to-list 'treesit-language-source-alist - '(go "https://github.com/tree-sitter/tree-sitter-go" "v0.23.4") + '(go "https://github.com/tree-sitter/tree-sitter-go" + :commit "12fe553fdaaa7449f764bc876fd777704d4fb752") t) (add-to-list 'treesit-language-source-alist - '(gomod "https://github.com/camdencheek/tree-sitter-go-mod" "v1.1.0") + '(gomod "https://github.com/camdencheek/tree-sitter-go-mod" + :commit "3b01edce2b9ea6766ca19328d1850e456fde3103") t) (add-to-list 'treesit-language-source-alist - '(gowork "https://github.com/omertuc/tree-sitter-go-work") + '(gowork "https://github.com/omertuc/tree-sitter-go-work" + :commit "949a8a470559543857a62102c84700d291fc984c") t) (defcustom go-ts-mode-indent-offset 8 diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el index 08c9019e6bc..c478750a73e 100644 --- a/lisp/progmodes/heex-ts-mode.el +++ b/lisp/progmodes/heex-ts-mode.el @@ -23,11 +23,12 @@ ;;; Tree-sitter language versions ;; -;; heex-ts-mode is known to work with the following languages and version: +;; heex-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-heex: v0.7.0 +;; - tree-sitter-elixir: v0.3.3 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -46,11 +47,13 @@ (add-to-list 'treesit-language-source-alist - '(heex "https://github.com/phoenixframework/tree-sitter-heex" "v0.7.0") + '(heex "https://github.com/phoenixframework/tree-sitter-heex" + :commit "f6b83f305a755cd49cf5f6a66b2b789be93dc7b9") t) (add-to-list 'treesit-language-source-alist - '(elixir "https://github.com/elixir-lang/tree-sitter-elixir" "v0.3.3") + '(elixir "https://github.com/elixir-lang/tree-sitter-elixir" + :commit "02a6f7fd4be28dd94ee4dd2ca19cb777053ea74e") t) (defgroup heex-ts nil diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index d48d6b45927..0fe35a4df8b 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -24,11 +24,11 @@ ;;; Tree-sitter language versions ;; -;; java-ts-mode is known to work with the following languages and version: +;; java-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-java: v0.23.5 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -45,11 +45,13 @@ (add-to-list 'treesit-language-source-alist - '(java "https://github.com/tree-sitter/tree-sitter-java" "v0.23.5") + '(java "https://github.com/tree-sitter/tree-sitter-java" + :commit "94703d5a6bed02b98e438d7cad1136c01a60ba2c") t) (add-to-list 'treesit-language-source-alist - '(doxygen "https://github.com/tree-sitter-grammars/tree-sitter-doxygen" "v1.1.0") + '(doxygen "https://github.com/tree-sitter-grammars/tree-sitter-doxygen" + :commit "1e28054cb5be80d5febac082706225e42eff14e6") t) (defcustom java-ts-mode-indent-offset 4 diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 44a1714b02f..bed2ef0616a 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -26,12 +26,12 @@ ;;; Tree-sitter language versions ;; -;; js-ts-mode is known to work with the following languages and version: +;; js-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-jsdoc: v0.23.2 ;; - tree-sitter-javascript: v0.23.1-2-g108b2d4 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -3410,11 +3410,13 @@ This function is intended for use in `after-change-functions'." (add-to-list 'treesit-language-source-alist - '(javascript "https://github.com/tree-sitter/tree-sitter-javascript" "v0.23.1") + '(javascript "https://github.com/tree-sitter/tree-sitter-javascript" + :commit "108b2d4d17a04356a340aea809e4dd5b801eb40d") t) (add-to-list 'treesit-language-source-alist - '(jsdoc "https://github.com/tree-sitter/tree-sitter-jsdoc" "v0.23.2") + '(jsdoc "https://github.com/tree-sitter/tree-sitter-jsdoc" + :commit "b253abf68a73217b7a52c0ec254f4b6a7bb86665") t) (defun js--treesit-font-lock-compatibility-definition-feature () @@ -4106,7 +4108,7 @@ See `treesit-thing-settings' for more information.") (treesit-major-mode-setup) (add-to-list 'auto-mode-alist - '("\\(\\.js[mx]\\|\\.har\\)\\'" . js-ts-mode)))) + '("\\(\\.js[mx]?\\|\\.har\\)\\'" . js-ts-mode)))) (derived-mode-add-parents 'js-ts-mode '(js-mode)) diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 11ec5d5c079..a18f3c342c0 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -24,11 +24,11 @@ ;;; Tree-sitter language versions ;; -;; json-ts-mode is known to work with the following languages and version: +;; json-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-json: v0.24.8-1-g4d770d3 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -42,7 +42,8 @@ (add-to-list 'treesit-language-source-alist - '(json "https://github.com/tree-sitter/tree-sitter-json" "v0.24.8") + '(json "https://github.com/tree-sitter/tree-sitter-json" + :commit "4d770d31f732d50d3ec373865822fbe659e47c75") t) (defcustom json-ts-mode-indent-offset 2 diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 8c2ff2ae7e0..5e58d4c071d 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -50,7 +50,8 @@ (add-to-list 'treesit-language-source-alist - '(lua "https://github.com/tree-sitter-grammars/tree-sitter-lua" "v0.3.0") + '(lua "https://github.com/tree-sitter-grammars/tree-sitter-lua" + :commit "db16e76558122e834ee214c8dc755b4a3edc82a9") t) (defgroup lua-ts nil diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el index e72c25acafc..4518d82cc37 100644 --- a/lisp/progmodes/peg.el +++ b/lisp/progmodes/peg.el @@ -5,6 +5,7 @@ ;; Author: Helmut Eller <eller.helmut@gmail.com> ;; Maintainer: Stefan Monnier <monnier@iro.umontreal.ca> ;; Version: 1.0.1 +;; Package-Requires: ((emacs "25")) ;; ;; 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 @@ -316,11 +317,15 @@ EXPS is a list of rules/expressions that failed.") "Match PEXS at point. PEXS is a sequence of PEG expressions, implicitly combined with `and'. Returns STACK if the match succeed and signals an error on failure, -moving point along the way." +moving point along the way. +For backward compatibility (and convenience) PEXS can also be a list of +RULES in which case we run the first such rule. In case of ambiguity, +prefix PEXS with \"\" so it doesn't look like a list of rules." (if (and (consp (car pexs)) (symbolp (caar pexs)) - (not (ignore-errors - (not (eq 'call (car (peg-normalize (car pexs)))))))) + (not (or (get (peg--rule-id (caar pexs)) 'peg--rule-definition) + (ignore-errors + (not (eq 'call (car (peg-normalize (car pexs))))))))) ;; The first of `pexs' has not been defined as a rule, so assume ;; that none of them have been and they should be fed to ;; `with-peg-rules' @@ -934,7 +939,8 @@ input. PATH is the list of rules that we have visited so far." (cl-adjoin `(not ,x) merged :test #'equal)) (cl-defmethod peg--merge-error (merged (_ (eql action)) _action) merged) -(cl-defmethod peg--merge-error (merged (_ (eql null))) merged) +(cl-defmethod peg--merge-error (merged (_ (eql guard)) e) + (if (eq e t) merged (cl-adjoin `(guard ,e) merged :test #'equal))) (provide 'peg) (require 'peg) diff --git a/lisp/progmodes/php-ts-mode.el b/lisp/progmodes/php-ts-mode.el index f5a56e29797..a01e4d66fba 100644 --- a/lisp/progmodes/php-ts-mode.el +++ b/lisp/progmodes/php-ts-mode.el @@ -24,8 +24,8 @@ ;;; Tree-sitter language versions ;; -;; php-ts-mode is known to work with the following languages and version: -;; - tree-sitter-phpdoc: fe3202e468bc17332bec8969f2b50ff1f1da3a46 +;; php-ts-mode has been tested with the following grammars and version: +;; - tree-sitter-phpdoc: v0.1.5 ;; - tree-sitter-css: v0.23.1-1-g6a442a3 ;; - tree-sitter-jsdoc: v0.23.2 ;; - tree-sitter-javascript: v0.23.1-2-g108b2d4 @@ -33,7 +33,7 @@ ;; - tree-sitter-php: v0.23.11 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -82,8 +82,11 @@ ;;; Install treesitter language parsers (defvar php-ts-mode--language-source-alist - '((php "https://github.com/tree-sitter/tree-sitter-php" "v0.23.11" "php/src") - (phpdoc "https://github.com/claytonrcarter/tree-sitter-phpdoc")) + '((php "https://github.com/tree-sitter/tree-sitter-php" + :commit "43aad2b9a98aa8e603ea0cf5bb630728a5591ad8" + :source-dir "php/src") + (phpdoc "https://github.com/claytonrcarter/tree-sitter-phpdoc" + :commit "fe3202e468bc17332bec8969f2b50ff1f1da3a46")) "Treesitter language parsers required by `php-ts-mode'. You can customize `treesit-language-source-alist' if you want to stick to a specific commit and/or use different parsers.") @@ -139,7 +142,7 @@ Works like `css--fontify-region'." (defvar-local php-ts-mode-alternative-php-program-name nil "An alternative to the usual `php' program name. -In non-nil, `php-ts-mode--executable' try to find this executable.") +If non-nil, `php-ts-mode--executable' looks for this instead of \"php\".") (defcustom php-ts-mode-php-config nil "The location of php.ini file. @@ -311,7 +314,7 @@ Calls REPORT-FN directly." "Return the absolute filename of the php executable. If the `default-directory' is remote, search on a remote host, otherwise it searches locally. If `php-ts-mode-alternative-php-program-name' is -non-zero, it searches for this program instead of the usual `php'. +non-nil, it searches for this program instead of the usual `php'. If the search fails, it returns `php-ts-mode-php-default-executable'." (or (executable-find (or php-ts-mode-alternative-php-program-name "php") t) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 5cf9a68a294..68179206017 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -321,12 +321,16 @@ end it with `/'. DIR must be either `project-root' or one of grep-find-ignored-files))) (defun project--file-completion-table (all-files) + (project--completion-table-with-category all-files 'project-file)) + +;; Switch to `completion-table-with-metadata' when we can. +(defun project--completion-table-with-category (table category) (lambda (string pred action) (cond ((eq action 'metadata) - '(metadata . ((category . project-file)))) + `(metadata . ((category . ,category)))) (t - (complete-with-action action all-files string pred))))) + (complete-with-action action table string pred))))) (cl-defmethod project-root ((project (head transient))) (cdr project)) @@ -1562,6 +1566,24 @@ 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)) + :version "31.1" + :group 'project) + +(defun project-prune-zombies-default (project) + "Default function used in `project-prune-zombie-projects'. +Return non-nil if PROJECT is not a remote project." + (not (file-remote-p project))) + (defun project--read-project-buffer () (let* ((pr (project-current t)) (current-buffer (current-buffer)) @@ -1580,12 +1602,20 @@ general form of conditions." uniquify-buffer-name-style) ;; Forgo the use of `buffer-read-function' (often nil) in ;; favor of uniquifying the buffers better. - (let* ((unique-names (uniquify-get-unique-names buffers)) + (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: " - unique-names + (project--completion-table-with-category + unique-names + 'buffer) predicate nil nil nil other-name))) @@ -1914,7 +1944,11 @@ With some possible metadata (to be decided).") (defun project--ensure-read-project-list () "Initialize `project--list' if it isn't already initialized." (when (eq project--list 'unset) - (project--read-project-list))) + (project--read-project-list) + (if-let* (project-prune-zombie-projects + ((consp project--list)) + (inhibit-message t)) + (project-forget-zombie-projects)))) (defun project--write-project-list () "Save `project--list' in `project-list-file'." @@ -1995,6 +2029,9 @@ see `project-list-file'. It's also possible to enter an arbitrary directory not in the list. When PROMPT is non-nil, use it as the prompt string." (project--ensure-read-project-list) + (if-let* (project-prune-zombie-projects + (inhibit-message t)) + (project-forget-zombie-projects)) (let* ((dir-choice "... (choose a dir)") (choices ;; XXX: Just using this for the category (for the substring @@ -2024,6 +2061,9 @@ The project is chosen among projects known from the project list, see `project-list-file'. It's also possible to enter an arbitrary directory not in the list. When PROMPT is non-nil, use it as the prompt string." + (if-let* (project-prune-zombie-projects + (inhibit-message t)) + (project-forget-zombie-projects)) (let* ((dir-choice "... (choose a dir)") project--name-history (choices @@ -2153,7 +2193,10 @@ Return the number of detected projects." "Forget all known projects that don't exist any more." (interactive) (dolist (proj (project-known-project-roots)) - (unless (file-exists-p proj) + (when (and (if project-prune-zombie-projects + (funcall project-prune-zombie-projects proj) + t) + (not (file-exists-p proj))) (project-forget-project proj)))) (defun project-forget-projects-under (dir &optional recursive) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3b83c5d3319..f4f0518dbfd 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -271,12 +271,14 @@ (add-to-list 'treesit-language-source-alist - '(python "https://github.com/tree-sitter/tree-sitter-python" "v0.23.6") + '(python "https://github.com/tree-sitter/tree-sitter-python" + :commit "bffb65a8cfe4e46290331dfef0dbf0ef3679de11") t) ;; Avoid compiler warnings (defvar compilation-error-regexp-alist) (defvar outline-heading-end-regexp) +(defvar treesit-thing-settings) (autoload 'comint-mode "comint") (autoload 'help-function-arglist "help-fns") @@ -1236,6 +1238,7 @@ fontified." (parameters (identifier) @font-lock-variable-name-face) (parameters (typed_parameter (identifier) @font-lock-variable-name-face)) (parameters (default_parameter name: (identifier) @font-lock-variable-name-face)) + (parameters (typed_default_parameter name: (identifier) @font-lock-variable-name-face)) (lambda_parameters (identifier) @font-lock-variable-name-face) (for_in_clause left: (identifier) @font-lock-variable-name-face) @@ -1266,7 +1269,11 @@ fontified." :feature 'function :language 'python - '((call function: (identifier) @font-lock-function-call-face) + '(((call function: (identifier) @font-lock-type-face) + (:match "\\`[A-Z][A-Za-z0-9]+\\'" @font-lock-type-face)) + (call function: (identifier) @font-lock-function-call-face) + (call arguments: (argument_list (keyword_argument + name: (identifier) @font-lock-property-name-face))) (call function: (attribute attribute: (identifier) @font-lock-function-call-face))) @@ -6116,13 +6123,34 @@ tree-sitter." (defvar python--thing-settings `((python (defun ,(rx (or "function" "class") "_definition")) - (sexp ,(rx (or "expression" - "string" - "call" - "operator" - "identifier" - "integer" - "float"))) + (sexp (not (or (and named + ,(rx bos (or "module" + "block" + "comment") + eos)) + (and anonymous + ,(rx bos (or "(" ")" "[" "]" "{" "}" ",") + eos))))) + (list ,(rx bos (or "parameters" + "type_parameter" + "parenthesized_list_splat" + "argument_list" + "_list_pattern" + "_tuple_pattern" + "dict_pattern" + "tuple_pattern" + "list_pattern" + "list" + "set" + "tuple" + "dictionary" + "list_comprehension" + "dictionary_comprehension" + "set_comprehension" + "generator_expression" + "parenthesized_expression" + "interpolation") + eos)) (sentence ,(rx (or "statement" "clause"))) (text ,(rx (or "string" "comment"))))) @@ -7348,8 +7376,11 @@ implementations: `python-mode' and `python-ts-mode'." (setq-local treesit-defun-name-function #'python--treesit-defun-name) - (setq treesit-thing-settings python--thing-settings) + (setq-local treesit-thing-settings python--thing-settings) (treesit-major-mode-setup) + ;; Enable the `sexp' navigation by default + (setq-local forward-sexp-function #'treesit-forward-sexp + treesit-sexp-thing 'sexp) (setq-local syntax-propertize-function #'python--treesit-syntax-propertize) diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 0ab9f30d70d..35da7e0ca02 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -24,11 +24,11 @@ ;;; Tree-sitter language versions ;; -;; ruby-ts-mode is known to work with the following languages and version: +;; ruby-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-ruby: v0.23.1 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -125,7 +125,8 @@ (add-to-list 'treesit-language-source-alist - '(ruby "https://github.com/tree-sitter/tree-sitter-ruby" "v0.23.1") + '(ruby "https://github.com/tree-sitter/tree-sitter-ruby" + :commit "71bd32fb7607035768799732addba884a37a6210") t) (defgroup ruby-ts nil diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 9d2450baa90..f0a716d25b5 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -24,11 +24,11 @@ ;;; Tree-sitter language versions ;; -;; rust-ts-mode is known to work with the following languages and version: -;; - tree-sitter-rust: v0.23.2-1-g1f63b33 +;; rust-ts-mode has been tested with the following grammars and version: +;; - tree-sitter-rust: v0.24.0 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -44,8 +44,10 @@ (add-to-list 'treesit-language-source-alist `(rust "https://github.com/tree-sitter/tree-sitter-rust" - ,(when (treesit-available-p) - (if (< (treesit-library-abi-version) 15) "v0.23.2" "v0.24.0"))) + :commit ,(if (and (treesit-available-p) + (< (treesit-library-abi-version) 15)) + "1f63b33efee17e833e0ea29266dd3d713e27e321" + "18b0515fca567f5a10aee9978c6d2640e878671a")) t) (defcustom rust-ts-mode-indent-offset 4 diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index dabef95463c..1ef204683b4 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -3267,7 +3267,8 @@ member of `flymake-diagnostic-functions'." (add-to-list 'treesit-language-source-alist - '(bash "https://github.com/tree-sitter/tree-sitter-bash" "v0.23.3") + '(bash "https://github.com/tree-sitter/tree-sitter-bash" + :commit "487734f87fd87118028a65a4599352fa99c9cde8") t) (defvar sh-mode--treesit-operators diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 6c381c8d777..e93fd8066ce 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -24,11 +24,14 @@ ;;; Tree-sitter language versions ;; -;; typescript-ts-mode is known to work with the following languages and version: +;; typescript-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-typescript: v0.23.2-2-g8e13e1d ;; +;; tsx-ts-mode has been tested with the following grammars and version: +;; - tree-sitter-tsx: v0.23.2-2-g8e13e1d +;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -45,14 +48,16 @@ (add-to-list 'treesit-language-source-alist '(typescript - "https://github.com/tree-sitter/tree-sitter-typescript" "v0.23.2" - "typescript/src") + "https://github.com/tree-sitter/tree-sitter-typescript" + :commit "8e13e1db35b941fc57f2bd2dd4628180448c17d5" + :source-dir "typescript/src") t) (add-to-list 'treesit-language-source-alist '(tsx - "https://github.com/tree-sitter/tree-sitter-typescript" "v0.23.2" - "tsx/src") + "https://github.com/tree-sitter/tree-sitter-typescript" + :commit "8e13e1db35b941fc57f2bd2dd4628180448c17d5" + :source-dir "tsx/src") t) (defcustom typescript-ts-mode-indent-offset 2 diff --git a/lisp/recentf.el b/lisp/recentf.el index 006b3159bb9..d641250f017 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -330,6 +330,15 @@ t means show messages that were printed by default on Emacs <= 31.1." :group 'recentf :type 'boolean :version "31.1") + +(defcustom recentf-suppress-open-file-help nil + "If non-nil, suppress help messages in recentf open file dialogs. +By default, opening the dialog interactively and tabbing between items +shows help messages. (In any case, a tooltip displays the help text +when the mouse pointer hovers over an item)." + :group 'recentf + :type 'boolean + :version "31.1") ;;; Utilities ;; @@ -1101,15 +1110,38 @@ IGNORE arguments." Go to the beginning of buffer if not found." (goto-char (point-min)) (condition-case nil - (let (done) - (widget-move 1) + (let ((no-echo (or recentf-suppress-open-file-help + ;; Show help messages by default only when + ;; invoking these interactively (bug#78666). + (not (memq this-command '(recentf-open-files + recentf-open-more-files + recentf-forward + recentf-backward))))) + done) + (widget-move 1 no-echo) (while (not done) (if (eq widget-type (widget-type (widget-at (point)))) (setq done t) - (widget-move 1)))) + (widget-move 1 no-echo)))) (error (goto-char (point-min))))) +(defun recentf-forward (arg) + "Move the cursor to the next widget in the current dialog. +With prefix argument ARG, move to the ARGth next widget. If +`recentf-suppress-open-file-help' is non-nil, suppress help messages in +the echo area in the open recentf dialog." + (interactive "p") + (widget-forward arg recentf-suppress-open-file-help)) + +(defun recentf-backward (arg) + "Move the cursor to the previous widget in the current dialog. +With prefix argument ARG, move to the ARGth previous widget. If +`recentf-suppress-open-file-help' is non-nil, suppress help messages in +the echo area in the open recentf dialog." + (interactive "p") + (widget-backward arg recentf-suppress-open-file-help)) + (defvar-keymap recentf-dialog-mode-map :doc "Keymap used in recentf dialogs." :parent (make-composed-keymap recentf--shortcuts-keymap widget-keymap) @@ -1141,6 +1173,8 @@ Go to the beginning of buffer if not found." (recentf-dialog-mode) ,@forms (widget-setup) + (keymap-local-set "<remap> <widget-forward>" #'recentf-forward) + (keymap-local-set "<remap> <widget-backward>" #'recentf-backward) (switch-to-buffer (current-buffer)))) ;;; Edit list dialog diff --git a/lisp/replace.el b/lisp/replace.el index 9939273594f..358f073c2c2 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2448,19 +2448,21 @@ To be added to `context-menu-functions'." "Type \\`SPC' or \\`y' to replace one match, Delete or \\`n' to skip to next, \\`RET' or \\`q' to exit, Period to replace one match and exit, \\`,' to replace but not move point immediately, -\\`C-r' to enter recursive edit (\\[exit-recursive-edit] to get out again), -\\`C-w' to delete match and recursive edit, -\\`C-l' to clear the screen, redisplay, and offer same replacement again, \\`!' to replace all remaining matches in this buffer with no more questions, +\\`C-r' to enter recursive edit (\\[exit-recursive-edit] to get out again), +\\`C-w' to delete match and then enter recursive edit, \\`^' to move point back to previous match, \\`u' to undo previous replacement, \\`U' to undo all replacements, \\`e' to edit the replacement string. \\`E' to edit the replacement string with exact case. -In multi-buffer replacements type \\`Y' to replace all remaining -matches in all remaining buffers with no more questions, -\\`N' to skip to the next buffer without replacing remaining matches -in the current buffer." +\\`C-l' to clear the screen, redisplay, and offer same replacement again, +\\`Y' to replace all remaining matches in all remaining buffers (in +multi-buffer replacements) with no more questions, +\\`N' (in multi-buffer replacements) to skip to the next buffer without +replacing remaining matches in the current buffer. +Any other character exits interactive replacement loop and is then +re-executed as a normal key sequence." "Help message while in `query-replace'.") (defvar query-replace-map diff --git a/lisp/startup.el b/lisp/startup.el index 3d38f68098b..65cf4627b60 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -361,7 +361,8 @@ This file is loaded at run-time before `user-init-file'. It contains inits that need to be in place for the entire site, but which, due to their higher incidence of change, don't make sense to put into Emacs's dump file. Thus, the run-time load order is: 1. file described in -this variable, if non-nil; 2. `user-init-file'; 3. `default.el'. +this variable, if non-nil; 2. `early-init-file', 3. `user-init-file'; +4. `default.el'. Don't use the `site-start.el' file for things some users may not like. Put them in `default.el' instead, so that users can more easily @@ -1185,14 +1186,15 @@ This function is called from `load' via `load-path-filter-function'." (make-hash-table :test #'equal)))))) (if (null ht) path - (seq-filter - (lambda (dir) - (when (file-directory-p dir) - (try-completion - file - (with-memoization (gethash dir ht) - (directory-files dir nil rx t))))) - path))))) + (let ((completion-regexp-list nil)) + (seq-filter + (lambda (dir) + (when (file-directory-p dir) + (try-completion + file + (with-memoization (gethash dir ht) + (directory-files dir nil rx t))))) + path)))))) (defun command-line () "A subroutine of `normal-top-level'. @@ -1426,6 +1428,21 @@ please check its value") (setq xdg-dir (concat "~" init-file-user "/.config/emacs/")) (startup--xdg-or-homedot xdg-dir init-file-user))) + ;; Run the site-start library if it exists. + ;; This used to come after the early init file, but was moved here to + ;; make it possible for sites to do early init things on behalf of + ;; their users, such as adding to `package-directory-list'. + ;; This certainly has to come before loading the regular init file. + ;; Note that `user-init-file' is nil at this point. Code that might + ;; be loaded from `site-run-file' and wants to test if -q was given + ;; should check `init-file-user' instead, since that is already set. + ;; See cus-edit.el for an example. + (when site-run-file + ;; Sites should not disable the startup screen. + ;; Only individuals may disable the startup screen. + (let ((inhibit-startup-screen inhibit-startup-screen)) + (load site-run-file t t))) + ;; Load the early init file, if found. (startup--load-user-init-file (lambda () @@ -1537,20 +1554,7 @@ please check its value") (let ((old-scalable-fonts-allowed scalable-fonts-allowed) (old-face-ignored-fonts face-ignored-fonts)) - ;; Run the site-start library if it exists. The point of this file is - ;; that it is run before .emacs. There is no point in doing this after - ;; .emacs; that is useless. - ;; Note that user-init-file is nil at this point. Code that might - ;; be loaded from site-run-file and wants to test if -q was given - ;; should check init-file-user instead, since that is already set. - ;; See cus-edit.el for an example. - (if site-run-file - ;; Sites should not disable the startup screen. - ;; Only individuals should disable the startup screen. - (let ((inhibit-startup-screen inhibit-startup-screen)) - (load site-run-file t t))) - - ;; Load that user's init file, or the default one, or none. + ;; Load the user's init file, or the default one, or none. (startup--load-user-init-file (lambda () (cond diff --git a/lisp/subr.el b/lisp/subr.el index 729f8b3e09b..69f6e4dbab8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4645,8 +4645,6 @@ If AUTOLOAD is non-nil and F is autoloaded, try to load it in the hope that it will set PROP. If AUTOLOAD is `macro', do it only if it's an autoloaded macro." (declare (important-return-value t)) - (unless (symbolp f) - (signal 'wrong-type-argument (list 'symbolp f))) (let ((val nil)) (while (and (symbolp f) (null (setq val (get f prop))) @@ -5755,9 +5753,9 @@ the substrings between the splitting points are collected as a list, which is returned. If SEPARATORS is non-nil, it should be a regular expression matching text -that separates, but is not part of, the substrings. If nil it defaults to -`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and -OMIT-NULLS is forced to t. +that separates, but is not part of, the substrings. If omitted or nil, +it defaults to `split-string-default-separators', whose value is +normally \"[ \\f\\t\\n\\r\\v]+\", and OMIT-NULLS is then forced to t. If OMIT-NULLS is t, zero-length substrings are omitted from the list (so that for the default value of SEPARATORS leading and trailing whitespace @@ -5768,11 +5766,6 @@ If TRIM is non-nil, it should be a regular expression to match text to trim from the beginning and end of each substring. If trimming makes the substring empty, it is treated as null. -If you want to trim whitespace from the substrings, the reliably correct -way is using TRIM. Making SEPARATORS match that whitespace gives incorrect -results when there is whitespace at the start or end of STRING. If you -see such calls to `split-string', please fix them. - Note that the effect of `(split-string STRING)' is the same as `(split-string STRING split-string-default-separators t)'. In the rare case that you wish to retain zero-length substrings when splitting on @@ -5785,7 +5778,9 @@ Modifies the match data; use `save-match-data' if necessary." (start 0) this-start this-end notfirst + match-beg (list nil) + (strlen (length string)) (push-one ;; Push the substring in range THIS-START to THIS-END ;; onto LIST, trimming it and perhaps discarding it. @@ -5794,6 +5789,7 @@ Modifies the match data; use `save-match-data' if necessary." ;; Discard the trim from start of this substring. (let ((tem (string-match trim string this-start))) (and (eq tem this-start) + (<= (match-end 0) this-end) (setq this-start (match-end 0))))) (when (or keep-nulls (< this-start this-end)) @@ -5811,18 +5807,25 @@ Modifies the match data; use `save-match-data' if necessary." (while (and (string-match rexp string (if (and notfirst - (= start (match-beginning 0)) - (< start (length string))) + (= start match-beg) ; empty match + (< start strlen)) (1+ start) start)) - (< start (length string))) - (setq notfirst t) - (setq this-start start this-end (match-beginning 0) - start (match-end 0)) + (< start strlen)) + (setq notfirst t + match-beg (match-beginning 0)) + ;; If the separator is right at the beginning, produce an empty + ;; substring in the result list. + (if (= start match-beg) + (setq this-start (match-end 0) + this-end this-start) + ;; Otherwise produce a substring from start to the separator. + (setq this-start start this-end match-beg)) + (setq start (match-end 0)) (funcall push-one)) ;; Handle the substring at the end of STRING. - (setq this-start start this-end (length string)) + (setq this-start start this-end strlen) (funcall push-one) (nreverse list))) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 306fed34e40..53da087384d 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -280,7 +280,9 @@ a list of frames to update." (dolist (frame frame-lst) (unless (or (frame-parameter frame 'tab-bar-lines-keep-state) (and (eq auto-resize-tab-bars 'grow-only) - (> (frame-parameter frame 'tab-bar-lines) 1))) + (> (frame-parameter frame 'tab-bar-lines) 1)) + ;; Don't enable tab-bar in daemon's initial frame. + (and (daemonp) (not (frame-parameter frame 'client)))) (set-frame-parameter frame 'tab-bar-lines (tab-bar--tab-bar-lines-for-frame frame))))) ;; Update `default-frame-alist' @@ -600,7 +602,11 @@ on each new frame when the global `tab-bar-mode' is disabled, or if you want to disable the tab bar individually on each new frame when the global `tab-bar-mode' is enabled, by using - (add-hook \\='after-make-frame-functions #\\='toggle-frame-tab-bar)" + (add-hook \\='after-make-frame-functions #\\='toggle-frame-tab-bar) + +Or when starting Emacs in daemon mode: + + (add-hook \\='server-after-make-frame-hook #\\='toggle-frame-tab-bar)" (interactive) (set-frame-parameter frame 'tab-bar-lines (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1)) @@ -1188,14 +1194,29 @@ when the tab is current. Return the result as a keymap." `((add-tab menu-item ,tab-bar-new-button tab-bar-new-tab :help "New tab")))) -(defun tab-bar-format-align-right () - "Align the rest of tab bar items to the right." - (let* ((rest (cdr (memq 'tab-bar-format-align-right tab-bar-format))) - (rest (tab-bar-format-list rest)) +(defvar tab-bar--align-right-hash nil + "Memoization table for `tab-bar-format-align-right'.") + +(defun tab-bar-format-align-right (&optional rest) + "Align the rest of tab bar items to the right. +The argument `rest' is used for special handling of this item +by `tab-bar-format-list' that collects the rest of formatted items. +This prevents calling other non-idempotent items like +`tab-bar-format-global' twice." + (unless tab-bar--align-right-hash + (define-hash-table-test 'tab-bar--align-right-hash-test + #'equal-including-properties + #'sxhash-equal-including-properties) + (setq tab-bar--align-right-hash + (make-hash-table :test 'tab-bar--align-right-hash-test))) + (let* ((rest (or rest (tab-bar-format-list + (cdr (memq 'tab-bar-format-align-right + tab-bar-format))))) (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) (hpos (progn (add-face-text-property 0 (length rest) 'tab-bar t rest) - (string-pixel-width rest))) + (with-memoization (gethash rest tab-bar--align-right-hash) + (string-pixel-width rest)))) (str (propertize " " 'display ;; The `right' spec doesn't work on TTY frames ;; when windows are split horizontally (bug#59620) @@ -1217,19 +1238,33 @@ on the tab bar instead." global-mode-string)) (defun tab-bar-format-list (format-list) - (let ((i 0)) - (apply #'append - (mapcar - (lambda (format) - (setq i (1+ i)) - (cond - ((functionp format) - (let ((ret (funcall format))) - (when (stringp ret) - (setq ret `((,(intern (format "str-%i" i)) - menu-item ,ret ignore)))) - ret)))) - format-list)))) + "Return a list of items formatted from `format-list'. +The item `tab-bar-format-align-right' has special formatting." + (let* ((i 0) align-right-p rest + (res (apply #'append + (mapcar + (lambda (format) + (setq i (1+ i)) + (cond + ((eq format 'tab-bar-format-align-right) + (setq align-right-p t) + (list format)) + ((functionp format) + (let ((ret (funcall format))) + (when (stringp ret) + (setq ret `((,(intern (format "str-%i" i)) + menu-item ,ret ignore)))) + (when align-right-p + (setq rest (append rest ret))) + ret)))) + format-list)))) + (when align-right-p + (setq res (mapcan (lambda (format) + (if (eq format 'tab-bar-format-align-right) + (tab-bar-format-align-right rest) + (list format))) + res))) + res)) (defun tab-bar-make-keymap-1 () "Generate an actual keymap from `tab-bar-map', without caching." @@ -3008,6 +3043,9 @@ files will be visited." "Display the buffer of the next command in a new tab. The next buffer is the buffer displayed by the next command invoked immediately after this command (ignoring reading from the minibuffer). +In case of multiple consecutive mouse events such as <down-mouse-1>, +a mouse release event <mouse-1>, <double-mouse-1>, <triple-mouse-1> +all bound commands are handled until one of them displays a buffer. Creates a new tab before displaying the buffer, or switches to the tab that already contains that buffer. When `switch-to-buffer-obey-display-actions' is non-nil, diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index 1c15234c49c..012ecc5ed5e 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -211,6 +211,14 @@ EVENT is a `preedit-text' event." ("etc/images/cancel" . "gtk-cancel") ("etc/images/info" . ("dialog-information" "gtk-info")) ("etc/images/bookmark_add" . "n:bookmark_add") + ;; Used in package-menu + ("images/package-menu/execute" . "gtk-apply") + ("images/package-menu/info" . ("dialog-information" "gtk-info")) + ("images/package-menu/install" . ("archive-insert" "list-add")) + ("images/package-menu/delete" . ("archive-remove" "edit-delete" "gtk-remove")) + ("images/package-menu/unmark" . ("gnumeric-object-checkbox" "box")) + ("images/package-menu/url" . "globe") + ("images/package-menu/upgrade" . ("archive-extract" "go-bottom")) ;; Used in Gnus and/or MH-E: ("etc/images/attach" . ("mail-attachment" "gtk-attach")) ("etc/images/connect" . "gtk-connect") diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 1863ff92c77..ae3ea9f1ba2 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1400,6 +1400,14 @@ This returns an error if any Emacs frames are X frames." ("etc/images/cancel" . "gtk-cancel") ("etc/images/info" . ("dialog-information" "gtk-info")) ("etc/images/bookmark_add" . "n:bookmark_add") + ;; Used in package-menu + ("images/package-menu/execute" . "gtk-apply") + ("images/package-menu/info" . ("dialog-information" "gtk-info")) + ("images/package-menu/install" . ("archive-insert" "list-add")) + ("images/package-menu/delete" . ("archive-remove" "edit-delete" "gtk-remove")) + ("images/package-menu/unmark" . ("gnumeric-object-checkbox" "box")) + ("images/package-menu/url" . "globe") + ("images/package-menu/upgrade" . ("archive-extract" "go-bottom")) ;; Used in Gnus and/or MH-E: ("etc/images/attach" . ("mail-attachment" "gtk-attach")) ("etc/images/connect" . "gtk-connect") diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index b48c98efa02..45053ac6f23 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -23,11 +23,11 @@ ;;; Tree-sitter language versions ;; -;; css-ts-mode is known to work with the following languages and version: +;; css-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-css: v0.23.1-1-g6a442a3 ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -1343,7 +1343,8 @@ for determining whether point is within a selector." (add-to-list 'treesit-language-source-alist - '(css "https://github.com/tree-sitter/tree-sitter-css" "v0.23.1") + '(css "https://github.com/tree-sitter/tree-sitter-css" + :commit "6a442a3cf461b0ce275339e5afa178693484c927") t) (defvar css-ts-mode-map (copy-keymap css-mode-map) diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 386a88bda3a..4ab639497ec 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -78,21 +78,24 @@ placed at the beginning or end of a line by filling. See the documentation of `kinsoku' for more information." :type 'boolean) -(defun set-fill-prefix () +(defun set-fill-prefix (&optional arg) "Set the fill prefix to the current line up to point. Filling expects lines to start with the fill prefix and -reinserts the fill prefix in each resulting line." - (interactive) - (let ((left-margin-pos (save-excursion (move-to-left-margin) (point)))) - (if (> (point) left-margin-pos) - (progn - (setq fill-prefix (buffer-substring left-margin-pos (point))) - (if (equal fill-prefix "") +reinserts the fill prefix in each resulting line. +With a prefix argument, cancel the fill prefix." + (interactive "P") + (if arg + (setq fill-prefix nil) + (let ((left-margin-pos (save-excursion (move-to-left-margin) (point)))) + (if (> (point) left-margin-pos) + (progn + (setq fill-prefix (buffer-substring left-margin-pos (point))) + (when (equal fill-prefix "") (setq fill-prefix nil))) - (setq fill-prefix nil))) + (setq fill-prefix nil)))) (if fill-prefix (message "fill-prefix: \"%s\"" fill-prefix) - (message "fill-prefix canceled"))) + (message "fill-prefix cancelled"))) (defcustom adaptive-fill-mode t "Non-nil means determine a paragraph's fill prefix from its text." @@ -644,8 +647,8 @@ The break position will be always after LINEBEG and generally before point." (indent-line-to (current-left-margin)) (put-text-property beg (point) 'face 'default))) -(defun fill-region-as-paragraph (from to &optional justify - nosqueeze squeeze-after) +(defun fill-region-as-paragraph-default (from to &optional justify + nosqueeze squeeze-after) "Fill the region as if it were a single paragraph. This command removes any paragraph breaks in the region and extra newlines at the end, and indents and fills lines between the @@ -797,6 +800,39 @@ space does not end a sentence, so don't break a line there." ;; Return the fill-prefix we used fill-prefix))) +(defvar fill-region-as-paragraph-function #'fill-region-as-paragraph-default + "Function to fill the region as if it were a single paragraph. +It should accept the arguments defined by `fill-region-as-paragraph' and +return the `fill-prefix' used for filling.") + +(defun fill-region-as-paragraph (from to &optional justify + nosqueeze squeeze-after) + "Fill the region as if it were a single paragraph. +The behavior of this command is controlled by the variable +`fill-region-as-paragraph-function', with the default implementation +being `fill-region-as-paragraph-default'. + +The arguments FROM and TO define the boundaries of the region. + +The optional third argument JUSTIFY, when called interactively with a +prefix arg, is assigned the value `full'. +When called from Lisp, JUSTIFY can specify any type of justification; +see `default-justification' for the possible values. +Optional fourth arg NOSQUEEZE non-nil means not to make spaces between +words canonical before filling. +Fifth arg SQUEEZE-AFTER, if non-nil, should be a buffer position; it +means canonicalize spaces only starting from that position. +See `canonically-space-region' for the meaning of canonicalization of +spaces. + +It returns the `fill-prefix' used for filling." + (interactive (progn + (barf-if-buffer-read-only) + (list (region-beginning) (region-end) + (if current-prefix-arg 'full)))) + (funcall fill-region-as-paragraph-function + from to justify nosqueeze squeeze-after)) + (defsubst skip-line-prefix (prefix) "If point is inside the string PREFIX at the beginning of line, move past it." (when (and prefix @@ -1058,7 +1094,10 @@ if variable `use-hard-newlines' is on). Return the `fill-prefix' used for filling the last paragraph. If `sentence-end-double-space' is non-nil, then period followed by one -space does not end a sentence, so don't break a line there." +space does not end a sentence, so don't break a line there. + +The variable `fill-region-as-paragraph-function' can be used to override +how paragraphs are filled." (interactive (progn (barf-if-buffer-read-only) (list (region-beginning) (region-end) @@ -1602,77 +1641,63 @@ spaces. The variable `fill-column' controls the width for filling. Return the `fill-prefix' used for filling. -For more details about semantic linefeeds, see `fill-paragraph-semlf'." - (interactive (progn - (barf-if-buffer-read-only) - (list (region-beginning) - (region-end) - (if current-prefix-arg 'full)))) - (unless (memq justify '(t nil none full center left right)) - (setq justify 'full)) - - (let ((from (min from to)) - (to (max from to)) - pfx) - (goto-char from) - (with-restriction (line-beginning-position) to - (let ((fill-column (point-max))) - (setq pfx (or (save-excursion - (fill-region-as-paragraph (point) - (point-max) - nil - nosqueeze - squeeze-after)) - ""))) - (while (not (eobp)) - (let ((fill-prefix pfx)) - (fill-region-as-paragraph (point) - (progn (forward-sentence) (point)) - justify - nosqueeze - squeeze-after)) - (when (and (> (point) (line-beginning-position)) - (< (point) (line-end-position))) - (delete-horizontal-space) - (insert "\n") - (insert pfx)))) - (unless (eobp) (forward-char 1)) - pfx)) - -(defun fill-paragraph-semlf (&optional justify) - "Fill paragraph at or after point using semantic linefeeds. -Refill text putting a newline character after each sentence, calling -`forward-sentence' to find the ends of sentences. If -`sentence-end-double-space' is non-nil, period followed by one space is -not the end of a sentence. - -If JUSTIFY is non-nil (interactively, with prefix argument), justify as -well. The variable `fill-column' controls the width for filling. - -Return the `fill-prefix' used for filling. - -You can use this function as the value of `fill-paragraph-function', so -`fill-paragraph' and other filling commands will use it. +This function can be assigned to `fill-region-as-paragraph-function' to +override how functions like `fill-paragraph' and `fill-region' fill +text. For more details about semantic linefeeds, see `https://sembr.org/' and `https://rhodesmill.org/brandon/2012/one-sentence-per-line/'." (interactive (progn (barf-if-buffer-read-only) - (list (if current-prefix-arg 'full)))) - (unless (memq justify '(t nil none full center left right)) - (setq justify 'full)) + (list (region-beginning) + (region-end) + (if current-prefix-arg 'full)))) - (save-excursion - (let ((to (progn - (fill-forward-paragraph 1) - (backward-word) - (end-of-line) - (point))) - (from (progn - (fill-forward-paragraph -1) - (forward-word) - (beginning-of-line) - (point)))) - (fill-region-as-paragraph-semlf from to justify)))) + (let ((from (min from to)) + (to (copy-marker (max from to) t)) + pfx) + (goto-char from) + (let ((fill-column (point-max))) + (setq pfx (or (save-excursion + (fill-region-as-paragraph-default (point) + to + nil + nosqueeze + squeeze-after)) + ""))) + (while (< (point) to) + (let ((fill-prefix pfx)) + (fill-region-as-paragraph-default (point) + (min to + (save-excursion + (forward-sentence) + (point))) + justify + t)) + (when (and (> (point) (line-beginning-position)) + (< (point) (line-end-position)) + (< (point) to)) + (delete-horizontal-space) + (insert "\n") + (insert pfx))) + pfx)) + +(defun fill-paragraph-semlf (&optional justify region) + "Fill paragraph at or after point using semantic linefeeds. +Refill text putting a newline character after each sentence. + +If JUSTIFY is non-nil (interactively, with prefix argument), justify as +well. The REGION argument is non-nil if called interactively; in that +case, if Transient Mark mode is enabled and the mark is active, fill the +active region. + +See `fill-paragraph' and `fill-region-as-paragraph-semlf' for more +details." + (interactive (progn + (barf-if-buffer-read-only) + (list (if current-prefix-arg 'full) t))) + + (let ((fill-region-as-paragraph-function #'fill-region-as-paragraph-semlf)) + (fill-paragraph justify region))) ;;; fill.el ends here diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 15d419b1a37..1bf89ee8f4e 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -24,11 +24,11 @@ ;;; Tree-sitter language versions ;; -;; html-ts-mode is known to work with the following languages and version: +;; html-ts-mode has been tested with the following grammars and version: ;; - tree-sitter-html: v0.23.2-1-gd9219ad ;; ;; We try our best to make builtin modes work with latest grammar -;; versions, so a more recent grammar version has a good chance to work. +;; versions, so a more recent grammar has a good chance to work too. ;; Send us a bug report if it doesn't. ;;; Commentary: @@ -45,7 +45,8 @@ (add-to-list 'treesit-language-source-alist - '(html "https://github.com/tree-sitter/tree-sitter-html" "v0.23.2") + '(html "https://github.com/tree-sitter/tree-sitter-html" + :commit "d9219ada6e1a2c8f0ab0304a8bd9ca4285ae0468") t) (defcustom html-ts-mode-indent-offset 2 diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el index d85cb581fe8..a94d1590fa0 100644 --- a/lisp/textmodes/markdown-ts-mode.el +++ b/lisp/textmodes/markdown-ts-mode.el @@ -22,6 +22,16 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;; Tree-sitter language versions +;; +;; markdown-ts-mode has been tested with the following grammars and version: +;; - tree-sitter-markdown: v0.4.1 +;; - tree-sitter-markdown-inline: v0.4.1 +;; +;; We try our best to make builtin modes work with latest grammar +;; versions, so a more recent grammar has a good chance to work too. +;; Send us a bug report if it doesn't. + ;;; Commentary: ;; @@ -38,14 +48,16 @@ (add-to-list 'treesit-language-source-alist '(markdown - "https://github.com/tree-sitter-grammars/tree-sitter-markdown" "v0.4.1" - "tree-sitter-markdown/src") + "https://github.com/tree-sitter-grammars/tree-sitter-markdown" + :commit "413285231ce8fa8b11e7074bbe265b48aa7277f9" + :source-dir "tree-sitter-markdown/src") t) (add-to-list 'treesit-language-source-alist '(markdown-inline - "https://github.com/tree-sitter-grammars/tree-sitter-markdown" "v0.4.1" - "tree-sitter-markdown-inline/src") + "https://github.com/tree-sitter-grammars/tree-sitter-markdown" + :commit "413285231ce8fa8b11e7074bbe265b48aa7277f9" + :source-dir "tree-sitter-markdown-inline/src") t) ;;; Helper functions diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 946685150af..ee587ab3597 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -44,7 +44,7 @@ ;; ;; https://www.gnu.org/software/auctex/reftex.html ;; -;; RefTeX was written by Carsten Dominik <dominik@science.uva.nl> with +;; RefTeX was written by Carsten Dominik <carsten.dominik@gmail.com> with ;; contributions from Stephen Eglen. It is currently maintained by ;; the AUCTeX project. diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index 854ff93fd6b..c1c5dea2bd9 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -38,7 +38,8 @@ (add-to-list 'treesit-language-source-alist - '(toml "https://github.com/tree-sitter-grammars/tree-sitter-toml" "v0.7.0") + '(toml "https://github.com/tree-sitter-grammars/tree-sitter-toml" + :commit "64b56832c2cffe41758f28e05c756a3a98d16f41") t) (defcustom toml-ts-mode-indent-offset 2 diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index 6bd1bd946ae..cadae19af1e 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -37,7 +37,8 @@ (add-to-list 'treesit-language-source-alist - '(yaml "https://github.com/tree-sitter-grammars/tree-sitter-yaml" "v0.7.0") + '(yaml "https://github.com/tree-sitter-grammars/tree-sitter-yaml" + :commit "b733d3f5f5005890f324333dd57e1f0badec5c87") t) (defvar yaml-ts-mode--syntax-table @@ -186,7 +187,7 @@ Return nil if there is no name or if NODE is not a defun node." ;; Comments. (setq-local comment-start "# ") (setq-local comment-end "") - (setq-local comment-start-skip "#+\\s-*") + (setq-local comment-start-skip "#+ *") ;; Indentation. (setq-local indent-tabs-mode nil) diff --git a/lisp/transient.el b/lisp/transient.el index e0c834564c6..100a7682e4d 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -5,7 +5,7 @@ ;; Author: Jonas Bernoulli <jonas@bernoul.li> ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Version: 0.9.1 +;; Version: 0.9.3 ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -31,8 +31,9 @@ ;; used to implement similar menus in other packages. ;;; Code: +;;;; Frontmatter -(defconst transient-version "v0.9.1-7-gd7d2c1c2-builtin") +(defconst transient-version "v0.9.3-8-g6fd0239e-builtin") (require 'cl-lib) (require 'eieio) @@ -2460,16 +2461,16 @@ value. Otherwise return CHILDREN as is.") (alist-get cmd levels) (plist-get args :level) (and proto (oref proto level)) - transient--default-child-level))) + transient--default-child-level)) + (args (plist-put (copy-sequence args) :level level))) (when (transient--use-level-p level) (let ((obj (if (child-of-class-p class 'transient-information) - (apply class :parent parent :level level args) + (apply class :parent parent args) (unless (and cmd (symbolp cmd)) (error "BUG: Non-symbolic suffix command: %s" cmd)) (if proto - (apply #'clone proto :parent parent :level level args) - (apply class :command cmd :parent parent :level level - args))))) + (apply #'clone proto :parent parent args) + (apply class :command cmd :parent parent args))))) (cond ((not cmd)) ((commandp cmd)) ((or (cl-typep obj 'transient-switch) @@ -2596,7 +2597,7 @@ value. Otherwise return CHILDREN as is.") (add-hook 'pre-command-hook #'transient--pre-command 99) (add-hook 'post-command-hook #'transient--post-command) (advice-add 'recursive-edit :around #'transient--recursive-edit) - (set-default-toplevel-value 'inhibit-quit t) + (transient--quit-kludge 'enable) (when transient--exitp ;; This prefix command was invoked as the suffix of another. ;; Prevent `transient--post-command' from removing the hooks @@ -2707,10 +2708,8 @@ value. Otherwise return CHILDREN as is.") (defun transient--resume-override (&optional _ignore) (transient--debug 'resume-override) - (cond ((and transient--showp (not (window-live-p transient--window))) - (transient--show)) - ((window-live-p transient--window) - (transient--fit-window-to-buffer transient--window))) + (when (window-live-p transient--window) + (transient--fit-window-to-buffer transient--window)) (transient--push-keymap 'transient--transient-map) (transient--push-keymap 'transient--redisplay-map) (add-hook 'pre-command-hook #'transient--pre-command) @@ -2890,8 +2889,7 @@ value. Otherwise return CHILDREN as is.") (setq transient--current-suffix nil)) (cond (resume (transient--stack-pop)) ((not replace) - (setq quit-flag nil) - (set-default-toplevel-value 'inhibit-quit nil) + (transient--quit-kludge 'disable) (run-hooks 'transient-post-exit-hook))))) (defun transient--stack-push () @@ -2974,13 +2972,35 @@ When no transient is active (i.e., when `transient--prefix' is nil) then only reset `inhibit-quit'. Optional ID is a keyword identifying the exit." (transient--debug 'emergency-exit id) - (set-default-toplevel-value 'inhibit-quit nil) + (transient--quit-kludge 'disable) (when transient--prefix (setq transient--stack nil) (setq transient--exitp t) (transient--pre-exit) (transient--post-exit this-command))) +(defun transient--quit-kludge (action) + (static-if (boundp 'redisplay-can-quit) ;Emacs 31 + action + (pcase-exhaustive action + ('enable + (add-function + :around command-error-function + (let (unreadp) + (lambda (orig data context fn) + (cond ((not (eq (car data) 'quit)) + (funcall orig data context fn) + (setq unreadp nil)) + (unreadp + (remove-function command-error-function "inhibit-quit") + (funcall orig data context fn)) + (t + (push ?\C-g unread-command-events) + (setq unreadp t))))) + '((name . "inhibit-quit")))) + ('disable + (remove-function command-error-function "inhibit-quit"))))) + ;;;; Pre-Commands (defun transient--call-pre-command () @@ -4946,7 +4966,7 @@ This is used when a tooltip is needed.") (let ((message-log-max nil)) (message "%s" doc)))))) -;;; Menu Navigation +;;;; Menu Navigation (defun transient-scroll-up (&optional arg) "Scroll text of transient's menu window upward ARG lines. @@ -4997,7 +5017,9 @@ See `forward-button' for information about N." (when (re-search-forward (concat "^" (regexp-quote command)) nil t) (goto-char (match-beginning 0)))) (command - (cl-flet ((found () (eq (button-get (button-at (point)) 'command) command))) + (cl-flet ((found () + (and-let* ((button (button-at (point)))) + (eq (button-get button 'command) command)))) (while (and (ignore-errors (forward-button 1)) (not (found)))) (unless (found) @@ -5013,7 +5035,7 @@ See `forward-button' for information about N." beg (next-single-property-change beg 'face nil (line-end-position)))))) -;;; Compatibility +;;;; Compatibility ;;;; Menu Isearch (defvar-keymap transient--isearch-mode-map @@ -5244,10 +5266,10 @@ as stand-in for elements of exhausted lists." (propertize (prin1-to-string value t) 'face (if value 'transient-value 'transient-inactive-value)))) -;;; _ +;;;; _ (provide 'transient) ;; Local Variables: ;; indent-tabs-mode: nil ;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode") ;; End: -;;;; transient.el ends here +;;; transient.el ends here diff --git a/lisp/treesit-x.el b/lisp/treesit-x.el index d13d6b1a35a..65845ed0ac0 100644 --- a/lisp/treesit-x.el +++ b/lisp/treesit-x.el @@ -110,7 +110,7 @@ of `define-treesit-generic-mode'. (_ (pop body)))) (when (stringp source) - (setq source (list 'quote (list source nil nil nil nil nil :copy-queries t)))) + (setq source (list 'quote (list source :copy-queries t)))) (when (stringp auto-mode) (setq auto-mode (list 'quote (ensure-list auto-mode)))) @@ -203,7 +203,9 @@ of `define-treesit-generic-mode'. (define-treesit-generic-mode gitattributes-generic-ts-mode "Tree-sitter generic mode for .gitattributes files." :lang 'gitattributes - :source "https://github.com/tree-sitter-grammars/tree-sitter-gitattributes" + :source '("https://github.com/tree-sitter-grammars/tree-sitter-gitattributes" + :commit "5425944fd61bf2b3bad2c17c2dc9f53172b0f01d" + :copy-queries t) :auto-mode "gitattributes\\'" :name "Git-Attributes" (setq-local comment-start "# ") @@ -212,7 +214,9 @@ of `define-treesit-generic-mode'. (define-treesit-generic-mode liquid-generic-ts-mode "Tree-sitter generic mode for Liquid templates." :lang 'liquid - :source "https://github.com/hankthetank27/tree-sitter-liquid" + :source '("https://github.com/hankthetank27/tree-sitter-liquid" + :commit "d6ebde3974742cd1b61b55d1d94aab1dacb41056" + :copy-queries t) :auto-mode "\\.liquid\\'" :name "Liquid" :parent 'mhtml-ts-mode diff --git a/lisp/treesit.el b/lisp/treesit.el index 353e991ec20..dc17515ff99 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2020,7 +2020,7 @@ Because `pre-redisplay-functions' could be called multiple times during a single command loop, we use this variable to debounce calls to `treesit--pre-redisplay'.") -(defun treesit--font-lock-mark-ranges-to-fontify (ranges _parser) +(defun treesit--font-lock-mark-ranges-to-fontify (ranges) "A notifier that marks ranges that needs refontification. For RANGES and PARSER see `treesit-parser-add-notifier'. @@ -2073,18 +2073,18 @@ parser." (signal 'treesit-no-parser nil)))) (car (treesit-parser-list)))) -(defun treesit--pre-redisplay (&rest _) - "Force a reparse on the primary parser and mark regions to be fontified. +(declare-function treesit-parser-changed-regions "treesit.c") -The actual work is carried out by -`treesit--font-lock-mark-ranges-to-fontify', which see." +(defun treesit--pre-redisplay (&rest _) + "Force a reparse on primary parser and mark regions to be fontified." (unless (eq treesit--pre-redisplay-tick (buffer-chars-modified-tick)) (when treesit-primary-parser - ;; Force a reparse on the primary parser, if everything is setup - ;; correctly, the parser should call - ;; `treesit--font-lock-mark-ranges-to-fontify' (which should be a - ;; notifier function of the primary parser). - (treesit-parser-root-node treesit-primary-parser)) + ;; Force a reparse on the primary parser and update embedded + ;; parser ranges in the changed ranges. + (let ((affected-ranges (treesit-parser-changed-regions + treesit-primary-parser))) + (when affected-ranges + (treesit--font-lock-mark-ranges-to-fontify affected-ranges)))) (setq treesit--pre-redisplay-tick (buffer-chars-modified-tick)))) @@ -4072,6 +4072,7 @@ this variable takes priority.") "Search for the next outline heading in the syntax tree. For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in `outline-search-function'." + (treesit--pre-redisplay) (if looking-at (when (treesit-outline--at-point) (pos-bol)) @@ -4158,11 +4159,6 @@ For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in level)) -(defun treesit--after-change (beg end _len) - "Force updating the ranges in BEG...END. -Expected to be called after each text change." - (treesit-update-ranges beg end)) - ;;; Hideshow mode (defun treesit-hs-block-end () @@ -4374,9 +4370,6 @@ before calling this function." . treesit-font-lock-fontify-region))) (treesit-font-lock-recompute-features) (add-hook 'pre-redisplay-functions #'treesit--pre-redisplay 0 t) - (when treesit-primary-parser - (treesit-parser-add-notifier - treesit-primary-parser #'treesit--font-lock-mark-ranges-to-fontify)) (treesit-validate-font-lock-rules treesit-font-lock-settings)) ;; Syntax (add-hook 'syntax-propertize-extend-region-functions @@ -4462,8 +4455,7 @@ before calling this function." (setq treesit-outline-predicate #'treesit-outline-predicate--from-imenu)) (setq-local outline-search-function #'treesit-outline-search - outline-level #'treesit-outline-level) - (add-hook 'outline-after-change-functions #'treesit--after-change nil t)) + outline-level #'treesit-outline-level)) ;; Remove existing local parsers. (dolist (ov (overlays-in (point-min) (point-max))) @@ -4998,7 +4990,7 @@ window." The value should be an alist where each element has the form - (LANG . (URL REVISION SOURCE-DIR CC C++ COMMIT [KEYWORD VALUE]...)) + (LANG . (URL REVISION SOURCE-DIR CC C++ COMMIT)) Only LANG and URL are mandatory. LANG is the language symbol. URL is the URL of the grammar's Git repository or a directory @@ -5015,8 +5007,17 @@ the grammar's parser.c file resides, defaulting to \"src\". CC and C++ are C and C++ compilers, defaulting to \"cc\" and \"c++\", respectively. +Another way to specify optional data is to use keywords: + + (LANG . (URL [KEYWORD VALUE]...)) + The currently supported keywords: +`:revision' is the same as REVISION above. +`:source-dir' is the same as SOURCE-DIR above. +`:cc' is the same as CC above. +`:c++' is the same as C++ above. +`:commit' is the same as COMMIT above. `:copy-queries' when non-nil specifies whether to copy the files in the \"queries\" directory from the source directory to the installation directory.") @@ -5153,6 +5154,18 @@ nil." (string-trim (buffer-string))) (t nil)))) +(defun treesit--language-git-version-tags (repo-dir) + "Return a list of Git version tags in REPO-DIR, sorted latest first. + +Return the output of \"git tag --list --sort=-version:refname \\='v*\\='\". +If anything goes wrong, return nil." + (with-temp-buffer + (cond + ((eq 0 (call-process "git" nil t nil "-C" repo-dir "tag" + "--list" "--sort=-version:refname" "v*")) + (split-string (buffer-string))) + (t nil)))) + (defun treesit--language-git-timestamp (repo-dir) "Return the commit date in REPO-DIR in UNIX epoch. @@ -5203,7 +5216,7 @@ clone if `treesit--install-language-grammar-blobless' is t." (apply #'treesit--call-process-signal args))) (defun treesit--install-language-grammar-1 - (out-dir lang url &optional revision source-dir cc c++ commit &rest args) + (out-dir lang url &rest args) "Compile and install a tree-sitter language grammar library. OUT-DIR is the directory to put the compiled library file. If it @@ -5211,8 +5224,7 @@ is nil, the \"tree-sitter\" directory under user's Emacs configuration directory is used (and automatically created if it does not exist). -For LANG, URL, REVISION, SOURCE-DIR, GRAMMAR-DIR, CC, C++, COMMIT, see -`treesit-language-source-alist'. +For ARGS, see `treesit-language-source-alist'. Return the git revision of the installed grammar. The revision is generated by \"git describe\". It only works when @@ -5225,20 +5237,38 @@ If anything goes wrong, this function signals an `treesit-error'." (workdir (if url-is-dir maybe-repo-dir (expand-file-name "repo"))) - copy-queries version) + version + revision source-dir cc c++ commit copy-queries) ;; Process the keyword args. (while (keywordp (car args)) (pcase (pop args) - (:copy-queries (setq copy-queries (pop args))) - (_ (pop args)))) + (:revision (setq revision (pop args))) + (:source-dir (setq source-dir (pop args))) + (:cc (setq cc (pop args))) + (:c++ (setq c++ (pop args))) + (:commit (setq commit (pop args))) + (:copy-queries (setq copy-queries (pop args))))) + + ;; Old positional convention for backward-compatibility. + (unless revision (setq revision (nth 0 args))) + (unless source-dir (setq source-dir (nth 1 args))) + (unless cc (setq cc (nth 2 args))) + (unless c++ (setq c++ (nth 3 args))) + (unless commit (setq commit (nth 4 args))) (unwind-protect (with-temp-buffer (if url-is-dir (when revision (treesit--git-checkout-branch workdir revision)) - (treesit--git-clone-repo url revision workdir)) + (if commit + ;; Force blobless full clone to be able later + ;; to checkout a commit (bug#78542). + (let ((treesit--install-language-grammar-full-clone t) + (treesit--install-language-grammar-blobless t)) + (treesit--git-clone-repo url revision workdir)) + (treesit--git-clone-repo url revision workdir))) (when commit (treesit--git-checkout-branch workdir commit)) (setq version (treesit--language-git-revision workdir)) @@ -5401,6 +5431,19 @@ Tree-sitter grammar for `%s' is missing; install it?" (treesit-parser-language :no-eval (treesit-parser-language parser) :eg-result c) + (treesit-parser-tag + :no-eval (treesit-parser-tag parser) + :eg-result 'embeded) + (treesit-parser-changed-regions + :no-eval (treesit-parser-changed-regions parser) + :eg-result '((1 . 10) (24 . 58))) + + (treesit-parser-embed-level + :no-eval (treesit-parser-embed-level parser) + :eg-result 1) + (treesit-parser-set-embed-level + :no-eval (treesit-parser-set-embed-level parser 1)) + (treesit-parser-add-notifier) (treesit-parser-remove-notifier) (treesit-parser-notifiers diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 6e25323bf5a..4284d6a4feb 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -517,10 +517,11 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." "The current unique name of this buffer in `uniquify-get-unique-names'.") (defun uniquify-get-unique-names (buffers) - "Return an alist with a unique name for each buffer in BUFFERS. + "Return a list with unique names for buffers in BUFFERS. The names are unique only among BUFFERS, and may conflict with other -buffers not in that list. +buffers not in that list. Each string has a text property +`uniquify-orig-buffer' that stores the corresponding buffer. This does not rename the buffers or change any state; the unique name is only present in the returned alist." @@ -547,8 +548,15 @@ only present in the returned alist." (gethash name buffer-names))))) (mapcar (lambda (buf) (with-current-buffer buf - (prog1 (cons uniquify--stateless-curname buf) - (kill-local-variable 'uniquify--stateless-curname)))) + (let ((name + (if (eq uniquify--stateless-curname + (buffer-name buf)) + (copy-sequence uniquify--stateless-curname) + uniquify--stateless-curname))) + (when name + (put-text-property 0 1 'uniquify-orig-buffer buf name)) + (kill-local-variable 'uniquify--stateless-curname) + name))) buffers)) ;;; Hooks from the rest of Emacs diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 6446e0a945b..ca971a86c84 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -3220,46 +3220,47 @@ Without an argument, it saves customized diff argument, if available ;; idea suggested by Hannu Koivisto <azure@iki.fi> (defun ediff-clone-buffer-for-region-comparison (buff region-name) - (let ((cloned-buff (ediff-make-cloned-buffer buff region-name)) - (pop-up-windows t) - wind - other-wind - msg-buf) - (ediff-with-current-buffer cloned-buff - (setq ediff-temp-indirect-buffer t)) - (pop-to-buffer cloned-buff) - (setq wind (ediff-get-visible-buffer-window cloned-buff)) - (when (window-live-p wind) - (select-window wind) - (delete-other-windows)) - (or (mark) (push-mark)) - (setq mark-active 'ediff-util) - (setq-local transient-mark-mode t) - (split-window-vertically) - (ediff-select-lowest-window) - (setq other-wind (selected-window)) - (with-temp-buffer - (erase-buffer) - (insert - (format "\n ******* Mark a region in buffer %s (or confirm the existing one) *******\n" - (buffer-name cloned-buff))) - (insert - (ediff-with-current-buffer buff - (format "\n\t When done, type %s Use %s to abort\n " - (ediff-format-bindings-of 'exit-recursive-edit) - (ediff-format-bindings-of 'abort-recursive-edit)))) - (goto-char (point-min)) - (setq msg-buf (current-buffer)) - (set-window-buffer other-wind msg-buf) - (shrink-window-if-larger-than-buffer) - (if (window-live-p wind) - (select-window wind)) - (condition-case nil - (recursive-edit) - (quit - (ediff-kill-buffer-carefully cloned-buff))) - ) - cloned-buff)) + (save-window-excursion + (let ((cloned-buff (ediff-make-cloned-buffer buff region-name)) + (pop-up-windows t) + wind + other-wind + msg-buf) + (ediff-with-current-buffer cloned-buff + (setq ediff-temp-indirect-buffer t)) + (pop-to-buffer cloned-buff) + (setq wind (ediff-get-visible-buffer-window cloned-buff)) + (when (window-live-p wind) + (select-window wind) + (delete-other-windows)) + (or (mark) (push-mark)) + (setq mark-active 'ediff-util) + (setq-local transient-mark-mode t) + (split-window-vertically) + (ediff-select-lowest-window) + (setq other-wind (selected-window)) + (with-temp-buffer + (erase-buffer) + (insert + (format "\n ******* Mark a region in buffer %s (or confirm the existing one) *******\n" + (buffer-name cloned-buff))) + (insert + (ediff-with-current-buffer buff + (format "\n\t When done, type %s Use %s to abort\n " + (ediff-format-bindings-of 'exit-recursive-edit) + (ediff-format-bindings-of 'abort-recursive-edit)))) + (goto-char (point-min)) + (setq msg-buf (current-buffer)) + (set-window-buffer other-wind msg-buf) + (shrink-window-if-larger-than-buffer) + (if (window-live-p wind) + (select-window wind)) + (condition-case nil + (recursive-edit) + (quit + (ediff-kill-buffer-carefully cloned-buff))) + ) + cloned-buff))) (defun ediff-clone-buffer-for-window-comparison (buff wind region-name) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index d9b8afb2542..1f27f418cf5 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -400,7 +400,7 @@ automatically." (defvar log-edit-headers-alist '(("Summary" . log-edit-summary) ("Fixes") ("Author")) - "AList of known headers and the face to use to highlight them.") + "Alist of known headers and the face to use to highlight them.") (defconst log-edit-header-contents-regexp "[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?" @@ -533,7 +533,9 @@ keys and associated values are: files that are concerned by the current operation (using relative names); `log-edit-diff-function' -- function taking no arguments that displays a diff of the files concerned by the current operation. - `vc-log-fileset' -- the VC fileset to be committed (if any). + `vc-log-fileset' -- list of files to be committed, if any + (not a true VC fileset structure as returned by + `vc-deduce-fileset', but only the second element). If BUFFER is non-nil, `log-edit' will switch to that buffer, use it to edit the log message and go back to the current buffer when @@ -576,6 +578,7 @@ the \\[vc-prefix-map] prefix for VC commands, for example). (cl-pushnew 'display-line-numbers-disable font-lock-extra-managed-props) (setq-local jit-lock-contextually t) ;For the "first line is summary". (setq-local fill-paragraph-function #'log-edit-fill-entry) + (setq-local normal-auto-fill-function #'log-edit-do-auto-fill) (make-local-variable 'log-edit-comment-ring-index) (add-hook 'kill-buffer-hook 'log-edit-remember-comment nil t) (hack-dir-local-variables-non-file-buffer) @@ -743,6 +746,12 @@ according to `fill-column'." nil) t)))) +(defun log-edit-do-auto-fill () + "Like `do-auto-fill', but don't fill in Log Edit headers." + (unless (> (save-excursion (rfc822-goto-eoh) (point)) + (point)) + (do-auto-fill))) + (defun log-edit-hide-buf (&optional buf where) (when (setq buf (get-buffer (or buf log-edit-files-buf))) ;; FIXME: Should use something like `quit-windows-on' here, but @@ -861,8 +870,9 @@ comment history, see `log-edit-comment-ring', and hides `log-edit-files-buf'." ;; Re NOT-ESSENTIAL non-nil: this function can get called from ;; `log-edit-hook' and we don't want to abort the whole Log Edit setup ;; because the user says no to saving a buffer. The buffers will - ;; still actually get saved before committing, by `vc-finish-logentry'. - ;; Possibly `log-edit-maybe-show-diff' should catch the error instead. + ;; still actually get saved before committing, by the + ;; `vc-log-operation' anonymous function. Possibly + ;; `log-edit-maybe-show-diff' should catch the error instead. (vc-diff nil 'not-essential (list log-edit-vc-backend vc-log-fileset))) (defun log-edit-show-diff () diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index d1b27f6763b..0a9e07cf78b 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1089,12 +1089,32 @@ chars to try and eliminate some spurious differences." ;; (list match-num1 match-num2 startline)) (overlay-put ol 'evaporate t) (dolist (x props) - (when (or (> end beg) - ;; Don't highlight the char we cover artificially. - (not (memq (car-safe x) '(face font-lock-face)))) - (overlay-put ol (car x) (cdr x)))) + (if (or (> end beg) + (not (memq (car-safe x) '(face font-lock-face)))) + (overlay-put ol (car x) (cdr x)) + ;; Don't highlight the char we cover artificially. + ;; FIXME: We don't want to insert any space because it + ;; causes misalignment. A `:box' face with a line + ;; only on one side would be a good solution. + ;; (overlay-put ol (if (= beg olbeg) 'before-string 'after-string) + ;; (propertize + ;; " " (car-safe x) (cdr-safe x) + ;; 'display '(space :width 0.5))) + )) ol))))) +(defcustom smerge-refine-shadow-cursor t + "If non-nil, display a shadow cursor on the other side of smerge refined regions. +Its appearance is controlled by the face `smerge-refine-shadow-cursor'." + :type 'boolean + :version "31.1") + +(defface smerge-refine-shadow-cursor + '((t :box (:line-width (-2 . -2)))) + "Face placed on a character to highlight it as the shadow cursor. +The presence of the shadow cursor depends on the +variable `smerge-refine-shadow-cursor'.") + ;;;###autoload (defun smerge-refine-regions (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a) "Show fine differences in the two regions BEG1..END1 and BEG2..END2. @@ -1124,7 +1144,11 @@ used to replace chars to try and eliminate some spurious differences." (ol2 (make-overlay beg2 end2 nil ;; Make it shrink rather than spread when editing. 'front-advance nil)) - (common-props '((evaporate . t) (smerge--refine-region . t)))) + (common-props '((evaporate . t) (smerge--refine-region . t) + (cursor-sensor-functions + smerge--refine-shadow-cursor)))) + (when smerge-refine-shadow-cursor + (cursor-sensor-mode 1)) (dolist (prop (or props-a props-c)) (when (and (not (memq (car prop) '(face font-lock-face))) (member prop (or props-r props-c)) @@ -1215,6 +1239,55 @@ used to replace chars to try and eliminate some spurious differences." (define-obsolete-function-alias 'smerge-refine-subst #'smerge-refine-regions "26.1") +(defun smerge--refine-at-right-margin-p (pos window) + ;; FIXME: `posn-at-point' seems to be costly/slow. + (when-let* ((posn (posn-at-point pos window)) + (xy (nth 2 posn)) + (x (car-safe xy)) + (_ (numberp x))) + (> (+ x (with-selected-window window (string-pixel-width " "))) + (car (window-text-pixel-size window))))) + +(defun smerge--refine-shadow-cursor (window _oldpos dir) + (let ((ol (window-parameter window 'smerge--refine-shadow-cursor))) + (if (not (and smerge-refine-shadow-cursor + (memq dir '(entered moved)))) + (if ol (delete-overlay ol)) + (with-current-buffer (window-buffer window) + (let* ((cursor (window-point window)) + (other-beg (ignore-errors (smerge--refine-other-pos cursor)))) + (if (not other-beg) + (if ol (delete-overlay ol)) + (let ((other-end (min (point-max) (1+ other-beg)))) + ;; If other-beg/end covers a "wide" char like TAB or LF, the + ;; resulting shadow cursor doesn't look like a cursor, so try + ;; and convert it to a before-string space. + (when (or (and (eq ?\n (char-after other-beg)) + (not (smerge--refine-at-right-margin-p + other-beg window))) + (and (eq ?\t (char-after other-beg)) + ;; FIXME: `posn-at-point' seems to be costly/slow. + (when-let* ((posn (posn-at-point other-beg window)) + (xy (nth 2 posn)) + (x (car-safe xy)) + (_ (numberp x))) + (< (1+ (% x tab-width)) tab-width)))) + (setq other-end other-beg)) + ;; FIXME: Doesn't obey `cursor-in-non-selected-windows'. + (if ol (move-overlay ol other-beg other-end) + (setq ol (make-overlay other-beg other-end nil t nil)) + (setf (window-parameter window 'smerge--refine-shadow-cursor) + ol) + (overlay-put ol 'window window) + (overlay-put ol 'face 'smerge-refine-shadow-cursor)) + ;; When the shadow cursor needs to be at EOB (or TAB or EOL), + ;; "draw" it as a pseudo space character. + (overlay-put ol 'before-string + (when (= other-beg other-end) + (eval-when-compile + (propertize + " " 'face 'smerge-refine-shadow-cursor))))))))))) + (defun smerge-refine (&optional part) "Highlight the words of the conflict that are different. For 3-way conflicts, highlights only two of the three parts. @@ -1265,56 +1338,58 @@ repeating the command will highlight other two parts." (unless smerge-use-changed-face '((smerge . refine) (font-lock-face . smerge-refined-added)))))) -(defun smerge-refine-exchange-point () - "Go to the matching position in the other chunk." - (interactive) +(defun smerge--refine-other-pos (pos) (let* ((covering-ol - (let ((ols (overlays-at (point)))) + (let ((ols (overlays-at pos))) (while (and ols (not (overlay-get (car ols) 'smerge--refine-region))) (pop ols)) (or (car ols) (user-error "Not inside a refined region")))) (ref-pos - (if (or (get-char-property (point) 'smerge--refine-other) - (get-char-property (1- (point)) 'smerge--refine-other)) - (point) + (if (or (get-char-property pos 'smerge--refine-other) + (get-char-property (1- pos) 'smerge--refine-other)) + pos (let ((next (next-single-char-property-change - (point) 'smerge--refine-other nil + pos 'smerge--refine-other nil (overlay-end covering-ol))) (prev (previous-single-char-property-change - (point) 'smerge--refine-other nil + pos 'smerge--refine-other nil (overlay-start covering-ol)))) (cond ((and (> prev (overlay-start covering-ol)) (or (>= next (overlay-end covering-ol)) - (> (- next (point)) (- (point) prev)))) + (> (- next pos) (- pos prev)))) prev) ((< next (overlay-end covering-ol)) next) (t (user-error "No \"other\" position info found")))))) (boundary (cond - ((< ref-pos (point)) + ((< ref-pos pos) (let ((adjust (get-char-property (1- ref-pos) 'smerge--refine-adjust))) - (min (point) (+ ref-pos (or (cdr adjust) 0))))) - ((> ref-pos (point)) + (min pos (+ ref-pos (or (cdr adjust) 0))))) + ((> ref-pos pos) (let ((adjust (get-char-property ref-pos 'smerge--refine-adjust))) - (max (point) (- ref-pos (or (car adjust) 0))))) + (max pos (- ref-pos (or (car adjust) 0))))) (t ref-pos))) (other-forw (get-char-property ref-pos 'smerge--refine-other)) (other-back (get-char-property (1- ref-pos) 'smerge--refine-other)) (other (or other-forw other-back)) - (dist (- boundary (point)))) + (dist (- boundary pos))) (if (not (overlay-start other)) (user-error "The \"other\" position has vanished") - (goto-char - (- (if other-forw - (- (overlay-start other) - (or (car (overlay-get other 'smerge--refine-adjust)) 0)) - (+ (overlay-end other) - (or (cdr (overlay-get other 'smerge--refine-adjust)) 0))) - dist))))) + (- (if other-forw + (- (overlay-start other) + (or (car (overlay-get other 'smerge--refine-adjust)) 0)) + (+ (overlay-end other) + (or (cdr (overlay-get other 'smerge--refine-adjust)) 0))) + dist)))) + +(defun smerge-refine-exchange-point () + "Go to the matching position in the other chunk." + (interactive) + (goto-char (smerge--refine-other-pos (point)))) (defun smerge-swap () ;; FIXME: Extend for diff3 to allow swapping the middle end as well. diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index de432e4e1c3..e68c5a79919 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -419,7 +419,19 @@ should be applied to the background or to the foreground." (read-string (format-prompt "Annotate span days" 20) nil nil "20")))))))) (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef - (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev)) + (let* ((backend (or backend + (car vc-buffer-overriding-fileset) + (vc-backend file))) + (file-buffer (get-file-buffer file)) + (temp-buffer-name + (format "*Annotate %s (rev %s)*" + (if file-buffer + (buffer-name file-buffer) + ;; Try to avoid ambiguity. + (file-relative-name file + (vc-call-backend backend 'root + default-directory))) + rev)) (temp-buffer-show-function 'vc-annotate-display-select) ;; If BUF is specified, we presume the caller maintains current line, ;; so we don't need to do it here. This implementation may give @@ -436,45 +448,42 @@ should be applied to the background or to the foreground." (rename-buffer temp-buffer-name t) ;; In case it had to be uniquified. (setq temp-buffer-name (buffer-name)))) - (let ((backend (or backend - (car vc-buffer-overriding-fileset) - (vc-backend file))) - (coding-system-for-read buffer-file-coding-system)) - (with-output-to-temp-buffer temp-buffer-name - ;; For a VC backend running on DOS/Windows, it's normal to - ;; produce CRLF EOLs even if the original file has Unix EOLs, - ;; which will show ^M characters in the Annotate buffer. (One - ;; known case in point is "svn annotate".) Prevent that by - ;; forcing DOS EOL decoding. - (if (memq system-type '(windows-nt ms-dos)) - (setq coding-system-for-read - (coding-system-change-eol-conversion coding-system-for-read - 'dos))) - (vc-call-backend backend 'annotate-command file - (get-buffer temp-buffer-name) rev) - ;; we must setup the mode first, and then set our local - ;; variables before the show-function is called at the exit of - ;; with-output-to-temp-buffer - (with-current-buffer temp-buffer-name - (unless (equal major-mode 'vc-annotate-mode) - (vc-annotate-mode)) - (setq-local vc-annotate-backend backend) - (setq-local vc-buffer-overriding-fileset `(,backend (,file))) - (setq-local vc-buffer-revision rev) - (setq-local vc-annotate-parent-display-mode display-mode) - (kill-local-variable 'revert-buffer-function)))) + (let ((coding-system-for-read buffer-file-coding-system)) + (with-output-to-temp-buffer temp-buffer-name + ;; For a VC backend running on DOS/Windows, it's normal to + ;; produce CRLF EOLs even if the original file has Unix EOLs, + ;; which will show ^M characters in the Annotate buffer. (One + ;; known case in point is "svn annotate".) Prevent that by + ;; forcing DOS EOL decoding. + (if (memq system-type '(windows-nt ms-dos)) + (setq coding-system-for-read + (coding-system-change-eol-conversion coding-system-for-read + 'dos))) + (vc-call-backend backend 'annotate-command file + (get-buffer temp-buffer-name) rev) + ;; we must setup the mode first, and then set our local + ;; variables before the show-function is called at the exit of + ;; with-output-to-temp-buffer + (with-current-buffer temp-buffer-name + (unless (equal major-mode 'vc-annotate-mode) + (vc-annotate-mode)) + (setq-local vc-annotate-backend backend) + (setq-local vc-buffer-overriding-fileset `(,backend (,file))) + (setq-local vc-buffer-revision rev) + (setq-local vc-annotate-parent-display-mode display-mode) + (kill-local-variable 'revert-buffer-function)))) (with-current-buffer temp-buffer-name (vc-run-delayed - ;; Ideally, we'd rather not move point if the user has already - ;; moved it elsewhere, but really point here is not the position - ;; of the user's cursor :-( - (when current-line ;(and (bobp)) - (goto-char (point-min)) - (forward-line (1- current-line)) - (setq vc-sentinel-movepoint (point))) - (unless (active-minibuffer-window) - (message "Annotating... done")))))) + ;; Ideally, we'd rather not move point if the user has already + ;; moved it elsewhere, but really point here is not the position + ;; of the user's cursor :-( + (when current-line ;(and (bobp)) + (goto-char (point-min)) + (forward-line (1- current-line)) + (setq vc-sentinel-movepoint (point))) + (unless (active-minibuffer-window) + (message "Annotating... done")))))) (defun vc-annotate-prev-revision (prefix) "Visit the annotation of the revision previous to this one. @@ -548,8 +557,9 @@ Return a cons (REV . FILENAME)." (if (not rev-at-line) (message "Cannot extract revision number from the current line") (setq prev-rev - (vc-call-backend vc-annotate-backend 'previous-revision - fname rev)) + (let ((vc-use-short-revision vc-annotate-use-short-revision)) + (vc-call-backend vc-annotate-backend 'previous-revision + fname rev))) (if (not prev-rev) (message "No previous revisions") (vc-annotate-warp-revision prev-rev fname)))))) @@ -604,8 +614,9 @@ the file in question, search for the log entry required and move point." (if (not rev-at-line) (message "Cannot extract revision number from the current line") (setq prev-rev - (vc-call-backend vc-annotate-backend 'previous-revision - (if filediff fname nil) rev)) + (let ((vc-use-short-revision vc-annotate-use-short-revision)) + (vc-call-backend vc-annotate-backend 'previous-revision + (if filediff fname nil) rev))) (vc-diff-internal vc-allow-async-diff ;; The value passed here should follow what @@ -649,23 +660,27 @@ describes a revision number, so warp to that revision." (cond ((and (integerp revspec) (> revspec 0)) (setq newrev vc-buffer-revision) - (while (and (> revspec 0) newrev) - (setq newrev (vc-call-backend vc-annotate-backend 'next-revision - (or file - (caadr vc-buffer-overriding-fileset)) - newrev)) - (setq revspec (1- revspec))) + (let ((vc-use-short-revision vc-annotate-use-short-revision)) + (while (and (> revspec 0) newrev) + (setq newrev + (vc-call-backend vc-annotate-backend 'next-revision + (or file + (caadr vc-buffer-overriding-fileset)) + newrev)) + (setq revspec (1- revspec)))) (unless newrev (message "Cannot increment %d revisions from revision %s" revspeccopy vc-buffer-revision))) ((and (integerp revspec) (< revspec 0)) (setq newrev vc-buffer-revision) - (while (and (< revspec 0) newrev) - (setq newrev (vc-call-backend vc-annotate-backend 'previous-revision - (or file - (caadr vc-buffer-overriding-fileset)) - newrev)) - (setq revspec (1+ revspec))) + (let ((vc-use-short-revision vc-annotate-use-short-revision)) + (while (and (< revspec 0) newrev) + (setq newrev + (vc-call-backend vc-annotate-backend 'previous-revision + (or file + (caadr vc-buffer-overriding-fileset)) + newrev)) + (setq revspec (1+ revspec)))) (unless newrev (message "Cannot decrement %d revisions from revision %s" (- 0 revspeccopy) vc-buffer-revision))) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 278bafba022..b8dd07cd294 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -166,6 +166,12 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and :group 'vc :version "31.1") +(defcustom vc-dir-save-some-buffers-on-revert nil + "If non-nil, first offer to save relevant buffers when refreshing VC-Dir." + :type 'boolean + :group 'vc + :version "31.1") + (defun vc-dir-move-to-goal-column () ;; Used to keep the cursor on the file name column. (beginning-of-line) @@ -481,9 +487,11 @@ If BODY uses EVENT, it should be a variable, (vc-dir-fileinfo->name data))))))) (defun vc-dir-update (entries buffer &optional noinsert) - "Update BUFFER's ewoc from the list of ENTRIES. -If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." - ;; Add ENTRIES to the vc-dir buffer BUFFER. + "Update BUFFER's VC-Dir ewoc from ENTRIES. +This has the effect of adding ENTRIES to the VC-Dir buffer BUFFER. +If optional argument NOINSERT is non-nil, update ewoc nodes, but don't +add elements of ENTRIES to the buffer that aren't already in the ewoc. +Also update some VC file properties from ENTRIES." (with-current-buffer buffer ;; Insert the entries sorted by name into the ewoc. ;; We assume the ewoc is sorted too, which should be the @@ -586,7 +594,11 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." (apply #'vc-dir-create-fileinfo entry)))))) (when to-remove (let ((inhibit-read-only t)) - (apply #'ewoc-delete vc-ewoc (nreverse to-remove))))))) + (apply #'ewoc-delete vc-ewoc (nreverse to-remove))))) + ;; Update VC file properties. + (pcase-dolist (`(,file ,state ,_extra) entries) + (vc-file-setprop file 'vc-backend + (if (eq state 'unregistered) 'none vc-dir-backend))))) (defun vc-dir-busy () (and (buffer-live-p vc-dir-process-buffer) @@ -1367,6 +1379,8 @@ Throw an error if another update process is in progress." (error "Another update process is in progress, cannot run two at a time") (let ((def-dir default-directory) (backend vc-dir-backend)) + (when vc-dir-save-some-buffers-on-revert + (vc-buffer-sync-fileset `(,vc-dir-backend (,def-dir)) t)) (vc-set-mode-line-busy-indicator) ;; Call the `dir-status' backend function. ;; `dir-status' is supposed to be asynchronous. diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 2ea22f0622f..97c58ca9ea2 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -106,9 +106,6 @@ ;;; Code: -;; TODO: -;; - log buffers need font-locking. - (eval-when-compile (require 'cl-lib) (require 'cl-print)) @@ -279,7 +276,10 @@ Only run CODE if the SUCCESS process has a zero exit code." (if (functionp code) (funcall code) (eval code t)))) ;; If a process is running, add CODE to the sentinel ((eq (process-status proc) 'run) - (vc-set-mode-line-busy-indicator) + (let ((buf (process-buffer proc))) + (when (buffer-live-p buf) + (with-current-buffer buf + (vc-set-mode-line-busy-indicator)))) (letrec ((fun (lambda (p _msg) (remove-function (process-sentinel p) fun) (vc--process-sentinel p code success)))) @@ -861,39 +861,43 @@ the buffer contents as a comment." ;; Check and record the comment, if any. (unless nocomment (run-hooks 'vc-logentry-check-hook)) - ;; Must pass NOT-ESSENTIAL nil because we later call - ;; `vc-resynch-buffer' with NOQUERY non-nil. - (vc-buffer-sync-fileset (list log-edit-vc-backend vc-log-fileset)) (unless vc-log-operation (error "No log operation is pending")) ;; save the parameters held in buffer-local variables (let ((logbuf (current-buffer)) - (log-operation vc-log-operation) - ;; FIXME: When coming from VC-Dir, we should check that the - ;; set of selected files is still equal to vc-log-fileset, - ;; to avoid surprises. - (log-fileset vc-log-fileset) - (log-entry (buffer-string)) - (after-hook vc-log-after-operation-hook)) - (pop-to-buffer vc-parent-buffer) + (log-operation vc-log-operation) + (log-fileset vc-log-fileset) + (log-entry (buffer-string)) + (after-hook vc-log-after-operation-hook) + (parent vc-parent-buffer)) ;; OK, do it to it - (save-excursion - (funcall log-operation - log-fileset - log-entry)) - (setq vc-log-operation nil) + (let ((log-operation-ret + (with-current-buffer parent + (funcall log-operation log-fileset log-entry)))) + (pop-to-buffer parent) + (setq vc-log-operation nil) - ;; Quit windows on logbuf. - (cond ((not logbuf)) - (vc-delete-logbuf-window - (quit-windows-on logbuf t (selected-frame))) - (t - (quit-windows-on logbuf nil 0))) + ;; Quit windows on logbuf. + (cond ((not logbuf)) + (vc-delete-logbuf-window + (quit-windows-on logbuf t (selected-frame))) + (t + (quit-windows-on logbuf nil 0))) - ;; Now make sure we see the expanded headers - (mapc (lambda (file) (vc-resynch-buffer file t t)) log-fileset) - (run-hooks after-hook 'vc-finish-logentry-hook))) + ;; Now make sure we see the expanded headers. + ;; If the `vc-log-operation' started an async operation then we + ;; need to delay running the hooks. It tells us whether it did + ;; that with a special return value. + (cl-flet ((resynch-and-hooks () + (when (buffer-live-p parent) + (with-current-buffer parent + (mapc (lambda (file) (vc-resynch-buffer file t t)) + log-fileset) + (run-hooks after-hook 'vc-finish-logentry-hook))))) + (if (eq (car-safe log-operation-ret) 'async) + (vc-exec-after #'resynch-and-hooks nil (cadr log-operation-ret)) + (resynch-and-hooks)))))) (defun vc-dispatcher-browsing () "Are we in a directory browser buffer?" @@ -902,6 +906,16 @@ the buffer contents as a comment." (derived-mode-p 'diff-mode) (derived-mode-p 'log-view-mode))) +(declare-function vc-dir-marked-files "vc-dir") +(declare-function dired-get-marked-files "dired") + +(defun vc-dispatcher--explicit-marks-p () + "Are any files in the directory browser explicitly marked?" + (or (and (derived-mode-p 'vc-dir-mode) + (vc-dir-marked-files)) + (and (derived-mode-p 'dired-mode) + (length> (dired-get-marked-files nil nil nil t) 1)))) + ;; These are unused. ;; (defun vc-dispatcher-in-fileset-p (fileset) ;; (let ((member nil)) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 67375255f19..ef7f84ee3ac 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1144,8 +1144,7 @@ It is based on `log-edit-mode', and has Git-specific extensions." (defalias 'vc-git-async-checkins #'always) (defun vc-git-checkin (files comment &optional _rev) - (let* ((parent (current-buffer)) - (file1 (or (car files) default-directory)) + (let* ((file1 (or (car files) default-directory)) (root (vc-git-root file1)) (default-directory (expand-file-name root)) (only (or (cdr files) @@ -1273,11 +1272,9 @@ It is based on `log-edit-mode', and has Git-specific extensions." (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git) - (funcall post) - (when (buffer-live-p parent) - (with-current-buffer parent - (run-hooks 'vc-checkin-hook))))) - (vc-set-async-update buffer)) + (funcall post))) + (vc-set-async-update buffer) + (list 'async (get-buffer-process buffer))) (apply #'vc-git-command nil 0 files args) (funcall post))))) @@ -1560,7 +1557,7 @@ If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'. \(This requires at least Git version 1.5.6, for the --graph option.) If START-REVISION is non-nil, it is the newest revision to show. If LIMIT is a number, show no more than this many entries. -If LIMIT is a revision string, use it as an end-revision." +If LIMIT is a non-empty string, use it as a base revision." (let ((coding-system-for-read (or coding-system-for-read vc-git-log-output-coding-system))) ;; `vc-do-command' creates the buffer, but we need it before running @@ -1568,7 +1565,19 @@ If LIMIT is a revision string, use it as an end-revision." (vc-setup-buffer buffer) ;; If the buffer exists from a previous invocation it might be ;; read-only. - (let ((inhibit-read-only t)) + (let ((inhibit-read-only t) + ;; In some parts of Git's revision and revision range + ;; notation, an empty string is equivalent to "HEAD", but not + ;; everywhere. For simplicity we'll always be explicit. + (start-revision (if (member start-revision '(nil "")) + "HEAD" + start-revision)) + ;; An empty string LIMIT doesn't make sense given the + ;; specification of this VC backend function, and is tricky to + ;; deal with in combination with Git's double-dot notation for + ;; specifying revision ranges. So discard it right away. + (limit (and (not (equal limit "")) + limit))) (with-current-buffer buffer (apply #'vc-git-command buffer 'async files @@ -1591,14 +1600,11 @@ If LIMIT is a revision string, use it as an end-revision." (if shortlog vc-git-shortlog-switches vc-git-log-switches)) (when (numberp limit) (list "-n" (format "%s" limit))) - (when start-revision - (if (and limit (not (numberp limit))) - (list (concat start-revision ".." (if (equal limit "") - "HEAD" - limit))) - (list start-revision))) (when (eq vc-log-view-type 'with-diff) (list "-p")) + (list (concat (and (stringp limit) + (concat limit "..")) + start-revision)) '("--"))))))) (defun vc-git-incoming-revision (remote-location) @@ -1928,13 +1934,18 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." ;;; MISCELLANEOUS +(defsubst vc-git--maybe-abbrev () + (if vc-use-short-revision "--abbrev-commit" "--no-abbrev-commit")) + (defun vc-git-previous-revision (file rev) "Git-specific version of `vc-previous-revision'." (if file (let* ((fname (file-relative-name file)) (prev-rev (with-temp-buffer (and - (vc-git--out-ok "rev-list" "-2" rev "--" fname) + (vc-git--out-ok "rev-list" + (vc-git--maybe-abbrev) + "-2" rev "--" fname) (goto-char (point-max)) (bolp) (zerop (forward-line -1)) @@ -1965,7 +1976,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (current-rev (with-temp-buffer (and - (vc-git--out-ok "rev-list" "-1" rev "--" file) + (vc-git--out-ok "rev-list" + (vc-git--maybe-abbrev) + "-1" rev "--" file) (goto-char (point-max)) (bolp) (zerop (forward-line -1)) @@ -1977,7 +1990,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (and current-rev (with-temp-buffer (and - (vc-git--out-ok "rev-list" "HEAD" "--" file) + (vc-git--out-ok "rev-list" + (vc-git--maybe-abbrev) + "HEAD" "--" file) (goto-char (point-min)) (search-forward current-rev nil t) (zerop (forward-line -1)) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 76d5529ff45..761e802eb22 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -408,6 +408,7 @@ specific file to query." "Print commit log associated with FILES into specified BUFFER. If SHORTLOG is non-nil, use a short format based on `vc-hg-root-log-format'. If LIMIT is a positive integer, show no more than that many entries. +If LIMIT is a non-empty string, use it as a base revision. If START-REVISION is nil, print the commit log starting from the working directory parent (revset \".\"). If START-REVISION is a string, print @@ -417,17 +418,46 @@ the log starting from that revision." (vc-setup-buffer buffer) ;; If the buffer exists from a previous invocation it might be ;; read-only. - (let ((inhibit-read-only t)) - (with-current-buffer - buffer + (let ((inhibit-read-only t) + ;; Normalize START-REVISION parameter. + (start (if (member start-revision '(nil "")) + "." + start-revision))) + (with-current-buffer buffer (apply #'vc-hg-command buffer 'async files "log" - (format "-r%s:0" (or start-revision ".")) + ;; With Mercurial logs there are are, broadly speaking, two + ;; kinds of ranges of revisions for the log to show: + ;; - ranges by revision number: -rN:M + ;; - ranges according to the DAG: -rN::M or -rN..M + ;; Note that N & M can be revision numbers or changeset IDs + ;; (hashes). In either case a revision number range + ;; includes those commits with revision numbers between the + ;; revision numbers of the commits identified by N and M. + ;; See <https://repo.mercurial-scm.org/hg/help/revsets>. + ;; + ;; DAG ranges might seem like Git's double-dot notation for + ;; ranges, but there is (at least) the following + ;; difference: with -rN::M, commits from other branches + ;; aren't included in the log. + ;; + ;; VC has always used ranges by revision numbers, such that + ;; commits from all branches are included in the log. + ;; `vc-log-outgoing' is a special case: there we really + ;; need to exclude the incoming revision and its ancestors + ;; because those are certainly not outgoing. + (cond ((not (stringp limit)) + (format "-r%s:0" start)) + ((eq vc-log-view-type 'log-outgoing) + (format "-rreverse(%s::%s & !%s)" limit start limit)) + (t + (format "-r%s:%s & !%s" start limit limit))) (nconc - (when limit (list "-l" (format "%s" limit))) - (when (eq vc-log-view-type 'with-diff) - (list "-p")) + (and (numberp limit) + (list "-l" (format "%s" limit))) + (and (eq vc-log-view-type 'with-diff) + (list "-p")) (if shortlog - `(,@(if vc-hg-log-graph '("--graph")) + `(,@(and vc-hg-log-graph '("--graph")) "--template" ,(car vc-hg-root-log-format)) `("--template" ,vc-hg-log-format)) @@ -441,39 +471,40 @@ the log starting from that revision." (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View" (require 'add-log) ;; we need the add-log faces - (setq-local log-view-file-re regexp-unmatchable) - (setq-local log-view-per-file-logs nil) - (setq-local log-view-message-re - (if (eq vc-log-view-type 'short) - (cadr vc-hg-root-log-format) - "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")) - (setq-local tab-width 2) - ;; Allow expanding short log entries - (when (eq vc-log-view-type 'short) - (setq truncate-lines t) - (setq-local log-view-expanded-log-entry-function - 'vc-hg-expanded-log-entry)) - (setq-local log-view-font-lock-keywords - (if (eq vc-log-view-type 'short) - (list (cons (nth 1 vc-hg-root-log-format) - (nth 2 vc-hg-root-log-format))) - (append - log-view-font-lock-keywords - '( - ;; Handle the case: - ;; user: FirstName LastName <foo@bar> - ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" - (1 'change-log-name) - (2 'change-log-email)) - ;; Handle the cases: - ;; user: foo@bar - ;; and - ;; user: foo - ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)" - (1 'change-log-email)) - ("^date: \\(.+\\)" (1 'change-log-date)) - ("^tag: +\\([^ ]+\\)$" (1 'highlight)) - ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) + (let ((shortp (memq vc-log-view-type '(short log-incoming log-outgoing)))) + (setq-local log-view-file-re regexp-unmatchable) + (setq-local log-view-per-file-logs nil) + (setq-local log-view-message-re + (if shortp + (cadr vc-hg-root-log-format) + "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")) + (setq-local tab-width 2) + ;; Allow expanding short log entries. + (when shortp + (setq truncate-lines t) + (setq-local log-view-expanded-log-entry-function + 'vc-hg-expanded-log-entry)) + (setq-local log-view-font-lock-keywords + (if shortp + (list (cons (nth 1 vc-hg-root-log-format) + (nth 2 vc-hg-root-log-format))) + (append + log-view-font-lock-keywords + '( + ;; Handle the case: + ;; user: FirstName LastName <foo@bar> + ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" + (1 'change-log-name) + (2 'change-log-email)) + ;; Handle the cases: + ;; user: foo@bar + ;; and + ;; user: foo + ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)" + (1 'change-log-email)) + ("^date: \\(.+\\)" (1 'change-log-date)) + ("^tag: +\\([^ ]+\\)$" (1 'highlight)) + ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))) (autoload 'vc-switches "vc") @@ -1188,8 +1219,7 @@ It is based on `log-edit-mode', and has Hg-specific extensions.") (defun vc-hg-checkin (files comment &optional _rev) "Hg-specific version of `vc-backend-checkin'. REV is ignored." - (let ((parent (current-buffer)) - (args (nconc (list "commit" "-m") + (let ((args (nconc (list "commit" "-m") (vc-hg--extract-headers comment)))) (if vc-async-checkin (let ((buffer (vc-hg--async-buffer))) @@ -1198,11 +1228,9 @@ REV is ignored." "Finishing checking in files...") (with-current-buffer buffer (vc-run-delayed - (vc-compilation-mode 'hg) - (when (buffer-live-p parent) - (with-current-buffer parent - (run-hooks 'vc-checkin-hook))))) - (vc-set-async-update buffer)) + (vc-compilation-mode 'hg))) + (vc-set-async-update buffer) + (list 'async (get-buffer-process buffer))) (apply #'vc-hg-command nil 0 files args)))) (defun vc-hg-checkin-patch (patch-string comment) @@ -1463,40 +1491,27 @@ This runs the command \"hg summary\"." (nreverse result)) "\n")))) -;; FIXME: Resolve issue with `vc-hg-mergebase' and then delete this. -(defun vc-hg-log-incoming (buffer remote-location) - (vc-setup-buffer buffer) - (vc-hg-command buffer 1 nil "incoming" "-n" - (and (not (string-empty-p remote-location)) - remote-location))) - (defun vc-hg-incoming-revision (remote-location) - (let ((output (with-output-to-string - ;; Exits 1 to mean nothing to pull. - (vc-hg-command standard-output 1 nil - "incoming" "-qn" "--limit=1" - "--template={node}" - (and (not (string-empty-p remote-location)) - remote-location))))) - (and (not (string-empty-p output)) - output))) + (let* ((remote-location (if (string-empty-p remote-location) + "default" + remote-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}")))) + (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))) + rev)) -;; FIXME: Resolve issue with `vc-hg-mergebase' and then delete this. -(defun vc-hg-log-outgoing (buffer remote-location) - (vc-setup-buffer buffer) - (vc-hg-command buffer 1 nil "outgoing" "-n" - (and (not (string-empty-p remote-location)) - remote-location))) - -;; FIXME: This works only when both rev1 and rev2 have already been pulled. -;; That means it can't do the work -;; `vc-default-log-incoming' and `vc-default-log-outgoing' need it to do. (defun vc-hg-mergebase (rev1 &optional rev2) - (or (vc-hg--run-log "{node}" - (format "last(ancestors(%s) and ancestors(%s))" - rev1 (or rev2 "tip")) - nil) - (error "No common ancestor for merge base"))) + (with-output-to-string + (vc-hg-command standard-output 0 nil "log" + (format "--rev=last(ancestors(%s) and ancestors(%s))" + rev1 (or rev2 ".")) + "--limit=1" "--template={node}"))) (defvar vc-hg-error-regexp-alist '(("^M \\(.+\\)" 1 nil nil 0)) @@ -1623,8 +1638,10 @@ This runs the command \"hg merge\"." (defun vc-hg-command (buffer okstatus file-or-list &rest flags) "A wrapper around `vc-do-command' for use in vc-hg.el. -This function differs from `vc-do-command' in that it invokes -`vc-hg-program', and passes `vc-hg-global-switches' to it before FLAGS." +This function differs from `vc-do-command' in that +- BUFFER may be nil +- it invokes `vc-hg-program' and passes `vc-hg-global-switches' to it + before FLAGS." (vc-hg--command-1 #'vc-do-command (list (or buffer "*vc*") okstatus vc-hg-program file-or-list) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index f9fa3e1bd7e..59226d6f066 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -270,7 +270,7 @@ and else calls (apply #\\='vc-default-FUN BACKEND ARGS) -It is usually called via the `vc-call' macro." +See also the `vc-call' macro." (let ((f (assoc function-name (get backend 'vc-functions)))) (if f (setq f (cdr f)) (setq f (vc-find-backend-function backend function-name)) @@ -377,7 +377,10 @@ backend is tried first." (defun vc-backend (file-or-list) "Return the version control type of FILE-OR-LIST, nil if it's not registered. -If the argument is a list, the files must all have the same back end." +If the argument is a list, the files must all have the same back end. + +This function returns cached information. To query the VCS regarding +whether FILE-OR-LIST is registered or unregistered, use `vc-registered'." ;; `file' can be nil in several places (typically due to the use of ;; code like (vc-backend buffer-file-name)). (cond ((stringp file-or-list) @@ -951,6 +954,30 @@ In the latter case, VC mode is deactivated for this buffer." (fset 'vc-prefix-map vc-prefix-map) (define-key ctl-x-map "v" 'vc-prefix-map) +(defvar-keymap vc-incoming-prefix-map + "L" #'vc-log-incoming + "D" #'vc-root-diff-incoming) +(defvar-keymap vc-outgoing-prefix-map + "L" #'vc-log-outgoing + "D" #'vc-root-diff-outgoing) + +(defcustom vc-use-incoming-outgoing-prefixes nil + "Whether \\`C-x v I' and \\`C-x v O' are prefix commands. +Historically Emacs bound \\`C-x v I' and \\`C-x v O' directly to +commands. That is still the default. If this option is customized to +non-nil, these key sequences becomes prefix commands. `vc-log-incoming' +moves to \\`C-x v I L', `vc-log-outgoing' moves to \\`C-x v O L', and +other commands receive global bindings where they had none before." + :type 'boolean + :version "31.1" + :set (lambda (symbol value) + (if value + (progn (keymap-set vc-prefix-map "I" vc-incoming-prefix-map) + (keymap-set vc-prefix-map "O" vc-outgoing-prefix-map)) + (keymap-set vc-prefix-map "I" #'vc-log-incoming) + (keymap-set vc-prefix-map "O" #'vc-log-outgoing)) + (set-default symbol value))) + (defvar vc-menu-map (let ((map (make-sparse-keymap "Version Control"))) ;;(define-key map [show-files] diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4233f6bd3f8..63de0ae0c1b 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -350,7 +350,8 @@ ;; Insert the revision log for FILES into BUFFER. ;; If SHORTLOG is non-nil insert a short version of the log. ;; If LIMIT is non-nil insert only insert LIMIT log entries. -;; When LIMIT is a string it means stop at that revision. +;; When LIMIT is a string it means stop right before that revision +;; (i.e., revision LIMIT itself should not be included in the log). ;; If the backend does not support limiting the number of entries to ;; show it should return `limit-unsupported'. ;; If START-REVISION is given, then show the log starting from that @@ -375,6 +376,8 @@ ;; 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. ;; ;; - log-search (buffer pattern) ;; @@ -1078,24 +1081,26 @@ If any of FILES is actually a directory, then do the same for all buffers for files in that directory. SETTINGS is an association list of property/value pairs. After executing FORM, set those properties from SETTINGS that have not yet -been updated to their corresponding values." +been updated to their corresponding values. +Return the result of evaluating FORM." (declare (debug t)) - `(let ((vc-touched-properties (list t)) - (flist nil)) - (dolist (file ,files) - (if (file-directory-p file) - (dolist (buffer (buffer-list)) - (let ((fname (buffer-file-name buffer))) - (when (and fname (string-prefix-p file fname)) - (push fname flist)))) - (push file flist))) - ,form - (dolist (file flist) - (dolist (setting ,settings) - (let ((property (car setting))) - (unless (memq property vc-touched-properties) - (put (intern file vc-file-prop-obarray) - property (cdr setting)))))))) + (cl-with-gensyms (vc-touched-properties flist) + `(let ((,vc-touched-properties (list t)) + (,flist nil)) + (prog2 (dolist (file ,files) + (if (file-directory-p file) + (dolist (buffer (buffer-list)) + (let ((fname (buffer-file-name buffer))) + (when (and fname (string-prefix-p file fname)) + (push fname ,flist)))) + (push file ,flist))) + ,form + (dolist (file ,flist) + (dolist (setting ,settings) + (let ((property (car setting))) + (unless (memq property ,vc-touched-properties) + (put (intern file vc-file-prop-obarray) + property (cdr setting)))))))))) ;;; Code for deducing what fileset and backend to assume @@ -1950,39 +1955,80 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (lambda () (vc-call-backend backend 'log-edit-mode)) (lambda (files comment) + ;; Check the user isn't likely to be surprised by what is included + ;; in the checkin. Once a log operation is started, the fileset + ;; or patch string is locked in. In particular, it's probably too + ;; late to offer to change it now -- checks in hooks and/or the + ;; backend's Log Edit derived mode have all already okayed the + ;; checkin. Restarting with the new fileset or patch is easy. + (let* ((start-again + (substitute-command-keys "\\[vc-next-action] to check in again")) + (instructions + (substitute-command-keys + (string-join + (list "type \\<log-edit-mode-map>\\[log-edit-kill-buffer] to cancel" + start-again + "\\[log-edit-previous-comment] to recall your message") + ", ")))) + (cond (patch-string + (unless (or (not (derived-mode-p 'diff-mode)) + (equal patch-string (buffer-string)) + (yes-or-no-p + (format-message "Patch in buffer \"%s\" \ +has changed; continue with old patch?" (current-buffer)))) + (user-error "%s %s" + "To check in the new patch" instructions))) + ((vc-dispatcher-browsing) + (unless (or (and (length= files 1) + ;; If no files in the dispatcher were + ;; marked and it was just that point + ;; moved to a different line, we don't + ;; want to bother the user. This isn't + ;; foolproof because we don't know + ;; whether FILES was selected by means + ;; of marking a single file or the + ;; implicit selection of the file at + ;; point in the absence of any marks. + (not (vc-dispatcher--explicit-marks-p))) + (equal files (cadr (vc-deduce-fileset))) + (yes-or-no-p + (format-message "Selected file(s) in buffer \"%s\" \ +have changed; continue with old fileset?" (current-buffer)))) + (user-error "%s %s" + "To use the new fileset" instructions))))) + ;; "This log message intentionally left almost blank". ;; RCS 5.7 gripes about whitespace-only comments too. (unless (and comment (string-match "[^\t\n ]" comment)) (setq comment "*** empty log message ***")) - (when register (vc-register (list backend files))) - (cl-labels ((do-it () - ;; We used to change buffers to get local value of - ;; `vc-checkin-switches', but the (singular) local - ;; buffer is not well defined for filesets. - (if patch-string - (vc-call-backend backend 'checkin-patch - patch-string comment) - (vc-call-backend backend 'checkin - files comment rev)) - (mapc #'vc-delete-automatic-version-backups files))) + (unless patch-string + ;; Must not pass non-nil NOT-ESSENTIAL because we will shortly + ;; call (in `vc-finish-logentry') `vc-resynch-buffer' with its + ;; NOQUERY parameter non-nil. + (vc-buffer-sync-fileset (list backend files))) + (when register (vc-register (list backend register))) + (cl-flet ((do-it () + ;; We used to change buffers to get local value of + ;; `vc-checkin-switches', but the (singular) local + ;; buffer is not well defined for filesets. + (prog1 (if patch-string + (vc-call-backend backend 'checkin-patch + patch-string comment) + (vc-call-backend backend 'checkin + files comment rev)) + (mapc #'vc-delete-automatic-version-backups files)))) (if do-async ;; Rely on `vc-set-async-update' to update properties. (do-it) - (message "Checking in %s..." (vc-delistify files)) - (with-vc-properties files (do-it) - `((vc-state . up-to-date) - (vc-checkout-time - . ,(file-attribute-modification-time - (file-attributes file))) - (vc-working-revision . nil))) - (message "Checking in %s...done" (vc-delistify files))))) - - ;; FIXME: In the async case we need the hook to be added to the - ;; buffer with the checkin process, using `vc-run-delayed'. Ideally - ;; the identity of that buffer would be exposed to this code, - ;; somehow, so we could always handle running the hook up here. - (and (not do-async) 'vc-checkin-hook) - + (prog2 (message "Checking in %s..." (vc-delistify files)) + (with-vc-properties files (do-it) + `((vc-state . up-to-date) + (vc-checkout-time + . ,(file-attribute-modification-time + (file-attributes file))) + (vc-working-revision . nil))) + (message "Checking in %s...done" (vc-delistify files)))))) + 'vc-checkin-hook backend patch-string))) @@ -2449,6 +2495,72 @@ The merge base is a common ancestor between REV1 and REV2 revisions." vc-allow-async-diff (list backend (list rootdir)) rev1 rev2 (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. + +See `vc-use-incoming-outgoing-prefixes' regarding giving this command a +global binding." + (interactive (vc--maybe-read-remote-location)) + (vc--with-backend-in-rootdir "VC root-diff" + (let ((default-directory rootdir) + (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))))) + +;;;###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. + +See `vc-use-incoming-outgoing-prefixes' regarding giving this command a +global binding." + ;; For this command, for distributed VCS, we want to ignore + ;; uncommitted changes because those are not outgoing, and the point + ;; 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)) + (vc--with-backend-in-rootdir "VC root-diff" + (let ((default-directory rootdir) + (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))))) + (declare-function ediff-load-version-control "ediff" (&optional silent)) (declare-function ediff-vc-internal "ediff-vers" (rev1 rev2 &optional startup-hooks)) @@ -2645,7 +2757,7 @@ Unlike `vc-find-revision-save', doesn't save the buffer to the file." ;; to not ignore 'enable-local-variables' when nil. (normal-mode (not enable-local-variables))) (set-buffer-modified-p nil) - (setq buffer-read-only t) + (read-only-mode 1) (setq failed nil)) (when (and failed (unless buffer (get-file-buffer filename))) (with-current-buffer (get-file-buffer filename) @@ -3291,49 +3403,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)))) +(defvar vc-remote-location-history nil + "History for remote locations for VC incoming and outgoing commands.") + +(defun vc--maybe-read-remote-location () + (and current-prefix-arg + (list (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) + (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 - (when current-prefix-arg - (list (read-string "Remote location/branch (empty for default): ")))) + (interactive (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))) (defun vc-default-log-incoming (_backend buffer remote-location) (vc--with-backend-in-rootdir "" - (let ((incoming (or (vc-call-backend backend - 'incoming-revision - remote-location) - (user-error "No incoming revision -- local-only branch?")))) + (let ((incoming (vc--incoming-revision backend remote-location))) (vc-call-backend backend 'print-log (list rootdir) buffer t - (vc-call-backend backend 'mergebase incoming) - incoming)))) + 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 - (when current-prefix-arg - (list (read-string "Remote location/branch (empty for default): ")))) + (interactive (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))) (defun vc-default-log-outgoing (_backend buffer remote-location) (vc--with-backend-in-rootdir "" - (let ((incoming (or (vc-call-backend backend - 'incoming-revision - remote-location) - (user-error "No incoming revision -- local-only branch?")))) + (let ((incoming (vc--incoming-revision backend remote-location))) (vc-call-backend backend 'print-log (list rootdir) buffer t - (vc-call-backend backend 'mergebase incoming) - "")))) + "" + (vc-call-backend backend 'mergebase incoming))))) ;;;###autoload (defun vc-log-search (pattern) @@ -3367,7 +3483,7 @@ The merge base is a common ancestor of revisions REV1 and REV2." (list backend (list (vc-call-backend backend 'root default-directory))))))) (vc--with-backend-in-rootdir "VC root-log" (setq rev1 (vc-call-backend backend 'mergebase rev1 rev2)) - (vc-print-log-internal backend (list rootdir) rev1 t (or rev2 "")))) + (vc-print-log-internal backend (list rootdir) (or rev2 "") t rev1))) ;;;###autoload (defun vc-region-history (from to) @@ -3589,7 +3705,7 @@ For entries in FILES that are directories, revert all files inside them." (mapc #'vc-revert-file files) (with-vc-properties files (vc-call-backend backend 'revert-files files) - `((vc-state . up-to-date))) + '((vc-state . up-to-date))) (dolist (file files) (vc-file-setprop file 'vc-checkout-time (file-attribute-modification-time diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index db241ca914a..311e39f4c0f 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1383,19 +1383,23 @@ nothing is shown in the echo area." (widget-echo-help (point))) (run-hooks 'widget-move-hook)) -(defun widget-forward (arg) +(defun widget-forward (arg &optional suppress-echo) "Move point to the next field or button. -With optional ARG, move across that many fields." +With optional ARG, move across that many fields. +When the second optional argument is non-nil, +nothing is shown in the echo area." (interactive "p") (run-hooks 'widget-forward-hook) - (widget-move arg)) + (widget-move arg suppress-echo)) -(defun widget-backward (arg) +(defun widget-backward (arg &optional suppress-echo) "Move point to the previous field or button. -With optional ARG, move across that many fields." +With optional ARG, move across that many fields. +When the second optional argument is non-nil, +nothing is shown in the echo area." (interactive "p") (run-hooks 'widget-backward-hook) - (widget-move (- arg))) + (widget-move (- arg) suppress-echo)) ;; Since the widget code uses a `field' property to identify fields, ;; ordinary beginning-of-line does the right thing. diff --git a/lisp/windmove.el b/lisp/windmove.el index 4d122c08158..d69a09f3d1e 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -586,6 +586,9 @@ When `switch-to-buffer-obey-display-actions' is non-nil, "Display the next buffer in the window at direction DIR. The next buffer is the buffer displayed by the next command invoked immediately after this command (ignoring reading from the minibuffer). +In case of multiple consecutive mouse events such as <down-mouse-1>, +a mouse release event <mouse-1>, <double-mouse-1>, <triple-mouse-1> +all bound commands are handled until one of them displays a buffer. Create a new window if there is no window in that direction. By default, select the new window with a displayed buffer. diff --git a/lisp/window.el b/lisp/window.el index e372ef8b9bb..e229562163b 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4076,6 +4076,9 @@ always effectively nil." "Display the buffer of the next command in a new window. The next buffer is the buffer displayed by the next command invoked immediately after this command (ignoring reading from the minibuffer). +In case of multiple consecutive mouse events such as <down-mouse-1>, +a mouse release event <mouse-1>, <double-mouse-1>, <triple-mouse-1> +all bound commands are handled until one of them displays a buffer. Creates a new window before displaying the buffer. When `switch-to-buffer-obey-display-actions' is non-nil, `switch-to-buffer' commands are also supported." @@ -4096,6 +4099,9 @@ When `switch-to-buffer-obey-display-actions' is non-nil, "Display the buffer of the next command in the same window. The next buffer is the buffer displayed by the next command invoked immediately after this command (ignoring reading from the minibuffer). +In case of multiple consecutive mouse events such as <down-mouse-1>, +a mouse release event <mouse-1>, <double-mouse-1>, <triple-mouse-1> +all bound commands are handled until one of them displays a buffer. Even when the default rule should display the buffer in a new window, force its display in the already selected window. When `switch-to-buffer-obey-display-actions' is non-nil, @@ -5899,6 +5905,16 @@ changed by this function." window (- (if new-parent 1.0 (window-normal-size window horizontal)) new-normal))) + (unless horizontal + (let ((quit-restore (window-parameter window 'quit-restore))) + (when quit-restore + (let ((quad (nth 1 quit-restore))) + (when (and (listp quad) (integerp (nth 3 quad))) + ;; When WINDOW has a 'quit-restore' parameter that + ;; specifies a previous height to restore, remove that + ;; - it does more harm than good now (Bug#78835). + (setf (nth 3 quad) nil)))))) + (let ((new (split-window-internal window new-pixel-size side new-normal refer))) (window--pixel-to-total frame horizontal) @@ -9657,12 +9673,15 @@ to deactivate this overriding action." (fset postfun (lambda () (unless (or - ;; Remove the hook immediately - ;; after exiting the minibuffer. - (> (minibuffer-depth) minibuffer-depth) - ;; But don't remove immediately after - ;; adding the hook by the same command below. - (eq this-command command)) + ;; Remove the hook immediately + ;; after exiting the minibuffer. + (> (minibuffer-depth) minibuffer-depth) + ;; But don't remove immediately after + ;; adding the hook by the same command below. + (eq this-command command) + ;; Don't exit on mouse events in anticipation + ;; of more related events like double click. + (mouse-event-p last-input-event)) (funcall exitfun)))) ;; Call post-function after the next command finishes (bug#49057). (add-hook 'post-command-hook postfun) diff --git a/m4/acl.m4 b/m4/acl.m4 index 7e4b0e354d9..2dd33497efd 100644 --- a/m4/acl.m4 +++ b/m4/acl.m4 @@ -1,5 +1,5 @@ # acl.m4 -# serial 35 +# serial 37 dnl Copyright (C) 2002, 2004-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -12,7 +12,6 @@ dnl This file is offered as-is, without any warranty. AC_DEFUN([gl_FUNC_ACL_ARG], [ - gl_need_lib_has_acl= AC_ARG_ENABLE([acl], AS_HELP_STRING([[--disable-acl]], [do not support ACLs]), , [enable_acl=auto]) @@ -22,6 +21,7 @@ AC_DEFUN([gl_FUNC_ACL_ARG], [], [with_libsmack=maybe]) ]) +# Prerequisites of module acl-permissions. AC_DEFUN_ONCE([gl_FUNC_ACL], [ AC_REQUIRE([gl_FUNC_ACL_ARG]) @@ -145,9 +145,6 @@ int type = ACL_TYPE_EXTENDED;]])], AC_MSG_WARN([AC_PACKAGE_NAME will be built without ACL support.]) fi fi - if test -n "$gl_need_lib_has_acl"; then - FILE_HAS_ACL_LIB=$LIB_ACL - fi AC_SUBST([LIB_ACL]) AC_DEFINE_UNQUOTED([USE_ACL], [$use_acl], [Define to nonzero if you want access control list support.]) @@ -187,6 +184,7 @@ AC_DEFUN([gl_ACL_GET_FILE], AC_DEFUN([gl_FILE_HAS_ACL], [ AC_REQUIRE([gl_FUNC_ACL_ARG]) + AC_REQUIRE([gl_FUNC_ACL]) # On GNU/Linux, testing if a file has an acl can be done with the # listxattr and getxattr syscalls, which don't require linking # against additional libraries. Assume this works if linux/attr.h @@ -224,10 +222,7 @@ AC_DEFUN([gl_FILE_HAS_ACL], AS_CASE([$enable_acl,$gl_file_has_acl_uses_selinux,$gl_file_has_acl_uses_smack], [no,* | *,yes,* | *,yes], [], [*], - [dnl Set gl_need_lib_has_acl to a nonempty value, so that any - dnl later gl_FUNC_ACL call will set FILE_HAS_ACL_LIB=$LIB_ACL. - gl_need_lib_has_acl=1 - FILE_HAS_ACL_LIB=$LIB_ACL]) + [FILE_HAS_ACL_LIB=$LIB_ACL]) AC_SUBST([FILE_HAS_ACL_LIB]) ]) @@ -235,10 +230,11 @@ AC_DEFUN([gl_FILE_HAS_ACL], AC_DEFUN([gl_QCOPY_ACL], [ AC_REQUIRE([gl_FUNC_ACL]) + AC_REQUIRE([gl_FILE_HAS_ACL]) AC_CHECK_HEADERS_ONCE([linux/xattr.h]) gl_FUNC_XATTR if test "$use_xattr" = yes; then - QCOPY_ACL_LIB="$LIB_XATTR" + QCOPY_ACL_LIB="$LIB_XATTR $FILE_HAS_ACL_LIB" else QCOPY_ACL_LIB="$LIB_ACL" fi diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index a07c7dd5a89..d525d8b1faa 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,5 +1,5 @@ # gnulib-common.m4 -# serial 110 +# serial 112 dnl Copyright (C) 2007-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -57,33 +57,24 @@ AC_DEFUN([gl_COMMON_BODY], [ #endif ]) AH_VERBATIM([_Noreturn], -[/* The _Noreturn keyword of C11. */ +[/* The _Noreturn keyword of C11. + Do not use [[noreturn]], because with it the syntax + extern _Noreturn void func (...); + would not be valid; such a declaration would be valid only with 'extern' + and '_Noreturn' swapped, or without the 'extern' keyword. However, some + AIX system header files and several gnulib header files use precisely + this syntax with 'extern'. So even though C23 deprecates _Noreturn, + it is currently more portable to prefer it to [[noreturn]]. + + Also, do not try to work around LLVM bug 59792 (clang 15 or earlier). + This rare bug can be worked around by compiling with 'clang -D_Noreturn=', + though the workaround may generate many false-alarm warnings. */ #ifndef _Noreturn -# if (defined __cplusplus \ - && ((201103 <= __cplusplus && !(__GNUC__ == 4 && __GNUC_MINOR__ == 7)) \ - || (defined _MSC_VER && 1900 <= _MSC_VER)) \ - && 0) - /* [[noreturn]] is not practically usable, because with it the syntax - extern _Noreturn void func (...); - would not be valid; such a declaration would only be valid with 'extern' - and '_Noreturn' swapped, or without the 'extern' keyword. However, some - AIX system header files and several gnulib header files use precisely - this syntax with 'extern'. */ -# define _Noreturn [[noreturn]] -# elif (defined __clang__ && __clang_major__ < 16 \ - && defined _GL_WORK_AROUND_LLVM_BUG_59792) - /* Compile with -D_GL_WORK_AROUND_LLVM_BUG_59792 to work around - that rare LLVM bug, though you may get many false-alarm warnings. */ -# define _Noreturn -# elif ((!defined __cplusplus || defined __clang__) \ - && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \ - || (!defined __STRICT_ANSI__ \ - && (_GL_GNUC_PREREQ (4, 7) \ - || (defined __apple_build_version__ \ - ? 6000000 <= __apple_build_version__ \ - : 3 < __clang_major__ + (5 <= __clang_minor__)))))) +# if 201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) /* _Noreturn works as-is. */ # elif _GL_GNUC_PREREQ (2, 8) || defined __clang__ || 0x5110 <= __SUNPRO_C + /* Prefer __attribute__ ((__noreturn__)) to plain _Noreturn even if the + latter works, as 'gcc -std=gnu99 -Wpedantic' warns about _Noreturn. */ # define _Noreturn __attribute__ ((__noreturn__)) # elif 1200 <= (defined _MSC_VER ? _MSC_VER : 0) # define _Noreturn __declspec (noreturn) @@ -955,8 +946,8 @@ AC_DEFUN([gl_COMMON_BODY], [ -1 if n1 < n2 The naïve code (n1 > n2 ? 1 : n1 < n2 ? -1 : 0) produces a conditional jump with nearly all GCC versions up to GCC 10. - This variant (n1 < n2 ? -1 : n1 > n2) produces a conditional with many - GCC versions up to GCC 9. + This variant (n1 < n2 ? -1 : n1 > n2) produces a conditional jump with + many GCC versions up to GCC 9. The better code (n1 > n2) - (n1 < n2) from Hacker's Delight § 2-9 avoids conditional jumps in all GCC versions >= 3.4. */ #define _GL_CMP(n1, n2) (((n1) > (n2)) - ((n1) < (n2))) @@ -1571,13 +1562,25 @@ AC_DEFUN([gl_CHECK_FUNCS_CASE_FOR_MACOS], if test $[ac_cv_func_][$1] = yes; then [gl_cv_onwards_func_][$1]=yes else + dnl This is a bit complicated, because here we need the behaviour + dnl of AC_CHECK_DECL before the + dnl commit e1bbc9b93cdff61d70719c224b37970e065008bb (2025-05-26). + [ac_cv_have_decl_][$1][_saved]="$[ac_cv_have_decl_][$1]" unset [ac_cv_have_decl_][$1] + ac_c_future_darwin_options_saved="$ac_c_future_darwin_options" + ac_cxx_future_darwin_options_saved="$ac_cxx_future_darwin_options" + ac_c_future_darwin_options= + ac_cxx_future_darwin_options= AC_CHECK_DECL([$1], , , [$2]) + ac_c_future_darwin_options="$ac_c_future_darwin_options_saved" + ac_cxx_future_darwin_options="$ac_cxx_future_darwin_options_saved" if test $[ac_cv_have_decl_][$1] = yes; then [gl_cv_onwards_func_][$1]='future OS version' else [gl_cv_onwards_func_][$1]=no fi + [ac_cv_have_decl_][$1]="$[ac_cv_have_decl_][$1][_saved]" + unset [ac_cv_have_decl_][$1][_saved] fi else AC_CHECK_FUNC([$1]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 97db7d32a66..7e6a8a5494f 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -547,12 +547,7 @@ AC_DEFUN([gl_INIT], GL_STDC_LEADING_ZEROS=1 AC_REQUIRE([gl_STDBIT_H]) GL_STDC_TRAILING_ZEROS=1 - AC_CHECK_HEADERS_ONCE([stdckdint.h]) - if test $ac_cv_header_stdckdint_h = yes; then - GL_GENERATE_STDCKDINT_H=false - else - GL_GENERATE_STDCKDINT_H=true - fi + gl_STDCKDINT_H gl_CONDITIONAL_HEADER([stdckdint.h]) AC_PROG_MKDIR_P gl_STDDEF_H @@ -1558,6 +1553,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/std-gnu11.m4 m4/stdalign.m4 m4/stdbit_h.m4 + m4/stdckdint_h.m4 m4/stddef_h.m4 m4/stdint.m4 m4/stdio_h.m4 diff --git a/m4/libgmp.m4 b/m4/libgmp.m4 index baed8ab1a0a..abf677949dd 100644 --- a/m4/libgmp.m4 +++ b/m4/libgmp.m4 @@ -1,5 +1,5 @@ # libgmp.m4 -# serial 8 +# serial 9 # Configure the GMP library or a replacement. dnl Copyright 2020-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation @@ -34,7 +34,11 @@ AC_DEFUN([gl_LIBGMP], # include <gmp.h> #else # include <gmp/gmp.h> - #endif], + #endif + #if ! (6 < __GNU_MP_VERSION + (2 <= __GNU_MP_VERSION_MINOR)) + # error "GMP < 6.2.0, so mpz_probab_prime_p lacks Baillie-PSW" + #endif + ], [static const mp_limb_t x[2] = { 0x73, 0x55 }; mpz_t tmp; mpz_roinit_n (tmp, x, 2); diff --git a/m4/open.m4 b/m4/open.m4 index 2bceddbdbe3..dd3a805f5e9 100644 --- a/m4/open.m4 +++ b/m4/open.m4 @@ -1,5 +1,5 @@ # open.m4 -# serial 16 +# serial 17 dnl Copyright (C) 2007-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -10,6 +10,9 @@ AC_DEFUN([gl_FUNC_OPEN], [ AC_REQUIRE([AC_CANONICAL_HOST]) AC_REQUIRE([gl_PREPROC_O_CLOEXEC]) + AC_REQUIRE([gl_FCNTL_O_FLAGS]) + AS_CASE([$gl_cv_header_working_fcntl_h], + [*O_DIRECTORY* | *no], [REPLACE_OPEN=1]) case "$host_os" in mingw* | windows* | pw*) REPLACE_OPEN=1 diff --git a/m4/stdckdint_h.m4 b/m4/stdckdint_h.m4 new file mode 100644 index 00000000000..d269faa5c92 --- /dev/null +++ b/m4/stdckdint_h.m4 @@ -0,0 +1,136 @@ +# stdckdint_h.m4 +# serial 1 +dnl Copyright 2025 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. +dnl This file is offered as-is, without any warranty. + +dnl Written by Collin Funk. + +AC_DEFUN_ONCE([gl_STDCKDINT_H], +[ + gl_CHECK_NEXT_HEADERS([stdckdint.h]) + if test $ac_cv_header_stdckdint_h = yes; then + HAVE_STDCKDINT_H=1 + else + HAVE_STDCKDINT_H=0 + fi + AC_SUBST([HAVE_STDCKDINT_H]) + + if test $HAVE_STDCKDINT_H = 1; then + AC_CACHE_CHECK([whether stdckdint.h can be included in C], + [gl_cv_header_c_stdckdint_h], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[#include <stdckdint.h> + ]])], + [gl_cv_header_c_stdckdint_h=yes], + [gl_cv_header_c_stdckdint_h=no])]) + if test $gl_cv_header_c_stdckdint_h = yes; then + HAVE_C_STDCKDINT_H=1 + AC_CACHE_CHECK([checking for an ISO C23 compliant stdckdint.h in C], + [gl_cv_header_c_stdckdint_h_works], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[#include <stdckdint.h> + ]], + [[int r; + int a = 1; + int b = 1; + return !!(ckd_add (&r, a, b) || ckd_sub (&r, a, b) + || ckd_mul (&r, a, b)); + ]])], + [gl_cv_header_c_stdckdint_h_works=yes], + [gl_cv_header_c_stdckdint_h_works=no])]) + if test $gl_cv_header_c_stdckdint_h_works = yes; then + HAVE_WORKING_C_STDCKDINT_H=1 + else + HAVE_WORKING_C_STDCKDINT_H=0 + fi + else + HAVE_C_STDCKDINT_H=0 + HAVE_WORKING_C_STDCKDINT_H=0 + fi + if test "$CXX" != no; then + AC_CACHE_CHECK([whether stdckdint.h can be included in C++], + [gl_cv_header_cxx_stdckdint_h], + [dnl We can't use AC_LANG_PUSH([C++]) and AC_LANG_POP([C++]) here, due to + dnl an autoconf bug <https://savannah.gnu.org/support/?110294>. + cat > conftest.cpp <<\EOF +#include <stdckdint.h> +EOF + gl_command="$CXX $CXXFLAGS $CPPFLAGS -c conftest.cpp" + if AC_TRY_EVAL([gl_command]); then + gl_cv_header_cxx_stdckdint_h=yes + else + gl_cv_header_cxx_stdckdint_h=no + fi + rm -fr conftest* + ]) + if test $gl_cv_header_cxx_stdckdint_h = yes; then + HAVE_CXX_STDCKDINT_H=1 + AC_CACHE_CHECK([checking for an ISO C++26 compliant stdckdint.h in C++], + [gl_cv_header_cxx_stdckdint_h_works], + [dnl We can't use AC_LANG_PUSH([C++]) and AC_LANG_POP([C++]) here, due to + dnl an autoconf bug <https://savannah.gnu.org/support/?110294>. + cat > conftest.cpp <<\EOF +#include <stdckdint.h> +int +main (void) +{ + int r; + int a = 1; + int b = 1; + return !!(ckd_add (&r, a, b) || ckd_sub (&r, a, b) || ckd_mul (&r, a, b)); +} +EOF + gl_command="$CXX $CXXFLAGS $CPPFLAGS -c conftest.cpp" + if AC_TRY_EVAL([gl_command]); then + gl_cv_header_cxx_stdckdint_h_works=yes + else + gl_cv_header_cxx_stdckdint_h_works=no + fi + rm -fr conftest* + ]) + if test $gl_cv_header_cxx_stdckdint_h_works = yes; then + HAVE_WORKING_CXX_STDCKDINT_H=1 + else + HAVE_WORKING_CXX_STDCKDINT_H=0 + fi + else + HAVE_CXX_STDCKDINT_H=0 + HAVE_WORKING_CXX_STDCKDINT_H=0 + fi + fi + else + HAVE_C_STDCKDINT_H=0 + HAVE_WORKING_C_STDCKDINT_H=0 + HAVE_CXX_STDCKDINT_H=0 + HAVE_WORKING_CXX_STDCKDINT_H=0 + fi + AC_SUBST([HAVE_C_STDCKDINT_H]) + AC_SUBST([HAVE_WORKING_C_STDCKDINT_H]) + AC_SUBST([HAVE_CXX_STDCKDINT_H]) + AC_SUBST([HAVE_WORKING_CXX_STDCKDINT_H]) + + if test "$CXX" != no; then + dnl We might need the header for C or C++. + if test $HAVE_C_STDCKDINT_H = 1 \ + && test $HAVE_WORKING_C_STDCKDINT_H = 1 \ + && test $HAVE_CXX_STDCKDINT_H = 1 \ + && test $HAVE_WORKING_CXX_STDCKDINT_H = 1; then + GL_GENERATE_STDCKDINT_H=false + else + GL_GENERATE_STDCKDINT_H=true + fi + else + dnl We don't care about C++ here. + if test $HAVE_C_STDCKDINT_H = 1 \ + && test $HAVE_WORKING_C_STDCKDINT_H = 1; then + GL_GENERATE_STDCKDINT_H=false + else + GL_GENERATE_STDCKDINT_H=true + fi + fi +]) diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4 index 3bc8cd85fea..127ec05b60d 100644 --- a/m4/stddef_h.m4 +++ b/m4/stddef_h.m4 @@ -1,5 +1,5 @@ # stddef_h.m4 -# serial 21 +# serial 23 dnl Copyright (C) 2009-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -64,20 +64,26 @@ AC_DEFUN_ONCE([gl_STDDEF_H], GL_GENERATE_STDDEF_H=true fi - AC_CACHE_CHECK([for unreachable], - [gl_cv_func_unreachable], + AC_CACHE_CHECK([for unreachable in C], + [gl_cv_c_func_unreachable], [AC_LINK_IFELSE( [AC_LANG_PROGRAM( [[#include <stddef.h> ]], [[unreachable (); ]])], - [gl_cv_func_unreachable=yes], - [gl_cv_func_unreachable=no]) + [gl_cv_c_func_unreachable=yes], + [gl_cv_c_func_unreachable=no]) ]) - if test $gl_cv_func_unreachable = no; then + if test $gl_cv_c_func_unreachable = no; then GL_GENERATE_STDDEF_H=true + HAVE_C_UNREACHABLE=0 + else + HAVE_C_UNREACHABLE=1 fi + AC_SUBST([HAVE_C_UNREACHABLE]) + dnl Provide gl_unreachable() unconditionally. + GL_GENERATE_STDDEF_H=true dnl https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114869 AC_CACHE_CHECK([whether nullptr_t needs <stddef.h>], diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 7af9a9ae7db..234943aa57e 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -294,6 +294,7 @@ s/@PACKAGE@/emacs/ /^NEXT_AS_FIRST_DIRECTIVE_GETOPT_H *=/s/@[^@\n]*@/<getopt.h>/ /^NEXT_AS_FIRST_DIRECTIVE_LIMITS_H *=/s/@[^@\n]*@/<limits.h>/ /^NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H *=/s/@[^@\n]*@/<signal.h>/ +/^NEXT_AS_FIRST_DIRECTIVE_STDCKDINT_H *=/s/@[^@\n]*@/<stdckdint.h>/ /^NEXT_AS_FIRST_DIRECTIVE_STDDEF_H *=/s/@[^@\n]*@/<stddef.h>/ /^NEXT_AS_FIRST_DIRECTIVE_STDINT_H *=/s/@[^@\n]*@/<stdint.h>/ /^NEXT_AS_FIRST_DIRECTIVE_STDIO_H *=/s/@[^@\n]*@/<stdio.h>/ @@ -315,6 +316,7 @@ s/@PACKAGE@/emacs/ /^NEXT_LIMITS_H *=/s/@[^@\n]*@/<limits.h>/ /^NEXT_MATH_H *=/s/@[^@\n]*@// /^NEXT_SIGNAL_H *=/s/@[^@\n]*@/<signal.h>/ +/^NEXT_STDCKDINT_H *=/s/@[^@\n]*@/<stdckdint.h>/ /^NEXT_STDDEF_H *=/s/@[^@\n]*@/<stddef.h>/ /^NEXT_STDIO_H *=/s/@[^@\n]*@/<stdio.h>/ /^NEXT_STDINT_H *=/s/@[^@\n]*@/<stdint.h>/ diff --git a/src/comp.c b/src/comp.c index 0a4d4c255c7..d482b2c0bfe 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4254,7 +4254,7 @@ compile_function (Lisp_Object func) comp.handler_ptr_type, "c"); - comp.func_blocks_h = CALLN (Fmake_hash_table); + comp.func_blocks_h = Fmake_hash_table (0, NULL); /* Pre-declare all basic blocks to gcc. The "entry" block must be declared as first. */ @@ -4535,7 +4535,7 @@ Return t on success. */) if (NILP (comp.emitter_dispatcher)) { /* Move this into syms_of_comp the day will be dumpable. */ - comp.emitter_dispatcher = CALLN (Fmake_hash_table); + comp.emitter_dispatcher = Fmake_hash_table (0, NULL); register_emitter (Qset_internal, emit_set_internal); register_emitter (Qhelper_unbind_n, emit_simple_limple_call_lisp_ret); register_emitter (Qhelper_unwind_protect, @@ -4656,7 +4656,7 @@ Return t on success. */) Always reinitialize this cause old function definitions are garbage collected by libgccjit when the ctxt is released. */ - comp.imported_funcs_h = CALLN (Fmake_hash_table); + comp.imported_funcs_h = Fmake_hash_table (0, NULL); define_memcpy (); @@ -5862,7 +5862,7 @@ and advice. */); doc: /* Hash table subr-name -> installed trampoline. This is used to prevent double trampoline instantiation, and also to protect the trampolines against GC. */); - Vcomp_installed_trampolines_h = CALLN (Fmake_hash_table); + Vcomp_installed_trampolines_h = Fmake_hash_table (0, NULL); DEFVAR_LISP ("comp-no-native-file-h", V_comp_no_native_file_h, doc: /* Files for which no deferred compilation should be performed. diff --git a/src/editfns.c b/src/editfns.c index b0609d6e538..f1d5abcdb59 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4590,6 +4590,9 @@ ring. */) BUF_TS_LINECOL_POINT (current_buffer)); #endif + /* Run the before-change-functions *before* we move the gap. */ + modify_text (start1, end2); + /* Make sure the gap won't interfere, by moving it out of the text we will operate on. */ if (start1 < gap && gap < end2) @@ -4634,7 +4637,6 @@ ring. */) enough to use as the temporary storage? That would avoid an allocation... interesting. Later, don't fool with it now. */ - modify_text (start1, end2); tmp_interval1 = copy_intervals (cur_intv, start1, len1); tmp_interval2 = copy_intervals (cur_intv, start2, len2); USE_SAFE_ALLOCA; diff --git a/src/eval.c b/src/eval.c index fadc714f475..060713d489e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -175,7 +175,7 @@ backtrace_top (void) /* This is so "xbacktrace" doesn't crash in pdumped Emacs if they invoke the command before init_eval_once_for_pdumper initializes specpdl machinery. See also backtrace_p above. */ - if (!specpdl) + if (!current_thread || !specpdl) return NULL; union specbinding *pdl = specpdl_ptr - 1; diff --git a/src/fileio.c b/src/fileio.c index 12a4f1bec14..b088d173958 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -4550,14 +4550,19 @@ by calling `format-decode', which see. */) beg_offset += same_at_start - BEGV_BYTE; end_offset -= ZV_BYTE - same_at_end; - /* This binding is to avoid ask-user-about-supersession-threat - being called in insert_from_buffer or del_range_bytes (via - prepare_to_modify_buffer). - AFAICT we could avoid ask-user-about-supersession-threat by setting - current_buffer->modtime earlier, but we could still end up calling - ask-user-about-supersession-threat if the file is modified while - we read it, so we bind buffer-file-name instead. */ - specbind (Qbuffer_file_name, Qnil); + if (!NILP (visit) && BEG == BEGV && Z == ZV) + /* This binding is to avoid ask-user-about-supersession-threat + being called in insert_from_buffer or del_range_bytes (via + prepare_to_modify_buffer). + Such a prompt makes no sense if we're VISITing the file, + since the insertion makes the buffer *more* like the file + rather than the reverse. + AFAICT we could avoid ask-user-about-supersession-threat by + setting current_buffer->modtime earlier, but we could still + end up calling ask-user-about-supersession-threat if the file + is modified while we read it, so we bind buffer-file-name + instead. */ + specbind (Qbuffer_file_name, Qnil); del_range_byte (same_at_start, same_at_end); /* Insert from the file at the proper position. */ temp = BYTE_TO_CHAR (same_at_start); @@ -4666,8 +4671,9 @@ by calling `format-decode', which see. */) /* Truncate the buffer to the size of the file. */ if (same_at_start != same_at_end) { - /* See previous specbind for the reason behind this. */ - specbind (Qbuffer_file_name, Qnil); + if (!NILP (visit) && BEG == BEGV && Z == ZV) + /* See previous specbind for the reason behind this. */ + specbind (Qbuffer_file_name, Qnil); del_range_byte (same_at_start, same_at_end); } inserted = 0; @@ -4716,8 +4722,9 @@ by calling `format-decode', which see. */) we are taking from the decoded string. */ inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE); - /* See previous specbind for the reason behind this. */ - specbind (Qbuffer_file_name, Qnil); + if (!NILP (visit) && BEG == BEGV && Z == ZV) + /* See previous specbind for the reason behind this. */ + specbind (Qbuffer_file_name, Qnil); if (same_at_end != same_at_start) { del_range_byte (same_at_start, same_at_end); diff --git a/src/frame.c b/src/frame.c index 03710a5f7af..3ff082ea7d1 100644 --- a/src/frame.c +++ b/src/frame.c @@ -365,8 +365,8 @@ frame_redisplay_p (struct frame *f) { if (is_tty_frame (f)) { - struct frame *p = FRAME_PARENT_FRAME (f); - struct frame *q = NULL; + struct frame *p = f; + struct frame *q = f; while (p) { @@ -388,7 +388,7 @@ frame_redisplay_p (struct frame *f) frame of its terminal. Any other tty frame can be redisplayed iff it is the top frame of its terminal itself which must be always visible. */ - return (q ? q == r : f == r); + return q == r; } else #ifndef HAVE_X_WINDOWS @@ -1450,6 +1450,15 @@ make_terminal_frame (struct terminal *terminal, Lisp_Object parent, FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR; #endif /* not MSDOS */ + struct tty_display_info *tty = terminal->display_info.tty; + + if (NILP (tty->top_frame)) + /* If this frame's terminal's top frame has not been set up yet, + make the new frame its top frame so the top frame has been set up + before the first do_switch_frame on this terminal happens. See + Bug#78966. */ + tty->top_frame = frame; + #ifdef HAVE_WINDOW_SYSTEM f->vertical_scroll_bar_type = vertical_scroll_bar_none; f->horizontal_scroll_bars = false; diff --git a/src/keyboard.c b/src/keyboard.c index 7490bfffc59..da966c1a5bd 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4298,22 +4298,29 @@ kbd_buffer_get_event (KBOARD **kbp, break; default: { - /* If this event is on a different frame, return a - switch-frame this time, and leave the event in the queue - for next time. */ Lisp_Object frame; Lisp_Object focus; + /* It's not safe to assume that the following will always + produce a valid, live frame (Bug#78966). */ frame = event->ie.frame_or_window; if (CONSP (frame)) frame = XCAR (frame); else if (WINDOWP (frame)) frame = WINDOW_FRAME (XWINDOW (frame)); - focus = FRAME_FOCUS_FRAME (XFRAME (frame)); - if (! NILP (focus)) - frame = focus; + /* If the input focus of this frame is on another frame, + continue with that frame. */ + if (FRAMEP (frame)) + { + focus = FRAME_FOCUS_FRAME (XFRAME (frame)); + if (! NILP (focus)) + frame = focus; + } + /* If this event is on a different frame, return a + switch-frame this time, and leave the event in the queue + for next time. */ if (!EQ (frame, internal_last_event_frame) && !EQ (frame, selected_frame)) obj = make_lispy_switch_frame (frame); @@ -8266,13 +8273,21 @@ tty_read_avail_input (struct terminal *terminal, value of selected_frame is not reliable here, redisplay tends to temporarily change it. However, if the selected frame is a child frame, don't do that since it will cause switch frame - events to switch to the root frame instead. */ - if (FRAME_PARENT_FRAME (XFRAME (selected_frame)) - && (root_frame (XFRAME (selected_frame)) - == XFRAME (tty->top_frame))) + events to switch to the root frame instead. If the tty's top + frame has not been set up yet, always use the selected frame + (Bug#78966). */ + if (!FRAMEP (tty->top_frame) + || (FRAME_PARENT_FRAME (XFRAME (selected_frame)) + && (root_frame (XFRAME (selected_frame)) + == XFRAME (tty->top_frame)))) buf.frame_or_window = selected_frame; else buf.frame_or_window = tty->top_frame; + + /* If neither the selected frame nor the top frame were set, + something must have gone really wrong. */ + eassert (FRAMEP (buf.frame_or_window)); + buf.arg = Qnil; kbd_buffer_store_event (&buf); @@ -12444,7 +12459,15 @@ handle_interrupt (bool in_signal_handler) thread, see deliver_process_signal. So we must make sure the main thread holds the global lock. */ if (in_signal_handler) - maybe_reacquire_global_lock (); + { + /* But if the signal handler was called when a non-main thread was + in GC, just return, since switching threads by force-taking the + global lock will confuse the heck out of GC, and will most + likely segfault. */ + if (!main_thread_p (current_thread) && gc_in_progress) + return; + maybe_reacquire_global_lock (); + } #endif if (waiting_for_input && !echoing) quit_throw_to_read_char (in_signal_handler); diff --git a/src/lread.c b/src/lread.c index d5877fe6edc..0d8d1fffece 100644 --- a/src/lread.c +++ b/src/lread.c @@ -383,6 +383,8 @@ readchar (Lisp_Object readcharfun, bool *multibyte) else { c = SREF (readcharfun, read_from_string_index_byte); + if (!ASCII_CHAR_P (c)) + c = BYTE8_TO_CHAR (c); read_from_string_index++; read_from_string_index_byte++; } @@ -397,6 +399,9 @@ readchar (Lisp_Object readcharfun, bool *multibyte) goto read_multibyte; } + if (multibyte) + *multibyte = 1; + tem = call0 (readcharfun); if (!FIXNUMP (tem)) @@ -3636,9 +3641,9 @@ read_bool_vector (Lisp_Object readcharfun) Lisp_Object str = read_string_literal (readcharfun); if (STRING_MULTIBYTE (str) || !(size_in_chars == SCHARS (str) - /* We used to print 1 char too many when the number of bits + /* Emacs 19 printed 1 char too many when the number of bits was a multiple of 8. Accept such input in case it came - from an old version. */ + from that old version. */ || length == (SCHARS (str) - 1) * BOOL_VECTOR_BITS_PER_CHAR)) invalid_syntax ("#&...", readcharfun); @@ -3905,28 +3910,53 @@ read_stack_reset (intmax_t sp) rdstack.sp = sp; } -#define READ_AND_BUFFER(c) \ - c = READCHAR; \ - if (c < 0) \ - INVALID_SYNTAX_WITH_BUFFER (); \ - if (multibyte) \ - p += CHAR_STRING (c, (unsigned char *) p); \ - else \ - *p++ = c; \ - if (end - p < MAX_MULTIBYTE_LENGTH + 1) \ - { \ - offset = p - read_buffer; \ - read_buffer = grow_read_buffer (read_buffer, offset, \ - &heapbuf, &read_buffer_size, count); \ - p = read_buffer + offset; \ - end = read_buffer + read_buffer_size; \ - } +typedef struct { + char *start; /* start of buffer, dynamic if equal to heapbuf */ + char *end; /* just past end of buffer */ + char *cur; /* where to put next char read */ + char *heapbuf; /* start of heap allocation if any, or NULL */ + specpdl_ref count; /* specpdl at start */ +} readbuf_t; -#define INVALID_SYNTAX_WITH_BUFFER() \ - { \ - *p = 0; \ - invalid_syntax (read_buffer, readcharfun); \ - } +static NO_INLINE void +readbuf_grow (readbuf_t *rb) +{ + ptrdiff_t offset = rb->cur - rb->start; + ptrdiff_t size = rb->end - rb->start; + rb->start = grow_read_buffer (rb->start, offset, &rb->heapbuf, &size, + rb->count); + rb->cur = rb->start + offset; + rb->end = rb->start + size; +} + +static inline void +add_char_to_buffer (readbuf_t *rb, int c, bool multibyte) +{ + if (multibyte) + rb->cur += CHAR_STRING (c, (unsigned char *) rb->cur); + else + *rb->cur++ = c; + if (rb->end - rb->cur < MAX_MULTIBYTE_LENGTH + 1) + readbuf_grow (rb); +} + +static AVOID +invalid_syntax_with_buffer (readbuf_t *rb, Lisp_Object readcharfun) +{ + *rb->cur = '\0'; + invalid_syntax (rb->start, readcharfun); +} + +static inline int +read_and_buffer (readbuf_t *rb, Lisp_Object readcharfun) +{ + bool multibyte; + int c = READCHAR_REPORT_MULTIBYTE (&multibyte); + if (c < 0) + invalid_syntax_with_buffer (rb, readcharfun); + add_char_to_buffer (rb, c, multibyte); + return c; +} /* Read a Lisp object. If LOCATE_SYMS is true, symbols are read with position. */ @@ -3934,16 +3964,15 @@ static Lisp_Object read0 (Lisp_Object readcharfun, bool locate_syms) { char stackbuf[64]; - char *read_buffer = stackbuf; - ptrdiff_t read_buffer_size = sizeof stackbuf; - ptrdiff_t offset; - char *heapbuf = NULL; specpdl_ref base_pdl = SPECPDL_INDEX (); ptrdiff_t base_sp = rdstack.sp; record_unwind_protect_intmax (read_stack_reset, base_sp); - specpdl_ref count = SPECPDL_INDEX (); + readbuf_t rb = { .start = stackbuf, + .end = stackbuf + sizeof stackbuf, + .heapbuf = NULL, + .count = SPECPDL_INDEX () }; bool uninterned_symbol; bool skip_shorthand; @@ -4038,13 +4067,9 @@ read0 (Lisp_Object readcharfun, bool locate_syms) case '#': { - char *p = read_buffer; - char *end = read_buffer + read_buffer_size; - - *p++ = '#'; - int ch; - READ_AND_BUFFER (ch); - + rb.cur = rb.start; + *rb.cur++ = '#'; + int ch = read_and_buffer (&rb, readcharfun); switch (ch) { case '\'': @@ -4062,11 +4087,11 @@ read0 (Lisp_Object readcharfun, bool locate_syms) case 's': /* #s(...) -- a record or hash-table */ - READ_AND_BUFFER (ch); + ch = read_and_buffer (&rb, readcharfun); if (ch != '(') { UNREAD (ch); - INVALID_SYNTAX_WITH_BUFFER (); + invalid_syntax_with_buffer (&rb, readcharfun); } read_stack_push ((struct read_stack_entry) { .type = RE_record, @@ -4079,10 +4104,10 @@ read0 (Lisp_Object readcharfun, bool locate_syms) case '^': /* #^[...] -- char-table #^^[...] -- sub-char-table */ - READ_AND_BUFFER (ch); + ch = read_and_buffer (&rb, readcharfun); if (ch == '^') { - ch = READCHAR; + ch = read_and_buffer (&rb, readcharfun); if (ch == '[') { read_stack_push ((struct read_stack_entry) { @@ -4096,7 +4121,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) else { UNREAD (ch); - INVALID_SYNTAX_WITH_BUFFER (); + invalid_syntax_with_buffer (&rb, readcharfun); } } else if (ch == '[') @@ -4112,7 +4137,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) else { UNREAD (ch); - INVALID_SYNTAX_WITH_BUFFER (); + invalid_syntax_with_buffer (&rb, readcharfun); } case '(': @@ -4222,12 +4247,12 @@ read0 (Lisp_Object readcharfun, bool locate_syms) int c; for (;;) { - READ_AND_BUFFER (c); + c = read_and_buffer (&rb, readcharfun); if (c < '0' || c > '9') break; if (ckd_mul (&n, n, 10) || ckd_add (&n, n, c - '0')) - INVALID_SYNTAX_WITH_BUFFER (); + invalid_syntax_with_buffer (&rb, readcharfun); } if (c == 'r' || c == 'R') { @@ -4268,18 +4293,18 @@ read0 (Lisp_Object readcharfun, bool locate_syms) = XHASH_TABLE (read_objects_map); ptrdiff_t i = hash_find (h, make_fixnum (n)); if (i < 0) - INVALID_SYNTAX_WITH_BUFFER (); + invalid_syntax_with_buffer (&rb, readcharfun); obj = HASH_VALUE (h, i); break; } else - INVALID_SYNTAX_WITH_BUFFER (); + invalid_syntax_with_buffer (&rb, readcharfun); } else - INVALID_SYNTAX_WITH_BUFFER (); + invalid_syntax_with_buffer (&rb, readcharfun); } else - INVALID_SYNTAX_WITH_BUFFER (); + invalid_syntax_with_buffer (&rb, readcharfun); } break; } @@ -4364,23 +4389,13 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* symbol or number */ read_symbol: { - char *p = read_buffer; - char *end = read_buffer + read_buffer_size; + rb.cur = rb.start; bool quoted = false; EMACS_INT start_position = readchar_offset - 1; + ptrdiff_t nchars = 0; do { - if (end - p < MAX_MULTIBYTE_LENGTH + 1) - { - ptrdiff_t offset = p - read_buffer; - read_buffer = grow_read_buffer (read_buffer, offset, - &heapbuf, &read_buffer_size, - count); - p = read_buffer + offset; - end = read_buffer + read_buffer_size; - } - if (c == '\\') { c = READCHAR; @@ -4389,10 +4404,8 @@ read0 (Lisp_Object readcharfun, bool locate_syms) quoted = true; } - if (multibyte) - p += CHAR_STRING (c, (unsigned char *) p); - else - *p++ = c; + add_char_to_buffer (&rb, c, multibyte); + nchars++; c = READCHAR; } while (c > 32 @@ -4402,17 +4415,17 @@ read0 (Lisp_Object readcharfun, bool locate_syms) || c == '(' || c == ')' || c == '[' || c == ']' || c == '`' || c == ','))); - *p = 0; - ptrdiff_t nbytes = p - read_buffer; + *rb.cur = '\0'; + ptrdiff_t nbytes = rb.cur - rb.start; UNREAD (c); /* Only attempt to parse the token as a number if it starts as one. */ - char c0 = read_buffer[0]; + char c0 = rb.start[0]; if (((c0 >= '0' && c0 <= '9') || c0 == '.' || c0 == '-' || c0 == '+') && !quoted && !uninterned_symbol && !skip_shorthand) { ptrdiff_t len; - Lisp_Object result = string_to_number (read_buffer, 10, &len); + Lisp_Object result = string_to_number (rb.start, 10, &len); if (!NILP (result) && len == nbytes) { obj = result; @@ -4421,15 +4434,11 @@ read0 (Lisp_Object readcharfun, bool locate_syms) } /* symbol, possibly uninterned */ - ptrdiff_t nchars - = (multibyte - ? multibyte_chars_in_text ((unsigned char *)read_buffer, nbytes) - : nbytes); Lisp_Object result; if (uninterned_symbol) { Lisp_Object name - = make_specified_string (read_buffer, nchars, nbytes, multibyte); + = make_specified_string (rb.start, nchars, nbytes, multibyte); result = Fmake_symbol (name); } else @@ -4450,10 +4459,10 @@ read0 (Lisp_Object readcharfun, bool locate_syms) symbols that are comprised entirely of characters that have the 'symbol constituent' syntax from transforming according to shorthands. */ - || symbol_char_span (read_buffer) >= nbytes) - found = oblookup (obarray, read_buffer, nchars, nbytes); + || symbol_char_span (rb.start) >= nbytes) + found = oblookup (obarray, rb.start, nchars, nbytes); else - found = oblookup_considering_shorthand (obarray, read_buffer, + found = oblookup_considering_shorthand (obarray, rb.start, nchars, nbytes, &longhand, &longhand_chars, &longhand_bytes); @@ -4471,7 +4480,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) } else { - Lisp_Object name = make_specified_string (read_buffer, nchars, + Lisp_Object name = make_specified_string (rb.start, nchars, nbytes, multibyte); result = intern_driver (name, obarray, found); } diff --git a/src/print.c b/src/print.c index 99c29bb5329..86f40d2beb4 100644 --- a/src/print.c +++ b/src/print.c @@ -1025,6 +1025,14 @@ debug_format (const char *fmt, Lisp_Object arg) } +/* Erase the Vprin1_to_string_buffer, potentially switching to it. */ +static void +erase_prin1_to_string_buffer (void) +{ + set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); + Ferase_buffer (); +} + DEFUN ("error-message-string", Ferror_message_string, Serror_message_string, 1, 1, 0, doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message. @@ -1032,9 +1040,6 @@ See Info anchor `(elisp)Definition of signal' for some details on how this error message is constructed. */) (Lisp_Object obj) { - struct buffer *old = current_buffer; - Lisp_Object value; - /* If OBJ is (error STRING), just return STRING. That is not only faster, it also avoids the need to allocate space here when the error is due to memory full. */ @@ -1044,15 +1049,15 @@ error message is constructed. */) && NILP (XCDR (XCDR (obj)))) return XCAR (XCDR (obj)); + /* print_error_message can throw after producing some output, in which + case we need to ensure the buffer is cleared again (bug#78842). */ + specpdl_ref count = SPECPDL_INDEX (); + record_unwind_current_buffer (); + record_unwind_protect_void (erase_prin1_to_string_buffer); print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil); set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); - value = Fbuffer_string (); - - Ferase_buffer (); - set_buffer_internal (old); - - return value; + return unbind_to (count, Fbuffer_string ()); } /* Print an error message for the error DATA onto Lisp output stream @@ -1115,6 +1120,19 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, tail = Fcdr_safe (data); + /* For a user-error displayed in the echo area, use message3 rather + than Fprinc in order to preserve fontification. + In particular, there might be hints to the user about key sequences + they could type to do what they seemed to want. */ + if (EQ (errname, Quser_error) && EQ (stream, Qt) + /* These should always be true for a user-error, but check, lest + we throw any information away. */ + && !NILP (XCAR (tail)) && NILP (XCDR (tail))) + { + message3 (XCAR (tail)); + return; + } + /* For file-error, make error message by concatenating all the data items. They are all strings. */ if (!NILP (file_error) && CONSP (tail)) @@ -2635,7 +2653,7 @@ print_object (Lisp_Object obj, bool escapeflag, struct print_context *pc) { /* Here, we must convert each multi-byte form to the corresponding character code before handing it to PRINTCHAR. */ - int c = fetch_string_char_advance (name, &i, &i_byte); + int c = fetch_string_char_as_multibyte_advance (name, &i, &i_byte); maybe_quit (); if (escapeflag) diff --git a/src/treesit.c b/src/treesit.c index 7b8e5d161f7..bb720589c85 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -485,6 +485,7 @@ static Lisp_Object Vtreesit_str_space; static Lisp_Object Vtreesit_str_equal; static Lisp_Object Vtreesit_str_match; static Lisp_Object Vtreesit_str_pred; +static Lisp_Object Vtreesit_str_empty; /* This is the limit on recursion levels for some tree-sitter functions. Remember to update docstrings when changing this value. @@ -1802,9 +1803,9 @@ treesit_check_buffer_size (struct buffer *buffer) static Lisp_Object treesit_make_ranges (const TSRange *, uint32_t, Lisp_Object, struct buffer *); -static void -treesit_call_after_change_functions (TSTree *old_tree, TSTree *new_tree, - Lisp_Object parser) +static Lisp_Object +treesit_get_affected_ranges (TSTree *old_tree, TSTree *new_tree, + Lisp_Object parser) { /* If the old_tree is NULL, meaning this is the first parse, the changed range is the whole buffer. */ @@ -1824,24 +1825,31 @@ treesit_call_after_change_functions (TSTree *old_tree, TSTree *new_tree, lisp_ranges = Fcons (Fcons (Fpoint_min (), Fpoint_max ()), Qnil); set_buffer_internal (oldbuf); } + return lisp_ranges; +} +static void +treesit_call_after_change_functions (Lisp_Object parser, Lisp_Object ranges) +{ specpdl_ref count = SPECPDL_INDEX (); /* let's trust the after change functions and not clone a new ranges for each of them. */ Lisp_Object functions = XTS_PARSER (parser)->after_change_functions; FOR_EACH_TAIL (functions) - safe_calln (XCAR (functions), lisp_ranges, parser); + safe_calln (XCAR (functions), ranges, parser); unbind_to (count, Qnil); } -/* Parse the buffer. We don't parse until we have to. When we have - to, we call this function to parse and update the tree. */ -static void +/* Parse the buffer. We don't parse until we have to. When we have to, + we call this function to parse and update the tree. Return the + affected ranges (a list of (BEG . END)). If reparse didn't happen + or the affected ranges is empty, return nil. */ +static Lisp_Object treesit_ensure_parsed (Lisp_Object parser) { - if (XTS_PARSER (parser)->within_reparse) return; + if (XTS_PARSER (parser)->within_reparse) return Qnil; XTS_PARSER (parser)->within_reparse = true; struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer); @@ -1855,7 +1863,7 @@ treesit_ensure_parsed (Lisp_Object parser) if (!XTS_PARSER (parser)->need_reparse) { XTS_PARSER (parser)->within_reparse = false; - return; + return Qnil; } TSParser *treesit_parser = XTS_PARSER (parser)->parser; @@ -1881,10 +1889,12 @@ treesit_ensure_parsed (Lisp_Object parser) XTS_PARSER (parser)->need_reparse = false; XTS_PARSER (parser)->timestamp++; - treesit_call_after_change_functions (tree, new_tree, parser); + Lisp_Object ranges = treesit_get_affected_ranges (tree, new_tree, parser); + treesit_call_after_change_functions (parser, ranges); ts_tree_delete (tree); XTS_PARSER (parser)->within_reparse = false; + return ranges; } /* This is the read function provided to tree-sitter to read from a @@ -2788,6 +2798,22 @@ optimized; for heavy workload, use a temporary buffer instead. */) return Ftreesit_parser_root_node (parser); } +/* Use "regions" rather than "ranges" to distinguish from parser + ranges. */ +DEFUN ("treesit-parser-changed-regions", + Ftreesit_parser_changed_regions, + Streesit_parser_changed_regions, + 1, 1, 0, + doc: /* Force PARSER to re-parse and return the affected regions. + +Return ranges as a list of (BEG . END). If there's no need to re-parse +or no affected ranges, return nil. */) + (Lisp_Object parser) +{ + treesit_check_parser (parser); + treesit_initialize (); + return treesit_ensure_parsed (parser); +} /*** Node API */ @@ -2853,8 +2879,11 @@ If NODE is nil, return nil. */) treesit_initialize (); TSNode treesit_node = XTS_NODE (node)->node; + /* ts_node_type could return NULL, see source code (tree-sitter can't + find the string name of a node type by its id in its node name + obarray). */ const char *type = ts_node_type (treesit_node); - return build_string (type); + return type == NULL ? Vtreesit_str_empty : build_string (type); } DEFUN ("treesit-node-start", @@ -4444,6 +4473,10 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred, if (STRINGP (pred)) { const char *type = ts_node_type (node); + /* ts_node_type returning NULL means something unexpected happend + in tree-sitter, in this case the only reasonable thing is to + not match anything. */ + if (type == NULL) return false; return fast_c_string_match (pred, type, strlen (type)) >= 0; } else if (FUNCTIONP (pred) @@ -4496,6 +4529,10 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred, { /* A bit of code duplication here, but should be fine. */ const char *type = ts_node_type (node); + /* ts_node_type returning NULL means something unexpected + happend in tree-sitter, in this case the only reasonable + thing is to not match anything */ + if (type == NULL) return false; if (!(fast_c_string_match (car, type, strlen (type)) >= 0)) return false; @@ -5300,6 +5337,8 @@ buffer. */); Vtreesit_str_match = build_string ("match"); staticpro (&Vtreesit_str_pred); Vtreesit_str_pred = build_string ("pred"); + staticpro (&Vtreesit_str_empty); + Vtreesit_str_empty = build_string (""); defsubr (&Streesit_language_available_p); defsubr (&Streesit_library_abi_version); @@ -5325,6 +5364,7 @@ buffer. */); defsubr (&Streesit_parser_tag); defsubr (&Streesit_parser_embed_level); defsubr (&Streesit_parser_set_embed_level); + defsubr (&Streesit_parser_changed_regions); defsubr (&Streesit_parser_root_node); defsubr (&Streesit_parse_string); diff --git a/src/xfaces.c b/src/xfaces.c index 396d2d9b16c..192315e1439 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7386,6 +7386,7 @@ init_xfaces (void) #endif face_attr_sym[0] = Qface; + face_attr_sym[LFACE_FAMILY_INDEX] = QCfamily; face_attr_sym[LFACE_FOUNDRY_INDEX] = QCfoundry; face_attr_sym[LFACE_SWIDTH_INDEX] = QCwidth; face_attr_sym[LFACE_HEIGHT_INDEX] = QCheight; diff --git a/src/xterm.c b/src/xterm.c index 558931363e3..d401fe698ec 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -21492,45 +21492,49 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #if defined HAVE_GTK3 && defined USE_TOOLKIT_SCROLL_BARS - struct scroll_bar *bar = x_window_to_scroll_bar (dpyinfo->display, - configureEvent.xconfigure.window, 2); + struct scroll_bar *bar = x_window_to_scroll_bar (dpyinfo->display, + configureEvent.xconfigure.window, 2); - /* There is really no other way to make GTK scroll bars fit - in the dimensions we want them to. */ - if (bar) + /* There is really no other way to make GTK scroll bars fit + in the dimensions we want them to. */ + if (bar) + { + /* Skip all the pending configure events, not just the + ones where window motion occurred. */ + while (XPending (dpyinfo->display)) { - /* Skip all the pending configure events, not just the - ones where window motion occurred. */ - while (XPending (dpyinfo->display)) + XNextEvent (dpyinfo->display, &next_event); + if (next_event.type != ConfigureNotify + || next_event.xconfigure.window != event->xconfigure.window) { - XNextEvent (dpyinfo->display, &next_event); - if (next_event.type != ConfigureNotify - || next_event.xconfigure.window != event->xconfigure.window) - { - XPutBackEvent (dpyinfo->display, &next_event); - break; - } - else - configureEvent = next_event; + XPutBackEvent (dpyinfo->display, &next_event); + break; } + else + configureEvent = next_event; + } - if (configureEvent.xconfigure.width != max (bar->width, 1) - || configureEvent.xconfigure.height != max (bar->height, 1)) - { - XResizeWindow (dpyinfo->display, bar->x_window, - max (bar->width, 1), max (bar->height, 1)); - x_flush (WINDOW_XFRAME (XWINDOW (bar->window))); - } + if (configureEvent.xconfigure.width != max (bar->width, 1) + || configureEvent.xconfigure.height != max (bar->height, 1)) + { + XResizeWindow (dpyinfo->display, bar->x_window, + max (bar->width, 1), max (bar->height, 1)); + x_flush (WINDOW_XFRAME (XWINDOW (bar->window))); + } #ifdef HAVE_XDBE - if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) - x_drop_xrender_surfaces (f); + if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) + x_drop_xrender_surfaces (f); #endif - goto OTHER; - } + goto OTHER; + } #endif + /* XXX: it is strictly only necessary to provide the edit window + to many of the statements below which only modify or invalidate + resources assigned there. Most conditionals that alternate + between `f' and `any' could ideally be removed. */ f = x_top_window_to_frame (dpyinfo, configureEvent.xconfigure.window); /* This means we can no longer be certain of the root window @@ -21544,8 +21548,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, for size changes: that's not sufficient. We miss some surface invalidations and flicker. */ #ifdef HAVE_XDBE - if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) - x_drop_xrender_surfaces (f); + { +#if defined USE_GTK || defined USE_X_TOOLKIT + /* Only modifications to the edit window (on which pictures are + created) must be accompanied by invalidations. (bug#77988) */ + struct frame *f + = x_window_to_frame (dpyinfo, configureEvent.xconfigure.window); +#endif /* USE_GTK || USE_X_TOOLKIT */ + if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) + x_drop_xrender_surfaces (f); + } #endif #if defined USE_CAIRO && !defined USE_GTK if (f) diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index 788635ca82d..6e9693ed013 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -140,15 +140,14 @@ RUN src/emacs -Q --batch \ --eval '(setq treesit-extra-load-path (list "/root/.emacs.d/tree-sitter"))' \ -l admin/tree-sitter/treesit-admin.el \ --eval '(dolist (lang (mapcar (quote car) \ - (treesit-admin--populated-treesit-language-source-alist))) \ + (treesit-admin--populated-treesit-language-source-alist))) \ (treesit-install-language-grammar lang "/root/.emacs.d/tree-sitter"))' \ --eval '(message "\ntreesit-language-source-alist")' \ --eval '(message "=============================")' \ --eval '(message "%s" (pp-to-string treesit-language-source-alist))' \ --eval '(message "ABI versions\n============")' \ - --eval \ - '(dolist (lang (sort (mapcar (quote car) treesit-language-source-alist))) \ - (message "%s ABI version %d" lang (treesit-language-abi-version lang)))' \ + --eval '(dolist (lang (sort (mapcar (quote car) treesit-language-source-alist))) \ + (message "%s ABI version %d" lang (treesit-language-abi-version lang)))' \ --eval '(message "\ntreesit-admin-check-manual-coverage")' \ --eval '(message "===================================")' \ -f treesit-admin-check-manual-coverage \ diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 2534cd894a6..2944e555e64 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -189,7 +189,7 @@ default: .filenotify-gio-template: rules: - if: '$CI_PIPELINE_SOURCE == "web"' - # - if: '$CI_PIPELINE_SOURCE == "schedule"' + - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - "**.in" - lisp/autorevert.el @@ -323,10 +323,10 @@ test-eglot: target: emacs-eglot # This is needed in order to get a JUnit test report. make_params: >- - check-expensive TEST_HOME=/root LOGFILES="lisp/progmodes/eglot-tests.log" - - # EMACS_EXTRAOPT="--eval \(use-package\ company\ :ensure\ t\) - # --eval \(use-package\ yasnippet\ :ensure\ t\)" + check-expensive + TEST_HOME=/root + LOGFILES="lisp/progmodes/eglot-tests.log" + EMACS_EXTRAOPT='--eval \(use-package\ company\ :ensure\ t\) --eval \(use-package\ yasnippet\ :ensure\ t\)' build-image-tree-sitter: stage: platform-images diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index ad7506f68ff..4468559cf38 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -549,6 +549,33 @@ baz\"\"" (electric-pair-mode 1) (electric-indent-mode 1) (electric-layout-mode 1))) + +;;; String pairs +;;; TODO: add more tests +;;; + +;; NOTE: Currently string pairs do not support insert pairs in region +;; or delete them with electric-pair-delete-pair + +(ert-deftest electric-pair-strings-pairs () + (save-electric-modes + (with-temp-buffer + (setq-local electric-pair-pairs `((,(regexp-quote "/*") . "*/"))) + (electric-pair-local-mode) + (insert "/") + (let ((last-command-event ?\*)) + (ert-simulate-command '(self-insert-command 1))) + (should (equal "/**/" (buffer-string)))))) + +(ert-deftest electric-pair-strings-pairs-with-space () + (save-electric-modes + (with-temp-buffer + (setq-local electric-pair-pairs `((,(regexp-quote "/*") " */" t))) + (electric-pair-local-mode) + (insert "/") + (let ((last-command-event ?\*)) + (ert-simulate-command '(self-insert-command 1))) + (should (equal "/* */" (buffer-string)))))) ;;; Backspacing diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index d1f272f7a4d..7382928da15 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1322,6 +1322,24 @@ byte-compiled. Run with dynamic binding." (defun def () (m)))) (should (equal (funcall 'def) 4))) +(ert-deftest test-eager-load-macro-expand-defalias () + (ert-with-temp-file elfile + :suffix ".el" + (write-region + (concat ";;; -*- lexical-binding: t -*-\n" + (mapconcat #'prin1-to-string + '((defalias 'nothing '(macro . ignore)) + (defalias 'something (cons 'macro #'identity)) + (defalias 'five (cons 'macro (lambda (&rest _) 5))) + (eval-when-compile + (defun def () (or (nothing t) (something (five nil)))))) + "\n")) + nil elfile) + (let* ((byte-compile-debug t) + (byte-compile-dest-file-function #'ignore)) + (byte-compile-file elfile) + (should (equal (funcall 'def) 5))))) + (defmacro bytecomp-tests--with-temp-file (file-name-var &rest body) (declare (indent 1)) (cl-check-type file-name-var symbol) diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el index 6280be06cbb..5290ed9d04e 100644 --- a/test/lisp/emacs-lisp/cl-extra-tests.el +++ b/test/lisp/emacs-lisp/cl-extra-tests.el @@ -438,6 +438,15 @@ (my-foo most-positive-fixnum))) ) +(ert-deftest cl-extra-test-random () + (should-error (cl-random -1)) + (should-error (cl-random -0.5)) + (should-error (cl-random -1.0e+INF)) + (should-error (cl-random 0)) + (should-error (cl-random 0.0)) + (should-error (cl-random -0.0)) + (should-error (cl-random 1.0e+INF)) + (should (eql (cl-random 1) 0))) ;;; cl-extra-tests.el ends here diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index fced6bc3df2..b60db80ad56 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -1047,7 +1047,9 @@ Subclasses to override slot attributes.")) (slot-value x 'c))) (setf (slot-value x 'a) 1) (should (eq (eieio-test--struct-a x) 1)) - (should-error (setf (slot-value x 'c) 3) :type 'eieio-read-only))) + (should-error (setf (slot-value x 'c) 3) :type 'eieio-read-only) + (with-no-warnings + (should-error (eieio-oref x 'd)) :type 'invalid-slot-name))) (defclass foo-bug-66938 (eieio-instance-inheritor) ((x :initarg :x diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 8744dc4987a..1a041b0c46c 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -37,7 +37,7 @@ ;; of a respective command. The first command found is used. In ;; order to use a dedicated one, the environment variable ;; $REMOTE_FILE_NOTIFY_LIBRARY shall be set, possible values are -;; "inotifywait", "gio-monitor" and "gvfs-monitor-dir". +;; "inotifywait", "gio-monitor", "gvfs-monitor-dir", and "smb-notify". ;; Local file-notify libraries are auto-detected during Emacs ;; configuration. This can be changed with a respective configuration @@ -58,7 +58,7 @@ ;; Filter suppressed remote file-notify libraries. (when (stringp (getenv "REMOTE_FILE_NOTIFY_LIBRARY")) - (dolist (lib '("inotifywait" "gio-monitor" "gvfs-monitor-dir")) + (dolist (lib '("inotifywait" "gio-monitor" "gvfs-monitor-dir" "smb-notify")) (unless (string-equal (getenv "REMOTE_FILE_NOTIFY_LIBRARY") lib) (add-to-list 'tramp-connection-properties `(nil ,lib nil))))) @@ -104,6 +104,9 @@ There are different timeouts for local and remote file notification libraries." TIMEOUT is the maximum time to wait for, in seconds." `(with-timeout (,timeout (ignore)) (while (null ,until) + (when file-notify-debug + (message "file-notify--test-wait-for-events received: %s" + (file-notify--test-event-actions))) (file-notify--test-wait-event)))) (defun file-notify--test-no-descriptors () @@ -137,11 +140,7 @@ Return nil when any other file notification watch is still active." (should (file-notify--test-no-descriptors))) (defun file-notify--test-cleanup () - "Cleanup after a test." - ;; (when (getenv "EMACS_EMBA_CI") - ;; (dolist (buf (tramp-list-tramp-buffers)) - ;; (message ";; %s\n%s" buf (tramp-get-buffer-string buf)) - ;; (kill-buffer buf))) + "Cleanup before and after a test." (file-notify-rm-all-watches) (ignore-errors @@ -159,7 +158,7 @@ Return nil when any other file notification watch is still active." (ignore-errors (when (file-remote-p temporary-file-directory) (tramp-cleanup-connection - (tramp-dissect-file-name temporary-file-directory) nil 'keep-password))) + (tramp-dissect-file-name temporary-file-directory) t 'keep-password))) (when (hash-table-p file-notify-descriptors) (clrhash file-notify-descriptors)) @@ -176,9 +175,13 @@ Return nil when any other file notification watch is still active." file-notify--test-events nil file-notify--test-monitors nil)) -(setq file-notify-debug nil +(setq auth-source-cache-expiry nil + auth-source-save-behavior nil + file-notify-debug nil password-cache-expiry nil - ;; tramp-verbose (if (getenv "EMACS_EMBA_CI") 10 0) + remote-file-name-inhibit-cache nil + tramp-allow-unsafe-temporary-files t + tramp-cache-read-persistent-data t ;; For auth-sources. tramp-verbose 0 ;; When the remote user id is 0, Tramp refuses unsafe temporary files. tramp-allow-unsafe-temporary-files @@ -241,13 +244,17 @@ watch descriptor." ;; We cache the result, because after `file-notify-rm-watch', ;; `gfile-monitor-name' does not return a proper result anymore. ;; But we still need this information. So far, we know the monitors - ;; GFamFileMonitor (gfilenotify on cygwin), GFamDirectoryMonitor - ;; (gfilenotify on Solaris), GInotifyFileMonitor (gfilenotify and - ;; gio on GNU/Linux), GKqueueFileMonitor (gfilenotify and gio on - ;; FreeBSD) and GPollFileMonitor (gio on cygwin). + ;; - GFamFileMonitor (gfilenotify on cygwin) + ;; - GFamDirectoryMonitor (gfilenotify on Solaris) + ;; - GInotifyFileMonitor (gfilenotify and gio on GNU/Linux) + ;; - GKqueueFileMonitor (gfilenotify and gio on FreeBSD) + ;; - GPollFileMonitor (gio on cygwin) + ;; - SMBSamba (smb-notify on Samba server) + ;; - SMBWindows (smb-notify on MS Windows). (when file-notify--test-desc (or (alist-get file-notify--test-desc file-notify--test-monitors) - (when (member (file-notify--test-library) '("gfilenotify" "gio")) + (when (member + (file-notify--test-library) '("gfilenotify" "gio" "smb-notify")) (add-to-list 'file-notify--test-monitors (cons file-notify--test-desc @@ -255,10 +262,10 @@ watch descriptor." ;; `file-notify--test-desc' is the connection process. (progn (while (not (tramp-connection-property-p - file-notify--test-desc "gio-file-monitor")) + file-notify--test-desc "file-monitor")) (accept-process-output file-notify--test-desc 0)) (tramp-get-connection-property - file-notify--test-desc "gio-file-monitor" nil)) + file-notify--test-desc "file-monitor" nil)) (and (functionp 'gfile-monitor-name) (gfile-monitor-name file-notify--test-desc))))) ;; If we don't know the monitor, there are good chances the @@ -282,7 +289,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Needs further investigation. (skip-when (string-equal (file-notify--test-library) "gio")) (tramp-cleanup-connection - (tramp-dissect-file-name temporary-file-directory) nil 'keep-password) + (tramp-dissect-file-name temporary-file-directory) t 'keep-password) + (file-notify--test-cleanup) (funcall (ert-test-body ert-test))))) (ert-deftest file-notify-test00-availability () @@ -315,7 +323,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (unless (stringp file-notify--test-tmpdir) (setq file-notify--test-tmpdir (expand-file-name - (make-temp-name "file-notify-test") temporary-file-directory))) + (make-temp-name "file-notify-test-parent") temporary-file-directory))) (unless (file-directory-p file-notify--test-tmpdir) (make-directory file-notify--test-tmpdir)) (expand-file-name @@ -558,7 +566,7 @@ and the event to `file-notify--test-events'." (result (ert-run-test (make-ert-test :body 'file-notify--test-event-test)))) ;; Do not add lock files, this would confuse the checks. - (unless (string-match + (unless (string-match-p (regexp-quote ".#") (file-notify--test-event-file file-notify--test-event)) (when file-notify-debug @@ -575,6 +583,8 @@ and the event to `file-notify--test-events'." (defun file-notify--test-with-actions-check (actions) "Check whether received actions match one of the ACTIONS alternatives." + (when file-notify-debug + (message "file-notify--test-with-actions-check")) (let (result) (dolist (elt actions result) (setq result @@ -632,11 +642,14 @@ delivered." (not (input-pending-p))) (setq file-notify--test-events nil file-notify--test-results nil) + (when file-notify-debug + (message "file-notify--test-with-actions expected: %s" actions)) ,@body (file-notify--test-wait-for-events ;; More actions need more time. Use some fudge factor. (* (ceiling max-length 100) (file-notify--test-timeout)) - (= max-length (length file-notify--test-events))) + (or (= max-length (length file-notify--test-events)) + (memq 'stopped (file-notify--test-event-actions)))) ;; Check the result sequence just to make sure that all actions ;; are as expected. (dolist (result file-notify--test-results) @@ -648,9 +661,7 @@ delivered." (ert-deftest file-notify-test03-events () "Check file creation/change/removal notifications." - :tags (if (getenv "EMACS_EMBA_CI") - '(:expensive-test :unstable) - '(:expensive-test)) + :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) (unwind-protect @@ -666,6 +677,9 @@ delivered." '(change) #'file-notify--test-event-handler))) (file-notify--test-with-actions (cond + ;; SMBSamba reports three `changed' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + '(created changed changed changed deleted stopped)) ;; GFam{File,Directory}Monitor, GKqueueFileMonitor and ;; GPollFileMonitor do not report the `changed' event. ((memq (file-notify--test-monitor) @@ -697,6 +711,9 @@ delivered." '(change) #'file-notify--test-event-handler))) (file-notify--test-with-actions (cond + ;; SMBSamba reports four `changed' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + '(changed changed changed changed deleted stopped)) ;; GFam{File,Directory}Monitor and GPollFileMonitor do ;; not detect the `changed' event reliably. ((memq (file-notify--test-monitor) @@ -739,10 +756,9 @@ delivered." ;; events for the watched directory. ((string-equal (file-notify--test-library) "w32notify") '(created changed deleted)) - ;; On emba, `deleted' and `stopped' events of the - ;; directory are not detected. - ((getenv "EMACS_EMBA_CI") - '(created changed deleted)) + ;; SMBSamba reports three `changed' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + '(created changed changed changed deleted deleted stopped)) ;; There are two `deleted' events, for the file and for ;; the directory. Except for ;; GFam{File,Directory}Monitor, GPollFileMonitor and @@ -789,6 +805,10 @@ delivered." '(created changed created changed changed changed changed deleted deleted)) + ;; SMBSamba reports three `changed' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + '(created changed changed changed created changed changed changed + deleted deleted deleted stopped)) ;; There are three `deleted' events, for two files and ;; for the directory. Except for ;; GFam{File,Directory}Monitor, GPollFileMonitor and @@ -798,10 +818,6 @@ delivered." '(created created changed changed deleted stopped)) ((string-equal (file-notify--test-library) "kqueue") '(created changed created changed deleted stopped)) - ;; On emba, `deleted' and `stopped' events of the - ;; directory are not detected. - ((getenv "EMACS_EMBA_CI") - '(created changed created changed deleted deleted)) ;; GKqueueFileMonitor does not report the `changed' event. ((eq (file-notify--test-monitor) 'GKqueueFileMonitor) '(created created deleted deleted deleted stopped)) @@ -843,10 +859,10 @@ delivered." ;; events for the watched directory. ((string-equal (file-notify--test-library) "w32notify") '(created changed renamed deleted)) - ;; On emba, `deleted' and `stopped' events of the - ;; directory are not detected. - ((getenv "EMACS_EMBA_CI") - '(created changed renamed deleted)) + ;; SMBSamba reports three `changed' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + '(created changed changed changed + renamed changed changed deleted deleted stopped)) ;; There are two `deleted' events, for the file and for ;; the directory. Except for ;; GFam{File,Directory}Monitor, GPollfileMonitor and @@ -897,6 +913,14 @@ delivered." ((string-equal (file-notify--test-library) "w32notify") '((changed changed) (changed changed changed changed))) + ;; SMBWindows does not distinguish between `changed' and + ;; `attribute-changed'. + ((eq (file-notify--test-monitor) 'SMBWindows) + '(changed changed)) + ;; SMBSamba does not distinguish between `changed' and + ;; `attribute-changed'. + ((eq (file-notify--test-monitor) 'SMBSamba) + '(changed changed changed changed)) ;; GFam{File,Directory}Monitor, GKqueueFileMonitor and ;; GPollFileMonitor do not report the `attribute-changed' ;; event. @@ -913,6 +937,10 @@ delivered." ;; `attribute-changed' event. ((string-equal (file-notify--test-library) "kqueue") '(attribute-changed attribute-changed attribute-changed)) + ;; For inotifywait, `write-region' raises also an + ;; `attribute-changed' event. + ((string-equal (file-notify--test-library) "inotifywait") + '(attribute-changed attribute-changed attribute-changed)) (t '(attribute-changed attribute-changed))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) @@ -931,7 +959,7 @@ delivered." (file-notify--test-cleanup))) (file-notify--deftest-remote file-notify-test03-events - "Check file creation/change/removal notifications for remote files." t) + "Check file creation/change/removal notifications for remote files.") (require 'autorevert) (setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded" @@ -948,6 +976,7 @@ delivered." (timeout (if (file-remote-p temporary-file-directory) 60 ; FIXME: can this be shortened? (* auto-revert-interval 2.5))) + (text-quoting-style 'grave) buf) (auto-revert-set-timer) (unwind-protect @@ -995,10 +1024,11 @@ delivered." ;; Check, that the buffer has been reverted. (file-notify--test-wait-for-events timeout - (string-match - (format-message "Reverting buffer `%s'." (buffer-name buf)) + (string-match-p + (rx bol "Reverting buffer `" + (literal (buffer-name buf)) "'" eol) captured-messages)) - (should (string-match "another text" (buffer-string))))) + (should (string-match-p "another text" (buffer-string))))) ;; Stop file notification. Autorevert shall still work via polling. (file-notify-rm-watch auto-revert-notify-watch-descriptor) @@ -1020,10 +1050,11 @@ delivered." ;; Check, that the buffer has been reverted. (file-notify--test-wait-for-events timeout - (string-match - (format-message "Reverting buffer `%s'." (buffer-name buf)) + (string-match-p + (rx bol "Reverting buffer `" + (literal (buffer-name buf)) "'" eol) captured-messages)) - (should (string-match "foo bla" (buffer-string))))) + (should (string-match-p "foo bla" (buffer-string))))) ;; Stop autorevert, in order to cleanup descriptor. (auto-revert-mode -1)) @@ -1037,7 +1068,7 @@ delivered." (file-notify--test-cleanup)))) (file-notify--deftest-remote file-notify-test04-autorevert - "Check autorevert via file notification for remote files." t) + "Check autorevert via file notification for remote files.") (ert-deftest file-notify-test05-file-validity () "Check `file-notify-valid-p' for files." @@ -1077,6 +1108,9 @@ delivered." (should (file-notify-valid-p file-notify--test-desc)) (file-notify--test-with-actions (cond + ;; SMBSamba reports three `changed' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + '(changed changed changed changed deleted stopped)) ;; GFam{File,Directory}Monitor do not ;; detect the `changed' event reliably. ((memq (file-notify--test-monitor) @@ -1093,6 +1127,7 @@ delivered." "another text" nil file-notify--test-tmpfile nil 'no-message) (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) + (file-notify--test-wait-event) ;; After deleting the file, the descriptor is not valid anymore. (should-not (file-notify-valid-p file-notify--test-desc)) (file-notify-rm-watch file-notify--test-desc) @@ -1106,53 +1141,55 @@ delivered." (unwind-protect ;; On emba, `deleted' and `stopped' events of the directory are ;; not detected. - (unless (getenv "EMACS_EMBA_CI") - (let ((file-notify--test-tmpdir - (make-temp-file "file-notify-test-parent" t))) - (should - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) - file-notify--test-desc - (file-notify--test-add-watch - file-notify--test-tmpdir - '(change) #'file-notify--test-event-handler))) - (should (file-notify-valid-p file-notify--test-desc)) - (file-notify--test-with-actions - (cond - ;; w32notify does not raise `deleted' and `stopped' - ;; events for the watched directory. - ((string-equal (file-notify--test-library) "w32notify") - '(created changed deleted)) - ;; There are two `deleted' events, for the file and for - ;; the directory. Except for - ;; GFam{File,Directory}Monitor, GPollFileMonitor and - ;; kqueue. And GFam{File,Directory}Monitor and - ;; GPollfileMonitor do not raise a `changed' event. - ((memq (file-notify--test-monitor) - '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor)) - '(created deleted stopped)) - ((string-equal (file-notify--test-library) "kqueue") - '(created changed deleted stopped)) - ;; GKqueueFileMonitor does not report the `changed' event. - ((eq (file-notify--test-monitor) 'GKqueueFileMonitor) - '(created deleted deleted stopped)) - (t '(created changed deleted deleted stopped))) - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-wait-event) - (delete-directory file-notify--test-tmpdir 'recursive)) - ;; After deleting the parent directory, the descriptor must - ;; not be valid anymore. - (should-not (file-notify-valid-p file-notify--test-desc)) - ;; w32notify doesn't generate `stopped' events when the - ;; parent directory is deleted, which doesn't provide a - ;; chance for filenotify.el to remove the descriptor from - ;; the internal hash table it maintains. So we must remove - ;; the descriptor manually. - (if (string-equal (file-notify--test-library) "w32notify") - (file-notify--rm-descriptor file-notify--test-desc)) + (let ((file-notify--test-tmpdir + (make-temp-file "file-notify-test-parent" t))) + (should + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify--test-add-watch + file-notify--test-tmpdir + '(change) #'file-notify--test-event-handler))) + (should (file-notify-valid-p file-notify--test-desc)) + (file-notify--test-with-actions + (cond + ;; w32notify does not raise `deleted' and `stopped' events + ;; for the watched directory. + ((string-equal (file-notify--test-library) "w32notify") + '(created changed deleted)) + ;; SMBSamba reports three `changed' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + '(created changed changed changed deleted deleted stopped)) + ;; There are two `deleted' events, for the file and for the + ;; directory. Except for GFam{File,Directory}Monitor, + ;; GPollFileMonitor and kqueue. And + ;; GFam{File,Directory}Monitor and GPollfileMonitor do not + ;; raise a `changed' event. + ((memq (file-notify--test-monitor) + '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor)) + '(created deleted stopped)) + ((string-equal (file-notify--test-library) "kqueue") + '(created changed deleted stopped)) + ;; GKqueueFileMonitor does not report the `changed' event. + ((eq (file-notify--test-monitor) 'GKqueueFileMonitor) + '(created deleted deleted stopped)) + (t '(created changed deleted deleted stopped))) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (file-notify--test-wait-event) + (delete-directory file-notify--test-tmpdir 'recursive)) + ;; After deleting the parent directory, the descriptor must not + ;; be valid anymore. + (should-not (file-notify-valid-p file-notify--test-desc)) + ;; w32notify doesn't generate `stopped' events when the parent + ;; directory is deleted, which doesn't provide a chance for + ;; filenotify.el to remove the descriptor from the internal hash + ;; table it maintains. So we must remove the descriptor + ;; manually. + (if (string-equal (file-notify--test-library) "w32notify") + (file-notify--rm-descriptor file-notify--test-desc)) - ;; The environment shall be cleaned up. - (file-notify--test-cleanup-p))) + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup))) @@ -1192,7 +1229,7 @@ delivered." (unwind-protect ;; On emba, `deleted' and `stopped' events of the directory are ;; not detected. - (unless (getenv "EMACS_EMBA_CI") + (progn (should (setq file-notify--test-tmpfile (make-temp-file "file-notify-test-parent" t))) @@ -1247,7 +1284,14 @@ delivered." (push (expand-file-name (format "y%d" i)) target-file-list)) (push (expand-file-name (format "y%d" i)) source-file-list) (push (expand-file-name (format "x%d" i)) target-file-list))) - (file-notify--test-with-actions (make-list (+ n n) 'created) + (file-notify--test-with-actions + (cond + ;; SMBSamba fires both `created' and `changed' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + (let (r) + (dotimes (_i (+ n n) r) + (setq r (append '(created changed) r))))) + (t (make-list (+ n n) 'created))) (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) @@ -1260,18 +1304,26 @@ delivered." ;; w32notify fires both `deleted' and `renamed' events. ((string-equal (file-notify--test-library) "w32notify") (let (r) - (dotimes (_i n) - (setq r (append '(deleted renamed) r))) - r)) - ;; GFam{File,Directory}Monitor and GPollFileMonitor fire + (dotimes (_i n r) + (setq r (append '(deleted renamed) r))))) + ;; SMBWindows fires both `changed' and `deleted' events. + ((eq (file-notify--test-monitor) 'SMBWindows) + (let (r) + (dotimes (_i n r) + (setq r (append '(changed deleted) r))))) + ;; SMBSamba fires both `changed' and `deleted' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + (let (r) + (dotimes (_i n r) + (setq r (append '(changed changed deleted) r))))) + ;; GFam{File,Directory}Monitor and GPollFileMonitor fire ;; `changed' and `deleted' events, sometimes in random ;; order. ((memq (file-notify--test-monitor) '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor)) (let (r) - (dotimes (_i n) - (setq r (append '(changed deleted) r))) - (cons :random r))) + (dotimes (_i n (cons :random r)) + (setq r (append '(changed deleted) r))))) (t (make-list n 'renamed))) (let ((source-file-list source-file-list) (target-file-list target-file-list)) @@ -1283,8 +1335,7 @@ delivered." (file-notify--test-wait-event) (delete-file file))) (delete-directory file-notify--test-tmpfile) - (if (or (string-equal (file-notify--test-library) "w32notify") - (getenv "EMACS_EMBA_CI")) + (if (string-equal (file-notify--test-library) "w32notify") (file-notify--rm-descriptor file-notify--test-desc)) ;; The environment shall be cleaned up. @@ -1295,8 +1346,7 @@ delivered." ;; Unpredictable failures, eg https://hydra.nixos.org/build/86016286 (file-notify--deftest-remote file-notify-test07-many-events - "Check that events are not dropped for remote directories." - (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))) + "Check that events are not dropped for remote directories.") (ert-deftest file-notify-test08-backup () "Check that backup keeps file notification." @@ -1315,6 +1365,9 @@ delivered." (should (file-notify-valid-p file-notify--test-desc)) (file-notify--test-with-actions (cond + ;; SMBSamba reports four `changed' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + '(changed changed changed changed)) ;; GKqueueFileMonitor does not report the `changed' event. ((eq (file-notify--test-monitor) 'GKqueueFileMonitor) '()) ;; There could be one or two `changed' events. @@ -1354,6 +1407,12 @@ delivered." (should (file-notify-valid-p file-notify--test-desc)) (file-notify--test-with-actions (cond + ;; SMBWindows reports two `changed' events. + ((eq (file-notify--test-monitor) 'SMBWindows) + '(changed changed)) + ;; SMBSamba reports four `changed' events. + ((eq (file-notify--test-monitor) 'SMBSamba) + '(changed changed changed changed)) ;; GFam{File,Directory}Monitor and GPollFileMonitor ;; report only the `changed' event. ((memq (file-notify--test-monitor) @@ -1394,9 +1453,7 @@ descriptors that were issued when registering the watches. This test caters for the situation in bug#22736 where the callback for the directory received events for the file with the descriptor of the file watch." - :tags (if (getenv "EMACS_EMBA_CI") - '(:expensive-test :unstable) - '(:expensive-test)) + :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) ;; A directory to be watched. @@ -1438,7 +1495,27 @@ the file watch." (file-notify--test-with-actions ;; There could be one or two `changed' events. (list - ;; cygwin. + ;; SMBSamba. Sometimes, tha last `changed' event is + ;; missing, so we add two alternatives. + (append + '(:random) + ;; Just the file monitor. + (make-list (* (/ n 2) 5) 'changed) + ;; Just the directory monitor. Strange, not all + ;; `changed' events do arrive. + (make-list (1- (* (/ n 2) 10)) 'changed) + (make-list (/ n 2) 'created) + (make-list (/ n 2) 'created)) + (append + '(:random) + ;; Just the file monitor. + (make-list (* (/ n 2) 5) 'changed) + ;; Just the directory monitor. This is the alternative + ;; with all `changed' events. + (make-list (* (/ n 2) 10) 'changed) + (make-list (/ n 2) 'created) + (make-list (/ n 2) 'created)) + ;; cygwin. (append '(:random) (make-list (/ n 2) 'changed) @@ -1482,7 +1559,9 @@ the file watch." ;; directory and the file monitor. The `stopped' event is ;; from the file monitor. It's undecided in which order the ;; directory and the file monitor are triggered. - (file-notify--test-with-actions '(:random deleted deleted stopped) + (file-notify--test-with-actions + '((:random deleted deleted stopped) + (:random deleted deleted deleted stopped)) (delete-file file-notify--test-tmpfile1)) (should (file-notify-valid-p file-notify--test-desc1)) (should-not (file-notify-valid-p file-notify--test-desc2)) @@ -1514,17 +1593,12 @@ the file watch." ;; events for the watched directory. ((string-equal (file-notify--test-library) "w32notify") '()) - ;; On emba, `deleted' and `stopped' events of the - ;; directory are not detected. - ((getenv "EMACS_EMBA_CI") - '()) (t '(deleted stopped)))))) (delete-directory file-notify--test-tmpfile 'recursive)) (unless (getenv "EMACS_EMBA_CI") (should-not (file-notify-valid-p file-notify--test-desc1)) (should-not (file-notify-valid-p file-notify--test-desc2))) - (when (or (string-equal (file-notify--test-library) "w32notify") - (getenv "EMACS_EMBA_CI")) + (when (string-equal (file-notify--test-library) "w32notify") (file-notify--rm-descriptor file-notify--test-desc1) (file-notify--rm-descriptor file-notify--test-desc2)) @@ -1535,7 +1609,7 @@ the file watch." (file-notify--test-cleanup))) (file-notify--deftest-remote file-notify-test09-watched-file-in-watched-dir - "Check `file-notify-test09-watched-file-in-watched-dir' for remote files." t) + "Check `file-notify-test09-watched-file-in-watched-dir' for remote files.") (ert-deftest file-notify-test10-sufficient-resources () "Check that file notification does not use too many resources." @@ -1715,8 +1789,8 @@ the file watch." "Check that file notification stop after unmounting the filesystem." :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) - ;; This test does not work for w32notify. - (skip-when (string-equal (file-notify--test-library) "w32notify")) + ;; This test does not work for w32notify snd smb-notify. + (skip-when (member (file-notify--test-library) '("w32notify" "smb-notify"))) (unwind-protect (progn @@ -1789,8 +1863,8 @@ the file watch." ;; the missing directory monitor. ;; * For w32notify, no `deleted' and `stopped' events arrive when a ;; directory is removed. -;; * For cygwin and w32notify, no `attribute-changed' events arrive. -;; They send `changed' events instead. +;; * For cygwin, w32notify, and smb-notify, no `attribute-changed' +;; events arrive. They send `changed' events instead. ;; * cygwin does not send all expected `changed' and `deleted' events. ;; Probably due to timing issues. diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el index e7c5a29ecd4..fdb82ac628b 100644 --- a/test/lisp/net/eww-tests.el +++ b/test/lisp/net/eww-tests.el @@ -29,6 +29,22 @@ The default just returns an empty list of headers and the URL as the body.") +(defvar eww-test--lots-of-words + (string-join (make-list 20 "All work and no play makes Jack a dull boy.") + " ") + "A long enough run of words to satisfy EWW's readable mode cutoff.") + +(defvar eww-test--wordy-page + (concat "<html>" + "<head>" + "<title>Welcome to my home page" + "" + "" + "" + "This is an uninteresting sentence." + "
" eww-test--lots-of-words "
" + "")) + (defmacro eww-test--with-mock-retrieve (&rest body) "Evaluate BODY with a mock implementation of `eww-retrieve'. This avoids network requests during our tests. Additionally, prepare a @@ -201,19 +217,10 @@ This sets `eww-before-browse-history-function' to (eww-test--with-mock-retrieve (let* ((shr-width most-positive-fixnum) (shr-use-fonts nil) - (words (string-join - (make-list - 20 "All work and no play makes Jack a dull boy.") - " ")) (eww-test--response-function (lambda (_url) (concat "Content-Type: text/html\n\n" - "" - "This is an uninteresting sentence." - "
" - words - "
" - "")))) + eww-test--wordy-page)))) (eww "example.invalid") ;; Make sure EWW renders the whole document. (should-not (plist-get eww-data :readable)) @@ -224,7 +231,7 @@ This sets `eww-before-browse-history-function' to ;; Now, EWW should render just the "readable" parts. (should (plist-get eww-data :readable)) (should (string-match-p - (concat "\\`" (regexp-quote words) "\n*\\'") + (concat "\\`" (regexp-quote eww-test--lots-of-words) "\n*\\'") (buffer-substring-no-properties (point-min) (point-max)))) (eww-readable 'toggle) ;; Finally, EWW should render the whole document again. @@ -240,11 +247,31 @@ This sets `eww-before-browse-history-function' to (let* ((eww-test--response-function (lambda (_url) (concat "Content-Type: text/html\n\n" - "Hello there"))) + eww-test--wordy-page))) (eww-readable-urls '("://example\\.invalid/"))) (eww "example.invalid") ;; Make sure EWW uses "readable" mode. - (should (plist-get eww-data :readable))))) + (should (plist-get eww-data :readable)) + ;; Make sure the page include the , <link>, and <base> nodes. + (should (equal (plist-get eww-data :title) "Welcome to my home page")) + (should (equal (plist-get eww-data :home) "somewhere.invalid")) + (let* ((html (dom-child-by-tag (plist-get eww-data :dom) 'html)) + (base-tags (dom-by-tag html 'base))) + (should (length= base-tags 1)) + (should (equal (dom-attr (car base-tags) 'href) "/foo/")))))) + +(ert-deftest eww-test/readable/default-readable/non-readable-page () + "Test that EWW handles readable-by-default correctly for non-readable pages." + (skip-unless (libxml-available-p)) + (eww-test--with-mock-retrieve + (let* ((eww-test--response-function + (lambda (_url) + (concat "Content-Type: text/html\n\n" + "<html><body><h1>Hello</h1></body></html>"))) + (eww-readable-urls '("://example\\.invalid/"))) + (eww "example.invalid") + ;; Make sure EWW doesn't use "readable" mode here. + (should-not (plist-get eww-data :readable))))) (provide 'eww-tests) ;; eww-tests.el ends here diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index 66682a237ca..41ca0264907 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el @@ -125,7 +125,6 @@ ) (defun server-process-filter (proc string) - (message "Received %s" string) (let ((prev (process-get proc 'previous-string))) (when prev (setq string (concat prev string)) @@ -141,19 +140,20 @@ )))) (defun network-test--resolve-system-name () - (cl-loop for address in (network-lookup-address-info (system-name)) - when (or (and (= (length address) 5) - ;; IPv4 localhost addresses start with 127. - (= (elt address 0) 127)) - (and (= (length address) 9) - ;; IPv6 localhost address. - (equal address [0 0 0 0 0 0 0 1 0]))) - return t)) + (let ((addresses (network-lookup-address-info (system-name)))) + (if addresses + (cl-loop for address in addresses + when (or (and (= (length address) 5) + ;; IPv4 localhost addresses start with 127. + (= (elt address 0) 127)) + (and (= (length address) 9) + ;; IPv6 localhost address. + (equal address [0 0 0 0 0 0 0 1 0]))) + return t) + t))) (ert-deftest echo-server-with-dns () - (unless (network-test--resolve-system-name) - (ert-skip "Can't test resolver for (system-name)")) - + (skip-when (network-test--resolve-system-name)) (let* ((server (make-server (system-name))) (port (aref (process-contact server :local) 4)) (proc (make-network-process :name "foo" @@ -243,36 +243,52 @@ (should (equal (buffer-string) "foo\n"))) (delete-process server))) -(defun make-tls-server (port) - (start-process "gnutls" (generate-new-buffer "*tls*") - "gnutls-serv" "--http" - "--x509keyfile" - (ert-resource-file "key.pem") - "--x509certfile" - (ert-resource-file "cert.pem") - "--port" (format "%s" port))) +(defun make-tls-server (&optional params) + (catch 'server + (let (port + proc) + (while t + (setq port (+ 20000 (random 45535)) + proc (apply #'start-process + "gnutls" (generate-new-buffer "*tls*") + "gnutls-serv" "--http" + "--x509keyfile" + (ert-resource-file "key.pem") + "--x509certfile" + (ert-resource-file "cert.pem") + "--port" (format "%s" port) + params)) + (while (not (eq (process-status proc) 'run)) + (sit-for 0.1)) + (with-current-buffer (process-buffer proc) + (when (eq + (catch 'status + (while t + (goto-char (point-min)) + (when (search-forward (format "port %s..." port) nil t) + (if (looking-at "done") + (throw 'status 'done)) + (if (looking-at "bind() failed") + (throw 'status 'failed))) + (sit-for 0.1))) + 'done) + (throw 'server (cons proc port)))) + (delete-process proc))))) (ert-deftest connect-to-tls-ipv4-wait () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44332)) - (times 0) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (make-network-process - :name "bar" - :buffer (generate-new-buffer "*foo*") - :host "localhost" - :service 44332)))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (make-network-process + :name "bar" + :buffer (generate-new-buffer "*foo*") + :host "localhost" + :service port)) (should proc) (gnutls-negotiate :process proc :type 'gnutls-x509pki @@ -293,33 +309,25 @@ (ert-deftest connect-to-tls-ipv4-nowait () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44331)) - (times 0) - (network-security-level 'low) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + (times 0) + (network-security-level 'low) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (make-network-process - :name "bar" - :buffer (generate-new-buffer "*foo*") - :nowait t - :family 'ipv4 - :tls-parameters - (cons 'gnutls-x509pki - (gnutls-boot-parameters - :hostname "localhost")) - :host "localhost" - :service 44331)))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) - (should proc) - (setq times 0) + (setq proc (make-network-process + :name "bar" + :buffer (generate-new-buffer "*foo*") + :nowait t + :family 'ipv4 + :tls-parameters + (cons 'gnutls-x509pki + (gnutls-boot-parameters + :hostname "localhost")) + :host "localhost" + :service port)) (while (and (eq (process-status proc) 'connect) (< (setq times (1+ times)) 10)) (sit-for 0.1)) @@ -338,33 +346,26 @@ (skip-unless (gnutls-available-p)) (skip-when (eq system-type 'windows-nt)) (skip-unless (featurep 'make-network-process '(:family ipv6))) - (let ((server (make-tls-server 44333)) - (times 0) - (network-security-level 'low) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + (times 0) + (network-security-level 'low) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (make-network-process - :name "bar" - :buffer (generate-new-buffer "*foo*") - :family 'ipv6 - :nowait t - :tls-parameters - (cons 'gnutls-x509pki - (gnutls-boot-parameters - :hostname "localhost")) - :host "::1" - :service 44333)))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (make-network-process + :name "bar" + :buffer (generate-new-buffer "*foo*") + :family 'ipv6 + :nowait t + :tls-parameters + (cons 'gnutls-x509pki + (gnutls-boot-parameters + :hostname "localhost")) + :host "::1" + :service port)) (should proc) - (setq times 0) (while (and (eq (process-status proc) 'connect) (< (setq times (1+ times)) 10)) (sit-for 0.1)) @@ -381,27 +382,20 @@ (ert-deftest open-network-stream-tls-wait () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44334)) - (times 0) - (network-security-level 'low) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + (network-security-level 'low) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (open-network-stream - "bar" - (generate-new-buffer "*foo*") - "localhost" - 44334 - :type 'tls - :nowait nil)))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (open-network-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + port + :type 'tls + :nowait nil)) (should proc) (skip-when (eq (process-status proc) 'connect))) (if (process-live-p server) (delete-process server))) @@ -420,29 +414,22 @@ (ert-deftest open-network-stream-tls-nowait () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44335)) - (times 0) - (network-security-level 'low) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + (times 0) + (network-security-level 'low) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (open-network-stream - "bar" - (generate-new-buffer "*foo*") - "localhost" - 44335 - :type 'tls - :nowait t)))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (open-network-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + port + :type 'tls + :nowait t)) (should proc) - (setq times 0) (while (and (eq (process-status proc) 'connect) (< (setq times (1+ times)) 10)) (sit-for 0.1)) @@ -463,26 +450,19 @@ (ert-deftest open-network-stream-tls () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44336)) - (times 0) - (network-security-level 'low) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + (network-security-level 'low) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (open-network-stream - "bar" - (generate-new-buffer "*foo*") - "localhost" - 44336 - :type 'tls)))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (open-network-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + port + :type 'tls)) (should proc) (skip-when (eq (process-status proc) 'connect))) (if (process-live-p server) (delete-process server))) @@ -501,27 +481,20 @@ (ert-deftest open-network-stream-tls-nocert () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44337)) - (times 0) - (network-security-level 'low) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + (network-security-level 'low) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (open-network-stream - "bar" - (generate-new-buffer "*foo*") - "localhost" - 44337 - :type 'tls - :client-certificate nil)))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (open-network-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + port + :type 'tls + :client-certificate nil)) (should proc) (skip-when (eq (process-status proc) 'connect))) (if (process-live-p server) (delete-process server))) @@ -540,25 +513,19 @@ (ert-deftest open-gnutls-stream-new-api-default () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44665)) - (times 0) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (open-gnutls-stream - "bar" - (generate-new-buffer "*foo*") - "localhost" - 44665)))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + port)) (should proc) + (skip-when (eq (process-status proc) 'connect))) (if (process-live-p server) (delete-process server))) (setq status (gnutls-peer-status proc)) (should (consp status)) @@ -570,31 +537,25 @@ (let ((issuer (plist-get (plist-get status :certificate) :issuer))) (should (stringp issuer)) (setq issuer (split-string issuer ",")) - (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) (ert-deftest open-gnutls-stream-new-api-wait () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44666)) - (times 0) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (open-gnutls-stream - "bar" - (generate-new-buffer "*foo*") - "localhost" - 44666 - (list :nowait nil))))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + port + (list :nowait nil))) (should proc) + (skip-when (eq (process-status proc) 'connect))) (if (process-live-p server) (delete-process server))) (setq status (gnutls-peer-status proc)) (should (consp status)) @@ -606,32 +567,26 @@ (let ((issuer (plist-get (plist-get status :certificate) :issuer))) (should (stringp issuer)) (setq issuer (split-string issuer ",")) - (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) (ert-deftest open-gnutls-stream-old-api-wait () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44667)) - (times 0) - (nowait nil) ; Workaround Bug#47080 - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + (nowait nil) ; Workaround Bug#47080 + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (open-gnutls-stream - "bar" - (generate-new-buffer "*foo*") - "localhost" - 44667 - nowait)))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + port + nowait)) (should proc) + (skip-when (eq (process-status proc) 'connect))) (if (process-live-p server) (delete-process server))) (setq status (gnutls-peer-status proc)) (should (consp status)) @@ -643,33 +598,26 @@ (let ((issuer (plist-get (plist-get status :certificate) :issuer))) (should (stringp issuer)) (setq issuer (split-string issuer ",")) - (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) (ert-deftest open-gnutls-stream-new-api-nowait () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44668)) - (times 0) - (network-security-level 'low) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + (times 0) + (network-security-level 'low) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (open-gnutls-stream - "bar" - (generate-new-buffer "*foo*") - "localhost" - 44668 - (list :nowait t))))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + port + (list :nowait t))) (should proc) - (setq times 0) (while (and (eq (process-status proc) 'connect) (< (setq times (1+ times)) 10)) (sit-for 0.1)) @@ -686,27 +634,21 @@ (ert-deftest open-gnutls-stream-old-api-nowait () (skip-unless (executable-find "gnutls-serv")) (skip-unless (gnutls-available-p)) - (let ((server (make-tls-server 44669)) - (times 0) - (network-security-level 'low) - (nowait t) - proc status) + (let* ((s (make-tls-server)) + (server (car s)) + (port (cdr s)) + (times 0) + (network-security-level 'low) + (nowait t) + proc status) (unwind-protect (progn - (sleep-for 1) - (with-current-buffer (process-buffer server) - (message "gnutls-serv: %s" (buffer-string))) - - ;; It takes a while for gnutls-serv to start. - (while (and (null (ignore-errors - (setq proc (open-gnutls-stream - "bar" - (generate-new-buffer "*foo*") - "localhost" - 44669 - nowait)))) - (< (setq times (1+ times)) 10)) - (sit-for 0.1)) + (setq proc (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + port + nowait)) (should proc) (setq times 0) (while (and (eq (process-status proc) 'connect) @@ -729,14 +671,14 @@ "bar" (generate-new-buffer "*foo*") "localhost" - 44777 + (+ 20000 (random 45535)) (list t))) (should-error (open-gnutls-stream "bar" (generate-new-buffer "*foo*") "localhost" - 44777 + (+ 20000 (random 45535)) (vector :nowait t)))) (ert-deftest check-network-process-coding-system-bind () diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 2b6e09a4d16..2b98da4134b 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -185,7 +185,9 @@ directory hierarchy." (funcall fn))) (cancel-timer timer) (when (eq retval timed-out) - (error "%s" (concat "Timed out " message)))))) + (if (getenv "EMACS_EMBA_CI") + (ert-skip (concat "Timed out " message)) + (error "%s" (concat "Timed out " message))))))) (defun eglot--find-file-noselect (file &optional noerror) (unless (or noerror diff --git a/test/lisp/progmodes/peg-tests.el b/test/lisp/progmodes/peg-tests.el index 9d5e09ec8ae..df761a42c14 100644 --- a/test/lisp/progmodes/peg-tests.el +++ b/test/lisp/progmodes/peg-tests.el @@ -396,5 +396,12 @@ resp. succeeded instead of signaling an error." ;; (peg-ex-last-digit2 (make-string 500000 ?-)) ;; (peg-ex-last-digit2 (make-string 500000 ?5)) +(ert-deftest peg-tests--peg-parse () + (with-temp-buffer + (insert "abc") + (goto-char (point-min)) + (peg-parse (bob) "ab") + (should (looking-at "c")))) + (provide 'peg-tests) ;;; peg-tests.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 024cbe85bba..de2c59b9c25 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1298,11 +1298,7 @@ final or penultimate step during initialization.")) (should (eq (function-get 'subr-tests--some-fun 'prop) 'value)) ;; With an alias. (should (eq (function-get 'subr-tests--some-alias 'prop) 'value)) - (function-put 'subr-tests--some-alias 'prop 'value) - (should-error (function-get "non-symbol" 'prop) - :type 'wrong-type-argument) - (should-error (function-put "non-symbol" 'prop 'val) - :type 'wrong-type-argument)) + (function-put 'subr-tests--some-alias 'prop 'value)) (function-put 'subr-tests--some-fun 'prop nil))) (defun subr-tests--butlast-ref (list &optional n) @@ -1505,5 +1501,16 @@ final or penultimate step during initialization.")) (should (hash-table-contains-p 'cookie h)) (should (hash-table-contains-p 'milk h)))) +(ert-deftest subr-test-split-string () + (let ((text "-*- lexical-binding: t; -*-") + (seps "-\\*-") + (trim "[ \t\n\r-]+")) + (should (equal (split-string text seps nil trim) + '("" "lexical-binding: t;" ""))) + (should (equal (split-string text seps t trim) + '("lexical-binding: t;"))) + (should (equal (split-string text "[ \t\n\r-]*-\\*-[ \t\n\r-]*") + '("" "lexical-binding: t;" ""))))) + (provide 'subr-tests) ;;; subr-tests.el ends here diff --git a/test/lisp/textmodes/fill-resources/fill-region.erts b/test/lisp/textmodes/fill-resources/fill-region.erts new file mode 100644 index 00000000000..95e08248309 --- /dev/null +++ b/test/lisp/textmodes/fill-resources/fill-region.erts @@ -0,0 +1,23 @@ +Point-Char: | + +Name: fill region + +=-= +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. + +|Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. + +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. + +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. +=-= +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. + +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do +eiusmod tempor. Incididunt ut labore et dolore magna aliqua. + +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do +eiusmod tempor. Incididunt ut labore et dolore magna aliqua. + +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. +=-=-= diff --git a/test/lisp/textmodes/fill-resources/semlf-emacs-lisp-mode.erts b/test/lisp/textmodes/fill-resources/semlf-emacs-lisp-mode.erts index fe71ee32c1a..1623b0dcf8a 100644 --- a/test/lisp/textmodes/fill-resources/semlf-emacs-lisp-mode.erts +++ b/test/lisp/textmodes/fill-resources/semlf-emacs-lisp-mode.erts @@ -59,12 +59,12 @@ the comment. ;; eiusmod tempor. Incididunt ut labore et dolore magna aliqua. Ut ;; enim ad minim veniam, quis nostrud exercitation ullamco laboris ;; nisi ut. - +;; ;; |Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed ;; do eiusmod tempor. Incididunt ut labore et dolore magna ;; aliqua. Ut enim ad minim veniam, quis nostrud exercitation ;; ullamco laboris nisi ut. - +;; ;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do ;; eiusmod tempor. Incididunt ut labore et dolore magna aliqua. Ut ;; enim ad minim veniam, quis nostrud exercitation ullamco laboris @@ -74,12 +74,12 @@ the comment. ;; eiusmod tempor. Incididunt ut labore et dolore magna aliqua. Ut ;; enim ad minim veniam, quis nostrud exercitation ullamco laboris ;; nisi ut. - +;; ;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed ;; do eiusmod tempor. ;; Incididunt ut labore et dolore magna aliqua. Ut enim ad minim ;; veniam, quis nostrud exercitation ullamco laboris nisi ut. - +;; ;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do ;; eiusmod tempor. Incididunt ut labore et dolore magna aliqua. Ut ;; enim ad minim veniam, quis nostrud exercitation ullamco laboris diff --git a/test/lisp/textmodes/fill-resources/semlf-fill-paragraph-function.erts b/test/lisp/textmodes/fill-resources/semlf-fill-paragraph-function.erts deleted file mode 100644 index 467e7401cf5..00000000000 --- a/test/lisp/textmodes/fill-resources/semlf-fill-paragraph-function.erts +++ /dev/null @@ -1,12 +0,0 @@ -Name: fill-paragraph-function - -=-= -Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do -eiusmod tempor. Incididunt ut labore et dolore magna aliqua. Ut enim -ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut. -=-= -Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do -eiusmod tempor. -Incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, -quis nostrud exercitation ullamco laboris nisi ut. -=-=-= diff --git a/test/lisp/textmodes/fill-resources/semlf-fill-region.erts b/test/lisp/textmodes/fill-resources/semlf-fill-region.erts new file mode 100644 index 00000000000..231019a082a --- /dev/null +++ b/test/lisp/textmodes/fill-resources/semlf-fill-region.erts @@ -0,0 +1,25 @@ +Point-Char: | + +Name: fill-region-as-paragraph-function + +=-= +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. + +|Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. + +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. + +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. +=-= +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. + +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do +eiusmod tempor. +Incididunt ut labore et dolore magna aliqua. + +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do +eiusmod tempor. +Incididunt ut labore et dolore magna aliqua. + +Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor. Incididunt ut labore et dolore magna aliqua. +=-=-= diff --git a/test/lisp/textmodes/fill-tests.el b/test/lisp/textmodes/fill-tests.el index 8fbd9919bad..e1839fd6884 100644 --- a/test/lisp/textmodes/fill-tests.el +++ b/test/lisp/textmodes/fill-tests.el @@ -122,6 +122,17 @@ eius. Foo"))) ;; w "))) +(ert-deftest fill-test-fill-region () + "Test the `fill-region' function." + (ert-test-erts-file (ert-resource-file "fill-region.erts") + (lambda () + (fill-region + (point) + (progn + (goto-char (point-max)) + (forward-line -1) + (beginning-of-line) + (point)))))) (ert-deftest fill-test-fill-region-as-paragraph-semlf () "Test the `fill-region-as-paragraph-semlf' function." @@ -136,47 +147,54 @@ eius. Foo"))) (beginning-of-line) (point)))))) -(ert-deftest fill-test-fill-paragraph-semlf () - "Test the `fill-paragraph-semlf' function." +(ert-deftest fill-test-semlf-fill-region () + "Test `fill-region' with `fill-region-as-paragraph-semlf'." + (ert-test-erts-file (ert-resource-file "semlf-fill-region.erts") + (lambda () + (setq-local fill-region-as-paragraph-function + #'fill-region-as-paragraph-semlf) + (fill-region + (point) + (progn + (goto-char (point-max)) + (forward-line -1) + (beginning-of-line) + (point)))))) + +(ert-deftest fill-test-semlf () + "Test semantic-linefeed filling." (ert-test-erts-file (ert-resource-file "semlf.erts") (lambda () (fill-paragraph-semlf)))) -(ert-deftest fill-test-fill-paragraph-semlf-fill-paragraph-function () - "Test `fill-paragraph-semlf' as `fill-paragraph-function'." - (ert-test-erts-file (ert-resource-file "semlf-fill-paragraph-function.erts") - (lambda () - (setq-local fill-paragraph-function #'fill-paragraph-semlf) - (fill-paragraph)))) - -(ert-deftest fill-test-fill-paragraph-semlf-justify () - "Test the JUSTIFY parameter of the `fill-paragraph-semlf' function." +(ert-deftest fill-test-semlf-justify () + "Test semantic-linefeed filling with text justification." (ert-test-erts-file (ert-resource-file "semlf-justify.erts") (lambda () (fill-paragraph-semlf 'justify)))) -(ert-deftest fill-test-fill-paragraph-semlf-sentence-end-double-space () - "Test the `fill-paragraph-semlf' function with `sentence-end-double-space'." +(ert-deftest fill-test-semlf-sentence-end-double-space () + "Test semantic-linefeed filling with `sentence-end-double-space'." (ert-test-erts-file (ert-resource-file "semlf-sentence-end-double-space.erts") (lambda () (setq-local sentence-end-double-space nil) (fill-paragraph-semlf)))) -(ert-deftest fill-test-fill-paragraph-semlf-fill-column () - "Test the `fill-paragraph-semlf' function with `fill-column'." +(ert-deftest fill-test-semlf-fill-column () + "Test semantic-linefeed filling with `fill-column'." (ert-test-erts-file (ert-resource-file "semlf-fill-column.erts") (lambda () (setq-local fill-column 35) (fill-paragraph-semlf)))) -(ert-deftest fill-test-fill-paragraph-semlf-punctuation-marks () - "Test the `fill-paragraph-semlf' function with different punctuation marks." +(ert-deftest fill-test-semlf-punctuation-marks () + "Test semantic-linefeed filling with different punctuation marks." (ert-test-erts-file (ert-resource-file "semlf-punctuation-marks.erts") (lambda () (fill-paragraph-semlf)))) -(ert-deftest fill-test-fill-paragraph-semlf-twice () - "Test to run the `fill-paragraph-semlf' function twice." +(ert-deftest fill-test-semlf-twice () + "Test filling the same text twice using semantic linefeeds." (ert-test-erts-file (ert-resource-file "semlf-twice.erts") (lambda () (goto-char (point-min)) @@ -184,49 +202,50 @@ eius. Foo"))) (goto-char (point-min)) (fill-paragraph-semlf)))) -(ert-deftest fill-test-fill-paragraph-semlf-fill-prefix () - "Test the `fill-paragraph-semlf' function with different fill prefixes." +(ert-deftest fill-test-semlf-fill-prefix () + "Test semantic-linefeed filling with different fill prefixes." (ert-test-erts-file (ert-resource-file "semlf-fill-prefix.erts") (lambda () (fill-paragraph-semlf)))) -(ert-deftest fill-test-fill-paragraph-semlf-indented-block () - "Test the `fill-paragraph-semlf' function with an indented block." +(ert-deftest fill-test-semlf-indented-block () + "Test semantic-linefeed filling with an indented block." (ert-test-erts-file (ert-resource-file "semlf-indented-block.erts") (lambda () (fill-paragraph-semlf)))) -(ert-deftest fill-test-fill-paragraph-semlf-revert () - "Test that the `fill-paragraph-semlf' function can be reverted." +(ert-deftest fill-test-semlf-revert () + "Test that semantic-linefeed filling can be reverted." (ert-test-erts-file (ert-resource-file "semlf-revert.erts") (lambda () (fill-paragraph) - (fill-paragraph-semlf) + (fill-paragraph-semlf) (fill-paragraph)))) -(ert-deftest fill-test-fill-paragraph-semlf-emacs-lisp-mode () - "Test the `fill-paragraph-semlf' function with `emacs-lisp-mode'." +(ert-deftest fill-test-semlf-emacs-lisp-mode () + "Test semantic-linefeed filling with `emacs-lisp-mode'." (ert-test-erts-file (ert-resource-file "semlf-emacs-lisp-mode.erts") (lambda () (emacs-lisp-mode) (fill-paragraph-semlf)))) -(ert-deftest fill-test-fill-paragraph-semlf-c-mode () - "Test the `fill-paragraph-semlf' function with `c-mode'." +(ert-deftest fill-test-semlf-c-mode () + "Test semantic-linefeed filling with `c-mode'." (ert-test-erts-file (ert-resource-file "semlf-c-mode.erts") (lambda () (c-mode) (fill-paragraph-semlf)))) -(ert-deftest fill-test-fill-paragraph-semlf-org-mode () - "Test the `fill-paragraph-semlf' function with `org-mode'." +(ert-deftest fill-test-semlf-org-mode () + "Test semantic-linefeed filling with `org-mode'." (ert-test-erts-file (ert-resource-file "semlf-org-mode.erts") (lambda () (org-mode) (fill-paragraph-semlf)))) -(ert-deftest fill-test-fill-paragraph-semlf-markdown-mode () - "Test the `fill-paragraph-semlf' function with `markdown-mode'." +(declare-function markdown-mode "markdown-mode") +(ert-deftest fill-test-semlf-markdown-mode () + "Test semantic-linefeed filling with `markdown-mode'." (skip-unless (functionp 'markdown-mode)) (ert-test-erts-file (ert-resource-file "semlf-markdown-mode.erts") (lambda () diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 9a27c420f1e..2fce2315edb 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -630,4 +630,29 @@ (should (string= (format "%S" (format "%S %S" [1] (symbol-function '+))) str)))) +(ert-deftest editfns-tests--bug76124 () + (with-temp-buffer + (insert "Emacs forever!foo\n") + (insert "toto\n") + (goto-char (point-min)) + ;; Remove the trailing "foo", so as to move the gap between the + ;; two lines. + (delete-region (- (pos-eol) 3) (pos-eol)) + (add-hook 'before-change-functions + (lambda (beg end) + ;; Eglot uses `encode-coding-region' which can also move + ;; the gap, but let's do it more forcefully here. + (save-excursion + (goto-char beg) + (end-of-line) + (unless (> (point) end) + (with-silent-modifications + (insert "foo") + (delete-char -3))))) + nil t) + (goto-char (point-min)) + (transpose-regions (pos-bol) (pos-eol) + (pos-bol 2) (pos-eol 2)) + (should (equal (buffer-string) "toto\nEmacs forever!\n")))) + ;;; editfns-tests.el ends here diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index 13cc5de29e8..b6302c35fee 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -235,5 +235,31 @@ Also check that an encoding error can appear in a symlink." "2025/02/01 23:15:59.123456700"))) (delete-file tfile)))) +(defconst ert--tests-dir + (file-name-directory (macroexp-file-name))) + +(ert-deftest fileio-tests--insert-file-contents-supersession () + (ert-with-temp-file file + (write-region "foo" nil file) + (let* ((asked nil) + (buf (find-file-noselect file)) + (auast (lambda (&rest _) (setq asked t)))) + (unwind-protect + (with-current-buffer buf + ;; Pretend someone else edited the file. + (write-region "bar" nil file 'append) + ;; Use `advice-add' rather than `cl-letf' because the function + ;; may not be defined yet. + (advice-add 'ask-user-about-supersession-threat :override auast) + ;; Modify the local buffer via `insert-file-contents'. + (insert-file-contents + (expand-file-name "lread-resources/somelib.el" + ert--tests-dir) + nil nil nil 'replace)) + (advice-remove 'ask-user-about-supersession-threat auast) + (kill-buffer buf)) + ;; We should have prompted about the supersession threat. + (should asked)))) + ;;; fileio-tests.el ends here diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 40640e79eed..d9b31a6c438 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -387,4 +387,15 @@ literals (Bug#20852)." (goto-char (point-min)) (should-error (read (current-buffer)) :type 'end-of-file))) +(ert-deftest lread-function-source () + (let* ((s '(#x41 #x222a #xff -1)) + (val (read (lambda () (pop s))))) + (should (equal (symbol-name val) "A∪ÿ")))) + +(ert-deftest lread-unibyte-string-source () + (let* ((src "\"a\xff\"") + (val (read src))) + (should (equal val "a\xff")) ; not "aÿ" + (should-not (multibyte-string-p val)))) + ;;; lread-tests.el ends here diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 036248fd091..c870427a0a9 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -356,7 +356,9 @@ otherwise, use a different charset." (print-tests--deftest error-message-string-circular () (let ((err (list 'error))) (setcdr err err) - (should-error (error-message-string err) :type 'circular-list))) + (should-error (error-message-string err) :type 'circular-list) + ;; check that prin1-to-string-buffer is cleared (bug#78842) + (should (equal "37.0" (prin1-to-string 37.0))))) (print-tests--deftest print-hash-table-test () (should @@ -558,5 +560,12 @@ otherwise, use a different charset." (ignore (make-string 100 ?b)))) (should (equal outstr "xxx")))) +(ert-deftest print-unibyte-symbols () + ;; Non-ASCII in unibyte symbols should print as raw bytes. + (should (equal (prin1-to-string (make-symbol "a\xff")) + (string-to-multibyte "a\xff"))) + (should (equal (prin1-to-string (make-symbol "th\303\251")) + (string-to-multibyte "th\303\251")))) + (provide 'print-tests) ;;; print-tests.el ends here diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 84cf490e549..b5ea63a53f3 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -1141,7 +1141,8 @@ and \"]\"." (if-let* ((pos (funcall #'treesit-navigate-thing (point) (car conf) (cdr conf) - treesit-defun-type-regexp tactic))) + (or treesit-defun-type-regexp 'defun) + tactic))) (save-excursion (goto-char pos) (funcall treesit-defun-skipper)