diff options
| author | Andrea Corallo | 2024-02-28 20:47:57 +0100 |
|---|---|---|
| committer | Andrea Corallo | 2024-02-28 20:47:57 +0100 |
| commit | 1fbe56c32761efdc8d268df80a97a9102d00e109 (patch) | |
| tree | 8d8e76c8ae43c79ef9d76b0f97c12607567664b9 | |
| parent | 6de60f33ed5cc438e20400aee83e1e2032773811 (diff) | |
| parent | 05195e129fc933db32c9e08a155a94bfa4d75b54 (diff) | |
| download | emacs-1fbe56c32761efdc8d268df80a97a9102d00e109.tar.gz emacs-1fbe56c32761efdc8d268df80a97a9102d00e109.zip | |
Merge remote-tracking branch 'origin/master' into 'feature/type-hierarchy'
346 files changed, 11139 insertions, 6254 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index ce7febca851..1a6acecc206 100644 --- a/.dir-locals.el +++ b/.dir-locals.el | |||
| @@ -3,8 +3,8 @@ | |||
| 3 | 3 | ||
| 4 | ((nil . ((tab-width . 8) | 4 | ((nil . ((tab-width . 8) |
| 5 | (sentence-end-double-space . t) | 5 | (sentence-end-double-space . t) |
| 6 | (fill-column . 70) | 6 | (fill-column . 72) |
| 7 | (emacs-lisp-docstring-fill-column . 65) | 7 | (emacs-lisp-docstring-fill-column . 72) |
| 8 | (vc-git-annotate-switches . "-w") | 8 | (vc-git-annotate-switches . "-w") |
| 9 | (bug-reference-url-format . "https://debbugs.gnu.org/%s") | 9 | (bug-reference-url-format . "https://debbugs.gnu.org/%s") |
| 10 | (diff-add-log-use-relative-names . t) | 10 | (diff-add-log-use-relative-names . t) |
| @@ -23,6 +23,11 @@ | |||
| 23 | (electric-quote-string . nil) | 23 | (electric-quote-string . nil) |
| 24 | (indent-tabs-mode . t) | 24 | (indent-tabs-mode . t) |
| 25 | (mode . bug-reference-prog))) | 25 | (mode . bug-reference-prog))) |
| 26 | (java-mode . ((c-file-style . "GNU") | ||
| 27 | (electric-quote-comment . nil) | ||
| 28 | (electric-quote-string . nil) | ||
| 29 | (indent-tabs-mode . t) | ||
| 30 | (mode . bug-reference-prog))) | ||
| 26 | (objc-mode . ((c-file-style . "GNU") | 31 | (objc-mode . ((c-file-style . "GNU") |
| 27 | (electric-quote-comment . nil) | 32 | (electric-quote-comment . nil) |
| 28 | (electric-quote-string . nil) | 33 | (electric-quote-string . nil) |
| @@ -32,7 +37,8 @@ | |||
| 32 | (mode . bug-reference-prog))) | 37 | (mode . bug-reference-prog))) |
| 33 | (log-edit-mode . ((log-edit-font-lock-gnu-style . t) | 38 | (log-edit-mode . ((log-edit-font-lock-gnu-style . t) |
| 34 | (log-edit-setup-add-author . t) | 39 | (log-edit-setup-add-author . t) |
| 35 | (vc-git-log-edit-summary-target-len . 50))) | 40 | (vc-git-log-edit-summary-target-len . 50) |
| 41 | (fill-column . 64))) | ||
| 36 | (change-log-mode . ((add-log-time-zone-rule . t) | 42 | (change-log-mode . ((add-log-time-zone-rule . t) |
| 37 | (fill-column . 74) | 43 | (fill-column . 74) |
| 38 | (mode . bug-reference))) | 44 | (mode . bug-reference))) |
| @@ -116,6 +116,7 @@ Lars Ingebrigtsen <larsi@gnus.org> <larsi@quimbies.gnus.org> | |||
| 116 | Lars Ingebrigtsen <larsi@gnus.org> <larsi@stories.gnus.org> | 116 | Lars Ingebrigtsen <larsi@gnus.org> <larsi@stories.gnus.org> |
| 117 | Laurence Warne <laurencewarne@gmail.com> | 117 | Laurence Warne <laurencewarne@gmail.com> |
| 118 | Lin Sun <lin.sun@zoom.us> | 118 | Lin Sun <lin.sun@zoom.us> |
| 119 | Liu Hui <liuhui1610@gmail.com> <ilupin@users.noreply.github.com> | ||
| 119 | Ludovic Courtès <ludo@gnu.org> | 120 | Ludovic Courtès <ludo@gnu.org> |
| 120 | Luke Lee <luke.yx.lee@gmail.com> | 121 | Luke Lee <luke.yx.lee@gmail.com> |
| 121 | Martin Rudalics <rudalics@gmx.at> | 122 | Martin Rudalics <rudalics@gmx.at> |
| @@ -129,7 +130,7 @@ Maxim Nikulin <manikulin@gmail.com> | |||
| 129 | Michael Albinus <michael.albinus@gmx.de> <albinus@detlef> | 130 | Michael Albinus <michael.albinus@gmx.de> <albinus@detlef> |
| 130 | Michalis V <mvar.40k@gmail.com> | 131 | Michalis V <mvar.40k@gmail.com> |
| 131 | Miha Rihtaršič <miha@kamnitnik.top> | 132 | Miha Rihtaršič <miha@kamnitnik.top> |
| 132 | Morgan J. Smith <Morgan.J.Smith@outlook.com> | 133 | Morgan Smith <Morgan.J.Smith@outlook.com> |
| 133 | Nick Drozd <nicholasdrozd@gmail.com> | 134 | Nick Drozd <nicholasdrozd@gmail.com> |
| 134 | Nicolas Petton <nicolas@petton.fr> <petton.nicolas@gmail.com> | 135 | Nicolas Petton <nicolas@petton.fr> <petton.nicolas@gmail.com> |
| 135 | Nitish Chandra <nitishchandrachinta@gmail.com> | 136 | Nitish Chandra <nitishchandrachinta@gmail.com> |
| @@ -146,8 +147,7 @@ Philip Kaludercic <philipk@posteo.net> | |||
| 146 | Philip Kaludercic <philipk@posteo.net> <philip.kaludercic@fau.de> | 147 | Philip Kaludercic <philipk@posteo.net> <philip.kaludercic@fau.de> |
| 147 | Philip Kaludercic <philipk@posteo.net> <philip@icterid> | 148 | Philip Kaludercic <philipk@posteo.net> <philip@icterid> |
| 148 | Philip Kaludercic <philipk@posteo.net> <philip@warpmail.net> | 149 | Philip Kaludercic <philipk@posteo.net> <philip@warpmail.net> |
| 149 | Philipp Stephani <phst@google.com> | 150 | Philipp Stephani <p.stephani2@gmail.com> |
| 150 | Philipp Stephani <phst@google.com> Philipp Stephani <p.stephani2@gmail.com> | ||
| 151 | Phillip Lord <phillip.lord@russet.org.uk> <phillip.lord@newcastle.ac.uk> | 151 | Phillip Lord <phillip.lord@russet.org.uk> <phillip.lord@newcastle.ac.uk> |
| 152 | Pierre Lorenzon <devel@pollock-nageoire.net> | 152 | Pierre Lorenzon <devel@pollock-nageoire.net> |
| 153 | Pieter van Oostrum <pieter@vanoostrum.org> <pieter-l@vanoostrum.org> | 153 | Pieter van Oostrum <pieter@vanoostrum.org> <pieter-l@vanoostrum.org> |
| @@ -21,6 +21,10 @@ If necessary, you can read the manual without an info program: | |||
| 21 | 21 | ||
| 22 | cat info/emacs* | more "+/^File: emacs.*, Node: Bugs," | 22 | cat info/emacs* | more "+/^File: emacs.*, Node: Bugs," |
| 23 | 23 | ||
| 24 | If you think you may have found a critical security issue that needs | ||
| 25 | to be communicated privately, please contact the GNU Emacs maintainers | ||
| 26 | directly. See admin/MAINTAINERS for their contact details. | ||
| 27 | |||
| 24 | 28 | ||
| 25 | Please first check the file etc/PROBLEMS (e.g. with C-h C-p in Emacs) to | 29 | Please first check the file etc/PROBLEMS (e.g. with C-h C-p in Emacs) to |
| 26 | make sure it isn't a known issue. | 30 | make sure it isn't a known issue. |
diff --git a/CONTRIBUTE b/CONTRIBUTE index 70b9760bb99..bdee16eeab4 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE | |||
| @@ -115,9 +115,10 @@ mode after hiding the body of each entry. | |||
| 115 | 115 | ||
| 116 | Doc-strings should be updated together with the code. | 116 | Doc-strings should be updated together with the code. |
| 117 | 117 | ||
| 118 | New defcustom's should always have a ':version' tag stating the first | 118 | New defcustom's and defface's should always have a ':version' tag |
| 119 | Emacs version in which they will appear. Likewise with defcustom's | 119 | stating the first Emacs version in which they will appear. Likewise |
| 120 | whose value is changed -- update their ':version' tag. | 120 | with defcustom's or defface's whose value is changed -- update their |
| 121 | ':version' tag. | ||
| 121 | 122 | ||
| 122 | Think about whether your change requires updating the manuals. If you | 123 | Think about whether your change requires updating the manuals. If you |
| 123 | know it does not, mark the NEWS entry with "---" before the entry. If | 124 | know it does not, mark the NEWS entry with "---" before the entry. If |
| @@ -170,9 +171,9 @@ test 'out-of-tree' builds as well, i.e.: | |||
| 170 | 171 | ||
| 171 | ** Commit messages | 172 | ** Commit messages |
| 172 | 173 | ||
| 173 | Ordinarily, a change you commit should contain a log entry in its | 174 | Ordinarily, a changeset you commit should contain a description of the |
| 174 | commit message and should not touch the repository's ChangeLog files. | 175 | changes in its commit message and should not touch the repository's |
| 175 | Here is an example commit message (indented): | 176 | ChangeLog files. Here is an example commit message (indented): |
| 176 | 177 | ||
| 177 | Deactivate shifted region | 178 | Deactivate shifted region |
| 178 | 179 | ||
| @@ -184,8 +185,9 @@ Here is an example commit message (indented): | |||
| 184 | Deactivate the mark. | 185 | Deactivate the mark. |
| 185 | 186 | ||
| 186 | Occasionally, commit messages are collected and prepended to a | 187 | Occasionally, commit messages are collected and prepended to a |
| 187 | ChangeLog file, where they can be corrected. It saves time to get | 188 | generated ChangeLog file, where they can be corrected. It saves time |
| 188 | them right the first time, so here are guidelines for formatting them: | 189 | to get them right the first time, so here are guidelines for |
| 190 | formatting them: | ||
| 189 | 191 | ||
| 190 | - Start with a single unindented summary line explaining the change; | 192 | - Start with a single unindented summary line explaining the change; |
| 191 | do not end this line with a period. If possible, try to keep the | 193 | do not end this line with a period. If possible, try to keep the |
| @@ -194,9 +196,10 @@ them right the first time, so here are guidelines for formatting them: | |||
| 194 | contexts. | 196 | contexts. |
| 195 | 197 | ||
| 196 | If the summary line starts with a semicolon and a space "; ", the | 198 | If the summary line starts with a semicolon and a space "; ", the |
| 197 | commit message will be ignored when generating the ChangeLog file. | 199 | commit message will be skipped and not added to the generated |
| 198 | Use this for minor commits that do not need separate ChangeLog | 200 | ChangeLog file. Use this for minor commits that do not need to be |
| 199 | entries, such as changes in etc/NEWS. | 201 | mentioned in the ChangeLog file, such as changes in etc/NEWS, typo |
| 202 | fixes, etc. | ||
| 200 | 203 | ||
| 201 | - After the summary line, there should be an empty line. | 204 | - After the summary line, there should be an empty line. |
| 202 | 205 | ||
| @@ -211,8 +214,9 @@ them right the first time, so here are guidelines for formatting them: | |||
| 211 | enforced by a commit hook. | 214 | enforced by a commit hook. |
| 212 | 215 | ||
| 213 | - If only a single file is changed, the summary line can be the normal | 216 | - If only a single file is changed, the summary line can be the normal |
| 214 | file first line (starting with the asterisk). Then there is no | 217 | first line of a ChangeLog entry (starting with the asterisk). Then |
| 215 | individual files section. | 218 | there will be no individual ChangeLog entries beyond the one in the |
| 219 | summary line. | ||
| 216 | 220 | ||
| 217 | - If the commit has more than one author, the commit message should | 221 | - If the commit has more than one author, the commit message should |
| 218 | contain separate lines to mention the other authors, like the | 222 | contain separate lines to mention the other authors, like the |
| @@ -243,12 +247,12 @@ them right the first time, so here are guidelines for formatting them: | |||
| 243 | - Explaining the rationale for a design choice is best done in comments | 247 | - Explaining the rationale for a design choice is best done in comments |
| 244 | in the source code. However, sometimes it is useful to describe just | 248 | in the source code. However, sometimes it is useful to describe just |
| 245 | the rationale for a change; that can be done in the commit message | 249 | the rationale for a change; that can be done in the commit message |
| 246 | between the summary line and the file entries. | 250 | between the summary line and the following ChangeLog entries. |
| 247 | 251 | ||
| 248 | - Emacs generally follows the GNU coding standards for ChangeLogs: see | 252 | - Emacs follows the GNU coding standards for ChangeLog entries: see |
| 249 | https://www.gnu.org/prep/standards/html_node/Change-Logs.html | 253 | https://www.gnu.org/prep/standards/html_node/Change-Logs.html or run |
| 250 | or run 'info "(standards)Change Logs"'. One exception is that | 254 | 'info "(standards)Change Logs"'. One exception is that commits |
| 251 | commits still sometimes quote `like-this' (as the standards used to | 255 | still sometimes quote `like-this' (as the standards used to |
| 252 | recommend) rather than 'like-this' or ‘like this’ (as they do now), | 256 | recommend) rather than 'like-this' or ‘like this’ (as they do now), |
| 253 | as `...' is so widely used elsewhere in Emacs. | 257 | as `...' is so widely used elsewhere in Emacs. |
| 254 | 258 | ||
| @@ -261,9 +265,9 @@ them right the first time, so here are guidelines for formatting them: | |||
| 261 | in Emacs; that includes spelling and leaving 2 blanks between | 265 | in Emacs; that includes spelling and leaving 2 blanks between |
| 262 | sentences. | 266 | sentences. |
| 263 | 267 | ||
| 264 | They are preserved indefinitely, and have a reasonable chance of | 268 | The ChangeLog entries are preserved indefinitely, and have a |
| 265 | being read in the future, so it's better that they have good | 269 | reasonable chance of being read in the future, so it's better that |
| 266 | presentation. | 270 | they have good presentation. |
| 267 | 271 | ||
| 268 | - Use the present tense; describe "what the change does", not "what | 272 | - Use the present tense; describe "what the change does", not "what |
| 269 | the change did". | 273 | the change did". |
diff --git a/ChangeLog.3 b/ChangeLog.3 index dc712df43ad..7db4986410d 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 | |||
| @@ -137530,7 +137530,7 @@ | |||
| 137530 | Bind `enable-local-variables' in `hack-connection-local-variables' | 137530 | Bind `enable-local-variables' in `hack-connection-local-variables' |
| 137531 | 137531 | ||
| 137532 | * lisp/files-x.el (hack-connection-local-variables): | 137532 | * lisp/files-x.el (hack-connection-local-variables): |
| 137533 | Bind `enable-local-variables', instead of re-declaring | 137533 | Bind `enable-local-variables', instead of redeclaring |
| 137534 | `safe-local-variable-p'. | 137534 | `safe-local-variable-p'. |
| 137535 | 137535 | ||
| 137536 | 2019-03-23 Eli Zaretskii <eliz@gnu.org> | 137536 | 2019-03-23 Eli Zaretskii <eliz@gnu.org> |
| @@ -163179,7 +163179,7 @@ | |||
| 163179 | 163179 | ||
| 163180 | Quieten compilation of octave.el | 163180 | Quieten compilation of octave.el |
| 163181 | 163181 | ||
| 163182 | * lisp/progmodes/octave.el (compilation-forget-errors): Re-declare. | 163182 | * lisp/progmodes/octave.el (compilation-forget-errors): Redeclare. |
| 163183 | 163183 | ||
| 163184 | 2018-02-28 Glenn Morris <rgm@gnu.org> | 163184 | 2018-02-28 Glenn Morris <rgm@gnu.org> |
| 163185 | 163185 | ||
diff --git a/GNUmakefile b/GNUmakefile index 16064672c65..58c0281e895 100644 --- a/GNUmakefile +++ b/GNUmakefile | |||
| @@ -27,6 +27,8 @@ | |||
| 27 | # newly-built Makefile. If the source tree is already configured, | 27 | # newly-built Makefile. If the source tree is already configured, |
| 28 | # this file defers to the existing Makefile. | 28 | # this file defers to the existing Makefile. |
| 29 | 29 | ||
| 30 | . := | ||
| 31 | |||
| 30 | # If you want non-default build options, or if you want to build in an | 32 | # If you want non-default build options, or if you want to build in an |
| 31 | # out-of-source tree, you should run 'configure' before running 'make'. | 33 | # out-of-source tree, you should run 'configure' before running 'make'. |
| 32 | # But run 'autogen.sh' first, if the source was checked out directly | 34 | # But run 'autogen.sh' first, if the source was checked out directly |
| @@ -36,30 +38,30 @@ | |||
| 36 | 38 | ||
| 37 | ifeq (help,$(filter help,$(MAKECMDGOALS))) | 39 | ifeq (help,$(filter help,$(MAKECMDGOALS))) |
| 38 | help: | 40 | help: |
| 39 | $(info $ NOTE: This is a brief summary of some common make targets.) | 41 | $(info $.NOTE: This is a brief summary of some common make targets.) |
| 40 | $(info $ For more detailed information, please read the files INSTALL,) | 42 | $(info $.For more detailed information, please read the files INSTALL,) |
| 41 | $(info $ INSTALL.REPO, Makefile or visit this URL:) | 43 | $(info $.INSTALL.REPO, Makefile or visit this URL:) |
| 42 | $(info $ https://www.gnu.org/prep/standards/html_node/Standard-Targets.html) | 44 | $(info $.https://www.gnu.org/prep/standards/html_node/Standard-Targets.html) |
| 43 | $(info $ ) | 45 | $(info $.) |
| 44 | $(info $ make all -- compile and build Emacs) | 46 | $(info $.make all -- compile and build Emacs) |
| 45 | $(info $ make install -- install Emacs) | 47 | $(info $.make install -- install Emacs) |
| 46 | $(info $ make TAGS -- update tags tables) | 48 | $(info $.make TAGS -- update tags tables) |
| 47 | $(info $ make clean -- delete built files but preserve configuration) | 49 | $(info $.make clean -- delete built files but preserve configuration) |
| 48 | $(info $ make mostlyclean -- like 'make clean', but leave those files that) | 50 | $(info $.make mostlyclean -- like 'make clean', but leave those files that) |
| 49 | $(info $ usually do not need to be recompiled) | 51 | $(info $. usually do not need to be recompiled) |
| 50 | $(info $ make distclean -- delete all build and configuration files,) | 52 | $(info $.make distclean -- delete all build and configuration files,) |
| 51 | $(info $ leave only files included in source distribution) | 53 | $(info $. leave only files included in source distribution) |
| 52 | $(info $ make maintainer-clean -- delete almost everything that can be regenerated) | 54 | $(info $.make maintainer-clean -- delete almost everything that can be regenerated) |
| 53 | $(info $ make extraclean -- like maintainer-clean, and also delete) | 55 | $(info $.make extraclean -- like maintainer-clean, and also delete) |
| 54 | $(info $ backup and autosave files) | 56 | $(info $. backup and autosave files) |
| 55 | $(info $ make bootstrap -- delete all compiled files to force a new bootstrap) | 57 | $(info $.make bootstrap -- delete all compiled files to force a new bootstrap) |
| 56 | $(info $ from a clean slate, then build in the normal way) | 58 | $(info $. from a clean slate, then build in the normal way) |
| 57 | $(info $ make uninstall -- remove files installed by 'make install') | 59 | $(info $.make uninstall -- remove files installed by 'make install') |
| 58 | $(info $ make check -- run the Emacs test suite) | 60 | $(info $.make check -- run the Emacs test suite) |
| 59 | $(info $ make docs -- generate Emacs documentation in info format) | 61 | $(info $.make docs -- generate Emacs documentation in info format) |
| 60 | $(info $ make html -- generate documentation in html format) | 62 | $(info $.make html -- generate documentation in html format) |
| 61 | $(info $ make ps -- generate documentation in ps format) | 63 | $(info $.make ps -- generate documentation in ps format) |
| 62 | $(info $ make pdf -- generate documentation in pdf format ) | 64 | $(info $.make pdf -- generate documentation in pdf format ) |
| 63 | @: | 65 | @: |
| 64 | 66 | ||
| 65 | .PHONY: help | 67 | .PHONY: help |
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 06986ec8f48..c07fdc487ee 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES | |||
| @@ -25,6 +25,9 @@ SOLARIS2 | |||
| 25 | USG | 25 | USG |
| 26 | USG5_4 | 26 | USG5_4 |
| 27 | HAIKU Compiling on Haiku. | 27 | HAIKU Compiling on Haiku. |
| 28 | __ANDROID__ Compiling for the Android operating system. | ||
| 29 | __ANDROID_API__ A numerical "API level" indicating the version of | ||
| 30 | Android being compiled for; see http://apilevels.com. | ||
| 28 | 31 | ||
| 29 | ** Distinguishing GUIs ** | 32 | ** Distinguishing GUIs ** |
| 30 | 33 | ||
| @@ -35,10 +38,14 @@ NS_IMPL_COCOA Compile support for Cocoa (Apple) implementation of NS GUI API. | |||
| 35 | HAVE_X11 Compile support for the X11 GUI. | 38 | HAVE_X11 Compile support for the X11 GUI. |
| 36 | HAVE_PGTK Compile support for using GTK itself without directly using X Windows APIs. | 39 | HAVE_PGTK Compile support for using GTK itself without directly using X Windows APIs. |
| 37 | HAVE_HAIKU Compile support for the Haiku window system. | 40 | HAVE_HAIKU Compile support for the Haiku window system. |
| 38 | HAVE_X_WINDOWS Compile support for X Window system | 41 | HAVE_X_WINDOWS Compile support for X Window system. Equivalent to HAVE_X11. |
| 39 | (It looks like, nowadays, if HAVE_X11 is set, HAVE_X_WINDOWS must | 42 | HAVE_ANDROID Compiling the Android GUI interface. Enough of this |
| 40 | be, and vice versa. At least, this is true for configure, and | 43 | code is compiled for the build machine cross-compiling |
| 41 | msdos; not sure about nt.) | 44 | the Android port to produce an Emacs binary that can |
| 45 | run Lisp code in batch mode, for the purpose of running | ||
| 46 | the byte-compiler. | ||
| 47 | ANDROID_STUBIFY The Android GUI interface is being compiled for the build | ||
| 48 | machine, as above. | ||
| 42 | 49 | ||
| 43 | ** X Windows features ** | 50 | ** X Windows features ** |
| 44 | HAVE_X11R6 Whether or not the system has X11R6. (Always defined.) | 51 | HAVE_X11R6 Whether or not the system has X11R6. (Always defined.) |
diff --git a/admin/authors.el b/admin/authors.el index 6c74f4dd7a1..8ea6064423f 100644 --- a/admin/authors.el +++ b/admin/authors.el | |||
| @@ -175,6 +175,9 @@ files.") | |||
| 175 | ("Michalis V" "^mvar") | 175 | ("Michalis V" "^mvar") |
| 176 | ("Miha Rihtaršič" "Miha Rihtarsic") | 176 | ("Miha Rihtaršič" "Miha Rihtarsic") |
| 177 | ("Mikio Nakajima" "Nakajima Mikio") | 177 | ("Mikio Nakajima" "Nakajima Mikio") |
| 178 | (nil "montag451@laposte\\.net") | ||
| 179 | (nil "na@aisrntairetnraoitn") | ||
| 180 | ("Morgan Smith" "Morgan J\\. Smith") | ||
| 178 | ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira") | 181 | ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira") |
| 179 | ("Noah Peart" "noah\\.v\\.peart@gmail\\.com") | 182 | ("Noah Peart" "noah\\.v\\.peart@gmail\\.com") |
| 180 | ("Noorul Islam" "Noorul Islam K M") | 183 | ("Noorul Islam" "Noorul Islam K M") |
diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude index 416d79cf131..6413a73701b 100644 --- a/admin/codespell/codespell.exclude +++ b/admin/codespell/codespell.exclude | |||
| @@ -1583,3 +1583,5 @@ VERY VERY LONG STRIN | VERY VERY LONG STRIN | |||
| 1583 | (ert-info ("Joined by bouncer to #chan@foonet, pal persent") | 1583 | (ert-info ("Joined by bouncer to #chan@foonet, pal persent") |
| 1584 | (ert-info ("Joined by bouncer to #chan@barnet, pal persent") | 1584 | (ert-info ("Joined by bouncer to #chan@barnet, pal persent") |
| 1585 | .UE . | 1585 | .UE . |
| 1586 | (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.") | ||
| 1587 | (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.") | ||
diff --git a/admin/gitmerge.el b/admin/gitmerge.el index 7c815c729e5..32d5c3c1bea 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el | |||
| @@ -111,10 +111,10 @@ If nil, the function `gitmerge-default-branch' guesses.") | |||
| 111 | 111 | ||
| 112 | (defvar gitmerge-mode-font-lock-keywords | 112 | (defvar gitmerge-mode-font-lock-keywords |
| 113 | `((,gitmerge-log-regexp | 113 | `((,gitmerge-log-regexp |
| 114 | (1 font-lock-warning-face) | 114 | (1 'font-lock-warning-face) |
| 115 | (2 font-lock-constant-face) | 115 | (2 'font-lock-constant-face) |
| 116 | (3 font-lock-builtin-face) | 116 | (3 'font-lock-builtin-face) |
| 117 | (4 font-lock-comment-face)))) | 117 | (4 'font-lock-comment-face)))) |
| 118 | 118 | ||
| 119 | (defvar gitmerge--commits nil) | 119 | (defvar gitmerge--commits nil) |
| 120 | (defvar gitmerge--from nil) | 120 | (defvar gitmerge--from nil) |
diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 5246fb14e1e..41531d573b0 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib | |||
| @@ -53,7 +53,7 @@ GNULIB_MODULES=' | |||
| 53 | 53 | ||
| 54 | AVOIDED_MODULES=' | 54 | AVOIDED_MODULES=' |
| 55 | access btowc chmod close crypto/af_alg dup fchdir fstat | 55 | access btowc chmod close crypto/af_alg dup fchdir fstat |
| 56 | iswblank iswctype iswdigit iswxdigit langinfo lock | 56 | iswblank iswctype iswdigit iswxdigit langinfo localename-unsafe-limited lock |
| 57 | mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo | 57 | mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo |
| 58 | openat-die opendir pthread-h raise | 58 | openat-die opendir pthread-h raise |
| 59 | save-cwd select setenv sigprocmask stat stdarg | 59 | save-cwd select setenv sigprocmask stat stdarg |
diff --git a/admin/notes/kind-communication b/admin/notes/kind-communication new file mode 100644 index 00000000000..80b2afb27b2 --- /dev/null +++ b/admin/notes/kind-communication | |||
| @@ -0,0 +1,21 @@ | |||
| 1 | The GNU Project encourages contributions from anyone who wishes to | ||
| 2 | advance the development of the GNU system, regardless of gender, race, | ||
| 3 | ethnic group, physical appearance, religion, cultural background, and | ||
| 4 | any other demographic characteristics, as well as personal political | ||
| 5 | views. | ||
| 6 | |||
| 7 | People are sometimes discouraged from participating in GNU development | ||
| 8 | because of certain patterns of communication that strike them as | ||
| 9 | unfriendly, unwelcoming, rejecting, or harsh. This discouragement | ||
| 10 | particularly affects members of disprivileged demographics, but it is | ||
| 11 | not limited to them. Therefore, we ask all contributors to make a | ||
| 12 | conscious effort, in GNU Project discussions, to communicate in ways | ||
| 13 | that avoid that outcome — to avoid practices that will predictably and | ||
| 14 | unnecessarily risk putting some contributors off. | ||
| 15 | |||
| 16 | The GNU Kind Communications Guidelines suggest specific ways to | ||
| 17 | accomplish that goal. You can find the latest version at | ||
| 18 | https://www.gnu.org/philosophy/kind-communication.html | ||
| 19 | |||
| 20 | When sending messages to Emacs mailing lists, we ask you to read and | ||
| 21 | respect these guidelines. | ||
diff --git a/admin/notes/tree-sitter/build-module/build.sh b/admin/notes/tree-sitter/build-module/build.sh index 969187b7f92..9a567bb094d 100755 --- a/admin/notes/tree-sitter/build-module/build.sh +++ b/admin/notes/tree-sitter/build-module/build.sh | |||
| @@ -43,7 +43,7 @@ case "${lang}" in | |||
| 43 | org="phoenixframework" | 43 | org="phoenixframework" |
| 44 | ;; | 44 | ;; |
| 45 | "lua") | 45 | "lua") |
| 46 | org="MunifTanjim" | 46 | org="tree-sitter-grammars" |
| 47 | ;; | 47 | ;; |
| 48 | "typescript") | 48 | "typescript") |
| 49 | sourcedir="tree-sitter-typescript/typescript/src" | 49 | sourcedir="tree-sitter-typescript/typescript/src" |
diff --git a/configure.ac b/configure.ac index fa8b04ec685..452aa0838f1 100644 --- a/configure.ac +++ b/configure.ac | |||
| @@ -1231,6 +1231,7 @@ package will likely install on older systems but crash on startup.]) | |||
| 1231 | passthrough="$passthrough --with-mailutils=$with_mailutils" | 1231 | passthrough="$passthrough --with-mailutils=$with_mailutils" |
| 1232 | passthrough="$passthrough --with-pop=$with_pop" | 1232 | passthrough="$passthrough --with-pop=$with_pop" |
| 1233 | passthrough="$passthrough --with-harfbuzz=$with_harfbuzz" | 1233 | passthrough="$passthrough --with-harfbuzz=$with_harfbuzz" |
| 1234 | passthrough="$passthrough --with-threads=$with_threads" | ||
| 1234 | 1235 | ||
| 1235 | # Now pass through some checking options. | 1236 | # Now pass through some checking options. |
| 1236 | emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type" | 1237 | emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type" |
| @@ -1321,6 +1322,7 @@ if test "$ANDROID" = "yes"; then | |||
| 1321 | with_pop=no | 1322 | with_pop=no |
| 1322 | with_harfbuzz=no | 1323 | with_harfbuzz=no |
| 1323 | with_native_compilation=no | 1324 | with_native_compilation=no |
| 1325 | with_threads=no | ||
| 1324 | fi | 1326 | fi |
| 1325 | 1327 | ||
| 1326 | with_rsvg=no | 1328 | with_rsvg=no |
| @@ -1331,7 +1333,6 @@ if test "$ANDROID" = "yes"; then | |||
| 1331 | with_gpm=no | 1333 | with_gpm=no |
| 1332 | with_dbus=no | 1334 | with_dbus=no |
| 1333 | with_gsettings=no | 1335 | with_gsettings=no |
| 1334 | with_threads=no | ||
| 1335 | with_ns=no | 1336 | with_ns=no |
| 1336 | 1337 | ||
| 1337 | # zlib is available in android. | 1338 | # zlib is available in android. |
| @@ -2336,6 +2337,7 @@ fi | |||
| 2336 | AC_DEFUN([AC_TYPE_SIZE_T]) | 2337 | AC_DEFUN([AC_TYPE_SIZE_T]) |
| 2337 | # Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them. | 2338 | # Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them. |
| 2338 | AC_DEFUN([AC_TYPE_UID_T]) | 2339 | AC_DEFUN([AC_TYPE_UID_T]) |
| 2340 | ac_cv_type_gid_t=yes # AC_TYPE_GETGROUPS needs this in Autoconf 2.72. | ||
| 2339 | 2341 | ||
| 2340 | # Check for all math.h functions that Emacs uses; on some platforms, | 2342 | # Check for all math.h functions that Emacs uses; on some platforms, |
| 2341 | # -lm is needed for some of these functions. | 2343 | # -lm is needed for some of these functions. |
| @@ -4086,16 +4088,16 @@ case $with_file_notification,$opsys in | |||
| 4086 | fi ;; | 4088 | fi ;; |
| 4087 | esac | 4089 | esac |
| 4088 | 4090 | ||
| 4089 | dnl inotify is available only on GNU/Linux. | 4091 | dnl inotify is available only on Linux-kernel based systems. |
| 4090 | case $with_file_notification,$NOTIFY_OBJ in | 4092 | case $with_file_notification,$NOTIFY_OBJ in |
| 4091 | inotify, | yes,) | 4093 | inotify, | yes,) |
| 4092 | AC_CHECK_HEADER([sys/inotify.h]) | 4094 | AC_CHECK_HEADER([sys/inotify.h]) |
| 4093 | if test "$ac_cv_header_sys_inotify_h" = yes ; then | 4095 | if test "$ac_cv_header_sys_inotify_h" = yes ; then |
| 4094 | AC_CHECK_FUNC([inotify_init1]) | 4096 | AC_CHECK_FUNCS([inotify_init inotify_init1]) |
| 4095 | if test "$ac_cv_func_inotify_init1" = yes; then | 4097 | if test "$ac_cv_func_inotify_init" = yes; then |
| 4096 | AC_DEFINE([HAVE_INOTIFY], [1], [Define to 1 to use inotify.]) | 4098 | AC_DEFINE([HAVE_INOTIFY], [1], [Define to 1 to use inotify.]) |
| 4097 | NOTIFY_OBJ=inotify.o | 4099 | NOTIFY_OBJ=inotify.o |
| 4098 | NOTIFY_SUMMARY="yes -lglibc (inotify)" | 4100 | NOTIFY_SUMMARY="yes (inotify)" |
| 4099 | fi | 4101 | fi |
| 4100 | fi ;; | 4102 | fi ;; |
| 4101 | esac | 4103 | esac |
| @@ -5905,13 +5907,15 @@ pthread_sigmask strsignal setitimer \ | |||
| 5905 | sendto recvfrom getsockname getifaddrs freeifaddrs \ | 5907 | sendto recvfrom getsockname getifaddrs freeifaddrs \ |
| 5906 | gai_strerror sync \ | 5908 | gai_strerror sync \ |
| 5907 | endpwent getgrent endgrent \ | 5909 | endpwent getgrent endgrent \ |
| 5908 | renameat2 \ | ||
| 5909 | cfmakeraw cfsetspeed __executable_start log2 pthread_setname_np \ | 5910 | cfmakeraw cfsetspeed __executable_start log2 pthread_setname_np \ |
| 5910 | pthread_set_name_np]) | 5911 | pthread_set_name_np]) |
| 5911 | 5912 | ||
| 5912 | # getpwent is not present in older versions of Android. (bug#65319) | 5913 | # getpwent is not present in older versions of Android. (bug#65319) |
| 5913 | gl_CHECK_FUNCS_ANDROID([getpwent], [[#include <pwd.h>]]) | 5914 | gl_CHECK_FUNCS_ANDROID([getpwent], [[#include <pwd.h>]]) |
| 5914 | 5915 | ||
| 5916 | # renameat2 is not present in older versions of Android. | ||
| 5917 | gl_CHECK_FUNCS_ANDROID([renameat2], [[#include <stdio.h>]]) | ||
| 5918 | |||
| 5915 | if test "$ac_cv_func_cfmakeraw" != "yes"; then | 5919 | if test "$ac_cv_func_cfmakeraw" != "yes"; then |
| 5916 | # On some systems (Android), cfmakeraw is inline, so AC_CHECK_FUNCS | 5920 | # On some systems (Android), cfmakeraw is inline, so AC_CHECK_FUNCS |
| 5917 | # cannot find it. Check if some code including termios.h and using | 5921 | # cannot find it. Check if some code including termios.h and using |
diff --git a/cross/verbose.mk.android b/cross/verbose.mk.android index 958cf237c58..7b9af76404b 100644 --- a/cross/verbose.mk.android +++ b/cross/verbose.mk.android | |||
| @@ -44,12 +44,13 @@ have_working_info = $(filter notintermediate,$(value .FEATURES)) | |||
| 44 | # The workaround is done only for AM_V_ELC and AM_V_ELN, | 44 | # The workaround is done only for AM_V_ELC and AM_V_ELN, |
| 45 | # since the bug is not annoying elsewhere. | 45 | # since the bug is not annoying elsewhere. |
| 46 | 46 | ||
| 47 | AM_V_AR = @$(info $ AR $@) | 47 | . := |
| 48 | AM_V_AR = @$(info $. AR $@) | ||
| 48 | AM_V_at = @ | 49 | AM_V_at = @ |
| 49 | AM_V_CC = @$(info $ CC $@) | 50 | AM_V_CC = @$(info $. CC $@) |
| 50 | AM_V_CXX = @$(info $ CXX $@) | 51 | AM_V_CXX = @$(info $. CXX $@) |
| 51 | AM_V_CCLD = @$(info $ CCLD $@) | 52 | AM_V_CCLD = @$(info $. CCLD $@) |
| 52 | AM_V_CXXLD = @$(info $ CXXLD $@) | 53 | AM_V_CXXLD = @$(info $. CXXLD $@) |
| 53 | AM_V_GEN = @$(info $ GEN $@) | 54 | AM_V_GEN = @$(info $. GEN $@) |
| 54 | AM_V_NO_PD = --no-print-directory | 55 | AM_V_NO_PD = --no-print-directory |
| 55 | endif | 56 | endif |
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index cdc183c2a40..b1b1573729a 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi | |||
| @@ -632,15 +632,18 @@ long, by using Auto Fill mode. @xref{Filling}. | |||
| 632 | 632 | ||
| 633 | @cindex continuation lines, visual wrap prefix | 633 | @cindex continuation lines, visual wrap prefix |
| 634 | @findex visual-wrap-prefix-mode | 634 | @findex visual-wrap-prefix-mode |
| 635 | @findex global-visual-wrap-prefix-mode | ||
| 635 | Normally, the first character of each continuation line is | 636 | Normally, the first character of each continuation line is |
| 636 | positioned at the beginning of the screen line where it is displayed. | 637 | positioned at the beginning of the screen line where it is displayed. |
| 637 | The minor mode @code{visual-wrap-prefix-mode} arranges that | 638 | The minor mode @code{visual-wrap-prefix-mode} and its global |
| 638 | continuation lines be prefixed by slightly adjusted versions of the | 639 | (@pxref{Minor Modes}) counterpart |
| 639 | fill prefixes (@pxref{Fill Prefix}) of their respective logical lines, | 640 | @code{global-visual-wrap-prefix-mode} arranges that continuation lines |
| 640 | so that indentation characters or the prefixes of source code comments | 641 | be prefixed by slightly adjusted versions of the fill prefixes |
| 641 | are replicated across every continuation line, and the appearance of | 642 | (@pxref{Fill Prefix}) of their respective logical lines, so that |
| 642 | such comments or indentation is not broken. These prefixes are only | 643 | indentation characters or the prefixes of source code comments are |
| 643 | shown on display, and does not change the buffer text in any way. | 644 | replicated across every continuation line, and the appearance of such |
| 645 | comments or indentation is not broken. These prefixes are only shown | ||
| 646 | on display, and does not change the buffer text in any way. | ||
| 644 | 647 | ||
| 645 | Sometimes, you may need to edit files containing many long logical | 648 | Sometimes, you may need to edit files containing many long logical |
| 646 | lines, and it may not be practical to break them all up by adding | 649 | lines, and it may not be practical to break them all up by adding |
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index d9113a6811a..00160afd844 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi | |||
| @@ -205,7 +205,7 @@ Here is an example of a buffer list: | |||
| 205 | 205 | ||
| 206 | @smallexample | 206 | @smallexample |
| 207 | CRM Buffer Size Mode File | 207 | CRM Buffer Size Mode File |
| 208 | . * .emacs 3294 Emacs-Lisp ~/.emacs | 208 | . * .emacs 3294 ELisp/l ~/.emacs |
| 209 | % *Help* 101 Help | 209 | % *Help* 101 Help |
| 210 | search.c 86055 C ~/cvs/emacs/src/search.c | 210 | search.c 86055 C ~/cvs/emacs/src/search.c |
| 211 | % src 20959 Dired by name ~/cvs/emacs/src/ | 211 | % src 20959 Dired by name ~/cvs/emacs/src/ |
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 6db9e8344c6..bda57d2b30e 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi | |||
| @@ -2210,6 +2210,14 @@ keys; its value is the number of seconds of pause required to cause echoing | |||
| 2210 | to start, or zero, meaning don't echo at all. The value takes effect when | 2210 | to start, or zero, meaning don't echo at all. The value takes effect when |
| 2211 | there is something to echo. @xref{Echo Area}. | 2211 | there is something to echo. @xref{Echo Area}. |
| 2212 | 2212 | ||
| 2213 | @vindex echo-keystrokes-help | ||
| 2214 | If the variable @code{echo-keystrokes-help} is non-@code{nil} (the | ||
| 2215 | default), the multi-character key sequence echo shown according to | ||
| 2216 | @code{echo-keystrokes} will include a short help text about keys which | ||
| 2217 | will invoke @code{describe-prefix-bindings} (@pxref{Misc Help}) to show | ||
| 2218 | the list of commands for the prefix you already typed. For a related | ||
| 2219 | help facility, see @ref{which-key}. | ||
| 2220 | |||
| 2213 | @cindex mouse pointer | 2221 | @cindex mouse pointer |
| 2214 | @cindex hourglass pointer display | 2222 | @cindex hourglass pointer display |
| 2215 | @vindex display-hourglass | 2223 | @vindex display-hourglass |
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 99a4173ac29..05457a3f34f 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi | |||
| @@ -260,6 +260,11 @@ by these buttons, Emacs provides the @code{button-describe} and | |||
| 260 | @code{widget-describe} commands, that should be run with point over | 260 | @code{widget-describe} commands, that should be run with point over |
| 261 | the button. | 261 | the button. |
| 262 | 262 | ||
| 263 | @anchor{which-key} | ||
| 264 | @kbd{M-x which-key} is a global minor mode which helps in discovering | ||
| 265 | keymaps. It displays keybindings following your currently entered | ||
| 266 | incomplete command (prefix), in a popup. | ||
| 267 | |||
| 263 | @node Name Help | 268 | @node Name Help |
| 264 | @section Help by Command or Variable Name | 269 | @section Help by Command or Variable Name |
| 265 | 270 | ||
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 338bf014208..cb347d59948 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi | |||
| @@ -1097,6 +1097,12 @@ so that Outline mode will know that sections are contained in | |||
| 1097 | chapters. This works as long as no other command starts with | 1097 | chapters. This works as long as no other command starts with |
| 1098 | @samp{@@chap}. | 1098 | @samp{@@chap}. |
| 1099 | 1099 | ||
| 1100 | @vindex outline-search-function | ||
| 1101 | Instead of setting the variable @code{outline-regexp}, you can set | ||
| 1102 | the variable @code{outline-search-function} to a function that | ||
| 1103 | matches the current heading and searches for the next one | ||
| 1104 | (@pxref{Outline Minor Mode,,,elisp, the Emacs Lisp Reference Manual}). | ||
| 1105 | |||
| 1100 | @vindex outline-level | 1106 | @vindex outline-level |
| 1101 | You can explicitly specify a rule for calculating the level of a | 1107 | You can explicitly specify a rule for calculating the level of a |
| 1102 | heading line by setting the variable @code{outline-level}. The value | 1108 | heading line by setting the variable @code{outline-level}. The value |
diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi index 9b719145584..d89cec4bc2b 100644 --- a/doc/lispref/abbrevs.texi +++ b/doc/lispref/abbrevs.texi | |||
| @@ -65,7 +65,7 @@ expanded in the buffer. For the user-level commands for abbrevs, see | |||
| 65 | 65 | ||
| 66 | @defun make-abbrev-table &optional props | 66 | @defun make-abbrev-table &optional props |
| 67 | This function creates and returns a new, empty abbrev table---an | 67 | This function creates and returns a new, empty abbrev table---an |
| 68 | obarray containing no symbols. It is a vector filled with zeros. | 68 | obarray containing no symbols. |
| 69 | @var{props} is a property list that is applied to the new table | 69 | @var{props} is a property list that is applied to the new table |
| 70 | (@pxref{Abbrev Table Properties}). | 70 | (@pxref{Abbrev Table Properties}). |
| 71 | @end defun | 71 | @end defun |
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index 98a01fb67f9..00602198da5 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi | |||
| @@ -35,7 +35,6 @@ variable binding for @code{no-byte-compile} into it, like this: | |||
| 35 | * Speed of Byte-Code:: An example of speedup from byte compilation. | 35 | * Speed of Byte-Code:: An example of speedup from byte compilation. |
| 36 | * Compilation Functions:: Byte compilation functions. | 36 | * Compilation Functions:: Byte compilation functions. |
| 37 | * Docs and Compilation:: Dynamic loading of documentation strings. | 37 | * Docs and Compilation:: Dynamic loading of documentation strings. |
| 38 | * Dynamic Loading:: Dynamic loading of individual functions. | ||
| 39 | * Eval During Compile:: Code to be evaluated when you compile. | 38 | * Eval During Compile:: Code to be evaluated when you compile. |
| 40 | * Compiler Errors:: Handling compiler error messages. | 39 | * Compiler Errors:: Handling compiler error messages. |
| 41 | * Byte-Code Objects:: The data type used for byte-compiled functions. | 40 | * Byte-Code Objects:: The data type used for byte-compiled functions. |
| @@ -289,71 +288,6 @@ stands for the name of this file, as a string. Do not use these | |||
| 289 | constructs in Lisp source files; they are not designed to be clear to | 288 | constructs in Lisp source files; they are not designed to be clear to |
| 290 | humans reading the file. | 289 | humans reading the file. |
| 291 | 290 | ||
| 292 | @node Dynamic Loading | ||
| 293 | @section Dynamic Loading of Individual Functions | ||
| 294 | |||
| 295 | @cindex dynamic loading of functions | ||
| 296 | @cindex lazy loading | ||
| 297 | When you compile a file, you can optionally enable the @dfn{dynamic | ||
| 298 | function loading} feature (also known as @dfn{lazy loading}). With | ||
| 299 | dynamic function loading, loading the file doesn't fully read the | ||
| 300 | function definitions in the file. Instead, each function definition | ||
| 301 | contains a place-holder which refers to the file. The first time each | ||
| 302 | function is called, it reads the full definition from the file, to | ||
| 303 | replace the place-holder. | ||
| 304 | |||
| 305 | The advantage of dynamic function loading is that loading the file | ||
| 306 | should become faster. This is a good thing for a file which contains | ||
| 307 | many separate user-callable functions, if using one of them does not | ||
| 308 | imply you will probably also use the rest. A specialized mode which | ||
| 309 | provides many keyboard commands often has that usage pattern: a user may | ||
| 310 | invoke the mode, but use only a few of the commands it provides. | ||
| 311 | |||
| 312 | The dynamic loading feature has certain disadvantages: | ||
| 313 | |||
| 314 | @itemize @bullet | ||
| 315 | @item | ||
| 316 | If you delete or move the compiled file after loading it, Emacs can no | ||
| 317 | longer load the remaining function definitions not already loaded. | ||
| 318 | |||
| 319 | @item | ||
| 320 | If you alter the compiled file (such as by compiling a new version), | ||
| 321 | then trying to load any function not already loaded will usually yield | ||
| 322 | nonsense results. | ||
| 323 | @end itemize | ||
| 324 | |||
| 325 | These problems will never happen in normal circumstances with | ||
| 326 | installed Emacs files. But they are quite likely to happen with Lisp | ||
| 327 | files that you are changing. The easiest way to prevent these problems | ||
| 328 | is to reload the new compiled file immediately after each recompilation. | ||
| 329 | |||
| 330 | @emph{Experience shows that using dynamic function loading provides | ||
| 331 | benefits that are hardly measurable, so this feature is deprecated | ||
| 332 | since Emacs 27.1.} | ||
| 333 | |||
| 334 | The byte compiler uses the dynamic function loading feature if the | ||
| 335 | variable @code{byte-compile-dynamic} is non-@code{nil} at compilation | ||
| 336 | time. Do not set this variable globally, since dynamic loading is | ||
| 337 | desirable only for certain files. Instead, enable the feature for | ||
| 338 | specific source files with file-local variable bindings. For example, | ||
| 339 | you could do it by writing this text in the source file's first line: | ||
| 340 | |||
| 341 | @example | ||
| 342 | -*-byte-compile-dynamic: t;-*- | ||
| 343 | @end example | ||
| 344 | |||
| 345 | @defvar byte-compile-dynamic | ||
| 346 | If this is non-@code{nil}, the byte compiler generates compiled files | ||
| 347 | that are set up for dynamic function loading. | ||
| 348 | @end defvar | ||
| 349 | |||
| 350 | @defun fetch-bytecode function | ||
| 351 | If @var{function} is a byte-code function object, this immediately | ||
| 352 | finishes loading the byte code of @var{function} from its | ||
| 353 | byte-compiled file, if it is not fully loaded already. Otherwise, | ||
| 354 | it does nothing. It always returns @var{function}. | ||
| 355 | @end defun | ||
| 356 | |||
| 357 | @node Eval During Compile | 291 | @node Eval During Compile |
| 358 | @section Evaluation During Compilation | 292 | @section Evaluation During Compilation |
| 359 | @cindex eval during compilation | 293 | @cindex eval during compilation |
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 0c6895332a0..78ad5b68a51 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi | |||
| @@ -638,6 +638,16 @@ with @var{n} arguments (the other elements) and an additional | |||
| 638 | Example: @code{(= 42)}@* | 638 | Example: @code{(= 42)}@* |
| 639 | In this example, the function is @code{=}, @var{n} is one, and | 639 | In this example, the function is @code{=}, @var{n} is one, and |
| 640 | the actual function call becomes: @w{@code{(= 42 @var{expval})}}. | 640 | the actual function call becomes: @w{@code{(= 42 @var{expval})}}. |
| 641 | |||
| 642 | @item function call with an @code{_} arg | ||
| 643 | Call the function (the first element of the function call) | ||
| 644 | with the specified arguments (the other elements) and replacing | ||
| 645 | @code{_} with @var{expval}. | ||
| 646 | |||
| 647 | Example: @code{(gethash _ memo-table)} | ||
| 648 | In this example, the function is @code{gethash}, and | ||
| 649 | the actual function call becomes: @w{@code{(gethash @var{expval} | ||
| 650 | memo-table)}}. | ||
| 641 | @end table | 651 | @end table |
| 642 | 652 | ||
| 643 | @item (app @var{function} @var{pattern}) | 653 | @item (app @var{function} @var{pattern}) |
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index a3ef8313f8e..ed254795d90 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi | |||
| @@ -653,7 +653,6 @@ Byte Compilation | |||
| 653 | * Speed of Byte-Code:: An example of speedup from byte compilation. | 653 | * Speed of Byte-Code:: An example of speedup from byte compilation. |
| 654 | * Compilation Functions:: Byte compilation functions. | 654 | * Compilation Functions:: Byte compilation functions. |
| 655 | * Docs and Compilation:: Dynamic loading of documentation strings. | 655 | * Docs and Compilation:: Dynamic loading of documentation strings. |
| 656 | * Dynamic Loading:: Dynamic loading of individual functions. | ||
| 657 | * Eval During Compile:: Code to be evaluated when you compile. | 656 | * Eval During Compile:: Code to be evaluated when you compile. |
| 658 | * Compiler Errors:: Handling compiler error messages. | 657 | * Compiler Errors:: Handling compiler error messages. |
| 659 | * Byte-Code Objects:: The data type used for byte-compiled functions. | 658 | * Byte-Code Objects:: The data type used for byte-compiled functions. |
| @@ -884,6 +883,7 @@ Major and Minor Modes | |||
| 884 | * Minor Modes:: Defining minor modes. | 883 | * Minor Modes:: Defining minor modes. |
| 885 | * Mode Line Format:: Customizing the text that appears in the mode line. | 884 | * Mode Line Format:: Customizing the text that appears in the mode line. |
| 886 | * Imenu:: Providing a menu of definitions made in a buffer. | 885 | * Imenu:: Providing a menu of definitions made in a buffer. |
| 886 | * Outline Minor Mode:: Outline mode to use with other major modes. | ||
| 887 | * Font Lock Mode:: How modes can highlight text according to syntax. | 887 | * Font Lock Mode:: How modes can highlight text according to syntax. |
| 888 | * Auto-Indentation:: How to teach Emacs to indent for a major mode. | 888 | * Auto-Indentation:: How to teach Emacs to indent for a major mode. |
| 889 | * Desktop Save Mode:: How modes can have buffer state saved between | 889 | * Desktop Save Mode:: How modes can have buffer state saved between |
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 2062ae64866..486125acb0d 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi | |||
| @@ -89,9 +89,9 @@ you are criticizing. | |||
| 89 | 89 | ||
| 90 | @cindex bugs | 90 | @cindex bugs |
| 91 | @cindex suggestions | 91 | @cindex suggestions |
| 92 | Please send comments and corrections using @kbd{M-x | 92 | Please send comments and corrections using @kbd{M-x report-emacs-bug}. |
| 93 | report-emacs-bug}. If you wish to contribute new code (or send a | 93 | For more details, @xref{Bugs,, Reporting Bugs, emacs, The GNU Emacs |
| 94 | patch to fix a problem), use @kbd{M-x submit-emacs-patch}. | 94 | Manual}. |
| 95 | 95 | ||
| 96 | @node Lisp History | 96 | @node Lisp History |
| 97 | @section Lisp History | 97 | @section Lisp History |
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index aa27de72ba0..0247c93f7b8 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi | |||
| @@ -2562,6 +2562,14 @@ times match. | |||
| 2562 | The optional argument @var{default} specifies the default password to | 2562 | The optional argument @var{default} specifies the default password to |
| 2563 | return if the user enters empty input. If @var{default} is @code{nil}, | 2563 | return if the user enters empty input. If @var{default} is @code{nil}, |
| 2564 | then @code{read-passwd} returns the null string in that case. | 2564 | then @code{read-passwd} returns the null string in that case. |
| 2565 | |||
| 2566 | This function uses @code{read-passwd-mode}, a minor mode. It binds two | ||
| 2567 | keys in the minbuffer: @kbd{C-u} (@code{delete-minibuffer-contents}) | ||
| 2568 | deletes the password, and @kbd{TAB} | ||
| 2569 | (@code{read-passwd--toggle-visibility}) toggles the visibility of the | ||
| 2570 | password. There is also an additional icon in the mode-line. Clicking | ||
| 2571 | on this icon with @key{mouse-1} toggles the visibility of the password | ||
| 2572 | as well. | ||
| 2565 | @end defun | 2573 | @end defun |
| 2566 | 2574 | ||
| 2567 | @node Minibuffer Commands | 2575 | @node Minibuffer Commands |
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 1d961249633..630e42e6878 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi | |||
| @@ -25,6 +25,7 @@ user. For related topics such as keymaps and syntax tables, see | |||
| 25 | * Minor Modes:: Defining minor modes. | 25 | * Minor Modes:: Defining minor modes. |
| 26 | * Mode Line Format:: Customizing the text that appears in the mode line. | 26 | * Mode Line Format:: Customizing the text that appears in the mode line. |
| 27 | * Imenu:: Providing a menu of definitions made in a buffer. | 27 | * Imenu:: Providing a menu of definitions made in a buffer. |
| 28 | * Outline Minor Mode:: Outline mode to use with other major modes. | ||
| 28 | * Font Lock Mode:: How modes can highlight text according to syntax. | 29 | * Font Lock Mode:: How modes can highlight text according to syntax. |
| 29 | * Auto-Indentation:: How to teach Emacs to indent for a major mode. | 30 | * Auto-Indentation:: How to teach Emacs to indent for a major mode. |
| 30 | * Desktop Save Mode:: How modes can have buffer state saved between | 31 | * Desktop Save Mode:: How modes can have buffer state saved between |
| @@ -508,6 +509,12 @@ variable @code{imenu-generic-expression}, for the two variables | |||
| 508 | @code{imenu-create-index-function} (@pxref{Imenu}). | 509 | @code{imenu-create-index-function} (@pxref{Imenu}). |
| 509 | 510 | ||
| 510 | @item | 511 | @item |
| 512 | The mode should specify how Outline minor mode should find the | ||
| 513 | heading lines, by setting up a buffer-local value for the variables | ||
| 514 | @code{outline-regexp} or @code{outline-search-function}, and also | ||
| 515 | for the variable @code{outline-level} (@pxref{Outline Minor Mode}). | ||
| 516 | |||
| 517 | @item | ||
| 511 | The mode can tell ElDoc mode how to retrieve different types of | 518 | The mode can tell ElDoc mode how to retrieve different types of |
| 512 | documentation for whatever is at point, by adding one or more | 519 | documentation for whatever is at point, by adding one or more |
| 513 | buffer-local entries to the special hook | 520 | buffer-local entries to the special hook |
| @@ -1182,7 +1189,7 @@ column is sorted in the descending order. | |||
| 1182 | This buffer-local variable specifies the format of the Tabulated List | 1189 | This buffer-local variable specifies the format of the Tabulated List |
| 1183 | data. Its value should be a vector. Each element of the vector | 1190 | data. Its value should be a vector. Each element of the vector |
| 1184 | represents a data column, and should be a list @code{(@var{name} | 1191 | represents a data column, and should be a list @code{(@var{name} |
| 1185 | @var{width} @var{sort})}, where | 1192 | @var{width} @var{sort} . @var{props})}, where |
| 1186 | 1193 | ||
| 1187 | @itemize | 1194 | @itemize |
| 1188 | @item | 1195 | @item |
| @@ -1199,6 +1206,13 @@ sorted by comparing string values. Otherwise, this should be a | |||
| 1199 | predicate function for @code{sort} (@pxref{Rearrangement}), which | 1206 | predicate function for @code{sort} (@pxref{Rearrangement}), which |
| 1200 | accepts two arguments with the same form as the elements of | 1207 | accepts two arguments with the same form as the elements of |
| 1201 | @code{tabulated-list-entries} (see below). | 1208 | @code{tabulated-list-entries} (see below). |
| 1209 | |||
| 1210 | @item | ||
| 1211 | @var{props} is a plist (@pxref{Property Lists}) of additional column | ||
| 1212 | properties. If the value of the property @code{:right-align} is | ||
| 1213 | non-@code{nil} then the column should be right-aligned. And the | ||
| 1214 | property @code{:pad-right} specifies the number of additional padding | ||
| 1215 | spaces to the right of the column (by default 1 if omitted). | ||
| 1202 | @end itemize | 1216 | @end itemize |
| 1203 | @end defvar | 1217 | @end defvar |
| 1204 | 1218 | ||
| @@ -2994,6 +3008,61 @@ instead. | |||
| 2994 | automatically sets up Imenu if this variable is non-@code{nil}. | 3008 | automatically sets up Imenu if this variable is non-@code{nil}. |
| 2995 | @end defvar | 3009 | @end defvar |
| 2996 | 3010 | ||
| 3011 | @node Outline Minor Mode | ||
| 3012 | @section Outline Minor Mode | ||
| 3013 | |||
| 3014 | @cindex Outline minor mode | ||
| 3015 | @dfn{Outline minor mode} is a buffer-local minor mode that hides | ||
| 3016 | parts of the buffer and leaves only heading lines visible. | ||
| 3017 | This minor mode can be used in conjunction with other major modes | ||
| 3018 | (@pxref{Outline Minor Mode,, Outline Minor Mode, emacs, the Emacs Manual}). | ||
| 3019 | |||
| 3020 | There are two ways to define which lines are headings: with the | ||
| 3021 | variable @code{outline-regexp} or @code{outline-search-function}. | ||
| 3022 | |||
| 3023 | @defvar outline-regexp | ||
| 3024 | This variable is a regular expression. | ||
| 3025 | Any line whose beginning has a match for this regexp is considered a | ||
| 3026 | heading line. Matches that start within a line (not at the left | ||
| 3027 | margin) do not count. | ||
| 3028 | @end defvar | ||
| 3029 | |||
| 3030 | @defvar outline-search-function | ||
| 3031 | Alternatively, when it's impossible to create a regexp that | ||
| 3032 | matches heading lines, you can define a function that helps | ||
| 3033 | Outline minor mode to find heading lines. | ||
| 3034 | |||
| 3035 | The variable @code{outline-search-function} specifies the function with | ||
| 3036 | four arguments: @var{bound}, @var{move}, @var{backward}, and | ||
| 3037 | @var{looking-at}. The function completes two tasks: to match the | ||
| 3038 | current heading line, and to find the next or the previous heading line. | ||
| 3039 | If the argument @var{looking-at} is non-@code{nil}, it should return | ||
| 3040 | non-@code{nil} when point is at the beginning of the outline header line. | ||
| 3041 | If the argument @var{looking-at} is @code{nil}, the first three arguments | ||
| 3042 | are used. The argument @var{bound} is a buffer position that bounds | ||
| 3043 | the search. The match found must not end after that position. A | ||
| 3044 | value of nil means search to the end of the accessible portion of | ||
| 3045 | the buffer. If the argument @var{move} is non-@code{nil}, the | ||
| 3046 | failed search should move to the limit of search and return nil. | ||
| 3047 | If the argument @var{backward} is non-@code{nil}, this function | ||
| 3048 | should search for the previous heading backward. | ||
| 3049 | @end defvar | ||
| 3050 | |||
| 3051 | @defvar outline-level | ||
| 3052 | This variable is a function that takes no arguments | ||
| 3053 | and should return the level of the current heading. | ||
| 3054 | It's required in both cases: whether you define | ||
| 3055 | @code{outline-regexp} or @code{outline-search-function}. | ||
| 3056 | @end defvar | ||
| 3057 | |||
| 3058 | If built with tree-sitter, Emacs can automatically use | ||
| 3059 | Outline minor mode if the major mode sets the following variable. | ||
| 3060 | |||
| 3061 | @defvar treesit-outline-predicate | ||
| 3062 | This variable instructs Emacs how to find lines with outline headings. | ||
| 3063 | It should be a predicate that matches the node on the heading line. | ||
| 3064 | @end defvar | ||
| 3065 | |||
| 2997 | @node Font Lock Mode | 3066 | @node Font Lock Mode |
| 2998 | @section Font Lock Mode | 3067 | @section Font Lock Mode |
| 2999 | @cindex Font Lock mode | 3068 | @cindex Font Lock mode |
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 18484bac368..01f82d56528 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi | |||
| @@ -2122,6 +2122,9 @@ with references to further information. | |||
| 2122 | @item numberp | 2122 | @item numberp |
| 2123 | @xref{Predicates on Numbers, numberp}. | 2123 | @xref{Predicates on Numbers, numberp}. |
| 2124 | 2124 | ||
| 2125 | @item obarrayp | ||
| 2126 | @xref{Creating Symbols, obarrayp}. | ||
| 2127 | |||
| 2125 | @item overlayp | 2128 | @item overlayp |
| 2126 | @xref{Overlays, overlayp}. | 2129 | @xref{Overlays, overlayp}. |
| 2127 | 2130 | ||
| @@ -2182,7 +2185,7 @@ This function returns a symbol naming the primitive type of | |||
| 2182 | @code{condition-variable}, @code{cons}, @code{finalizer}, | 2185 | @code{condition-variable}, @code{cons}, @code{finalizer}, |
| 2183 | @code{float}, @code{font-entity}, @code{font-object}, | 2186 | @code{float}, @code{font-entity}, @code{font-object}, |
| 2184 | @code{font-spec}, @code{frame}, @code{hash-table}, @code{integer}, | 2187 | @code{font-spec}, @code{frame}, @code{hash-table}, @code{integer}, |
| 2185 | @code{marker}, @code{mutex}, @code{overlay}, @code{process}, | 2188 | @code{marker}, @code{mutex}, @code{obarray}, @code{overlay}, @code{process}, |
| 2186 | @code{string}, @code{subr}, @code{symbol}, @code{thread}, | 2189 | @code{string}, @code{subr}, @code{symbol}, @code{thread}, |
| 2187 | @code{vector}, @code{window}, or @code{window-configuration}. | 2190 | @code{vector}, @code{window}, or @code{window-configuration}. |
| 2188 | However, if @var{object} is a record, the type specified by its first | 2191 | However, if @var{object} is a record, the type specified by its first |
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index f75023d4039..421e64dd5d1 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi | |||
| @@ -28,6 +28,7 @@ these archives). | |||
| 28 | * Multi-file Packages:: How to package multiple files. | 28 | * Multi-file Packages:: How to package multiple files. |
| 29 | * Package Archives:: Maintaining package archives. | 29 | * Package Archives:: Maintaining package archives. |
| 30 | * Archive Web Server:: Interfacing to an archive web server. | 30 | * Archive Web Server:: Interfacing to an archive web server. |
| 31 | * Forwards-Compatibility:: Supporting older versions of Emacs. | ||
| 31 | @end menu | 32 | @end menu |
| 32 | 33 | ||
| 33 | @node Packaging Basics | 34 | @node Packaging Basics |
| @@ -399,3 +400,50 @@ Return the file. This will be the tarball for a multi-file | |||
| 399 | package, or the single file for a simple package. | 400 | package, or the single file for a simple package. |
| 400 | 401 | ||
| 401 | @end table | 402 | @end table |
| 403 | |||
| 404 | @node Forwards-Compatibility | ||
| 405 | @section Supporting older versions of Emacs | ||
| 406 | @cindex compatibility compat | ||
| 407 | |||
| 408 | Packages that wish to support older releases of Emacs, without giving | ||
| 409 | up on newer functionality from recent Emacs releases, one can make use | ||
| 410 | of the Compat package on GNU ELPA. By depending on the package, Emacs | ||
| 411 | can provide compatibility definitions for missing functionality. | ||
| 412 | |||
| 413 | The versioning of Compat follows that of Emacs, so next to the oldest | ||
| 414 | version that a package relies on (via the @code{emacs}-package), one | ||
| 415 | can also indicate what the newest version of Emacs is, that a package | ||
| 416 | wishes to use definitions from: | ||
| 417 | |||
| 418 | @example | ||
| 419 | ;; Package-Requires: ((emacs "27.2") (compat "29.1")) | ||
| 420 | @end example | ||
| 421 | |||
| 422 | Note that Compat provides replacement functions with extended | ||
| 423 | functionality for functions that are already defined (@code{sort}, | ||
| 424 | @code{assoc}, @dots{}). These functions may have changed their | ||
| 425 | calling convention (additional optional arguments) or may have changed | ||
| 426 | their behavior. These functions must be looked up explicitly with | ||
| 427 | @code{compat-function} or called explicitly with @code{compat-call}. | ||
| 428 | We call them @dfn{Extended Definitions}. In contrast, newly @dfn{Added | ||
| 429 | Definitions} can be called as usual. | ||
| 430 | |||
| 431 | @defmac compat-call fun &rest args | ||
| 432 | This macro calls the compatibility function @var{fun} with @var{args}. | ||
| 433 | Many functions provided by Compat can be called directly without this | ||
| 434 | macro. However in the case where Compat provides an alternative | ||
| 435 | version of an existing function, the function call has to go through | ||
| 436 | @code{compat-call}. | ||
| 437 | @end defmac | ||
| 438 | |||
| 439 | @defmac compat-function fun | ||
| 440 | This macro returns the compatibility function symbol for @var{fun}. | ||
| 441 | See @code{compat-call} for a more convenient macro to directly call | ||
| 442 | compatibility functions. | ||
| 443 | @end defmac | ||
| 444 | |||
| 445 | For further details on how to make use of the package, see | ||
| 446 | @ref{Usage,, Usage, compat, "Compat" Manual}. In case you don't have | ||
| 447 | the manual installed, you can also read the | ||
| 448 | @url{https://elpa.gnu.org/packages/doc/compat.html#Usage, Online | ||
| 449 | Compat manual}. | ||
diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 5d79c4b27f4..3d2192ace64 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi | |||
| @@ -794,7 +794,7 @@ that comes after it in the buffer position order, i.e., nodes with | |||
| 794 | start positions greater than the end position of @var{start}. | 794 | start positions greater than the end position of @var{start}. |
| 795 | 795 | ||
| 796 | In the tree shown above, @code{treesit-search-subtree} traverses node | 796 | In the tree shown above, @code{treesit-search-subtree} traverses node |
| 797 | @samp{S} (@var{start}) and nodes marked with @code{o}, where this | 797 | @samp{S} (@var{start}) and nodes marked with @code{o}, whereas this |
| 798 | function traverses the nodes marked with numbers. This function is | 798 | function traverses the nodes marked with numbers. This function is |
| 799 | useful for answering questions like ``what is the first node after | 799 | useful for answering questions like ``what is the first node after |
| 800 | @var{start} in the buffer that satisfies some condition?'' | 800 | @var{start} in the buffer that satisfies some condition?'' |
| @@ -916,32 +916,37 @@ nodes. | |||
| 916 | 916 | ||
| 917 | @defun treesit-parent-until node predicate &optional include-node | 917 | @defun treesit-parent-until node predicate &optional include-node |
| 918 | This function repeatedly finds the parents of @var{node}, and returns | 918 | This function repeatedly finds the parents of @var{node}, and returns |
| 919 | the parent that satisfies @var{pred}, a function that takes a node as | 919 | the parent that satisfies @var{predicate}. @var{predicate} can be |
| 920 | argument and returns a boolean that indicates a match. If no parent | 920 | either a function that takes a node as argument and returns @code{t} |
| 921 | satisfies @var{pred}, this function returns @code{nil}. | 921 | or @code{nil}, or a regexp matching node type names, or other valid |
| 922 | predicates described in @var{treesit-thing-settings}. If no parent | ||
| 923 | satisfies @var{predicates}, this function returns @code{nil}. | ||
| 922 | 924 | ||
| 923 | Normally this function only looks at the parents of @var{node} but not | 925 | Normally this function only looks at the parents of @var{node} but not |
| 924 | @var{node} itself. But if @var{include-node} is non-@code{nil}, this | 926 | @var{node} itself. But if @var{include-node} is non-@code{nil}, this |
| 925 | function returns @var{node} if @var{node} satisfies @var{pred}. | 927 | function returns @var{node} if @var{node} satisfies @var{predicate}. |
| 926 | @end defun | 928 | @end defun |
| 927 | 929 | ||
| 928 | @defun treesit-parent-while node pred | 930 | @defun treesit-parent-while node predicate |
| 929 | This function goes up the tree starting from @var{node}, and keeps | 931 | This function goes up the tree starting from @var{node}, and keeps |
| 930 | doing so as long as the nodes satisfy @var{pred}, a function that | 932 | doing so as long as the nodes satisfy @var{predicate}, a function that |
| 931 | takes a node as argument. That is, this function returns the highest | 933 | takes a node as argument. That is, this function returns the highest |
| 932 | parent of @var{node} that still satisfies @var{pred}. Note that if | 934 | parent of @var{node} that still satisfies @var{predicate}. Note that if |
| 933 | @var{node} satisfies @var{pred} but its immediate parent doesn't, | 935 | @var{node} satisfies @var{predicate} but its immediate parent doesn't, |
| 934 | @var{node} itself is returned. | 936 | @var{node} itself is returned. |
| 935 | @end defun | 937 | @end defun |
| 936 | 938 | ||
| 937 | @defun treesit-node-top-level node &optional type | 939 | @defun treesit-node-top-level node &optional predicate include-node |
| 938 | This function returns the highest parent of @var{node} that has the | 940 | This function returns the highest parent of @var{node} that has the |
| 939 | same type as @var{node}. If no such parent exists, it returns | 941 | same type as @var{node}. If no such parent exists, it returns |
| 940 | @code{nil}. Therefore this function is also useful for testing | 942 | @code{nil}. Therefore this function is also useful for testing |
| 941 | whether @var{node} is top-level. | 943 | whether @var{node} is top-level. |
| 942 | 944 | ||
| 943 | If @var{type} is non-@code{nil}, this function matches each parent's | 945 | If @var{predicate} is @code{nil}, this function uses @var{node}'s type |
| 944 | type with @var{type} as a regexp, rather than using @var{node}'s type. | 946 | to find the parent. If @var{predicate} is non-@code{nil}, this |
| 947 | function searches the parent that satisfies @var{predicate}. If | ||
| 948 | @var{include-node} is non-@code{nil}, this function returns @var{node} | ||
| 949 | if @var{node} satisfies @var{predicate}. | ||
| 945 | @end defun | 950 | @end defun |
| 946 | 951 | ||
| 947 | @node Accessing Node Information | 952 | @node Accessing Node Information |
| @@ -1892,6 +1897,10 @@ add-log functions used by @code{add-log-current-defun}. | |||
| 1892 | @item | 1897 | @item |
| 1893 | If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is | 1898 | If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is |
| 1894 | non-@code{nil}, it sets up Imenu. | 1899 | non-@code{nil}, it sets up Imenu. |
| 1900 | |||
| 1901 | @item | ||
| 1902 | If @code{treesit-outline-predicate} (@pxref{Outline Minor Mode}) is | ||
| 1903 | non-@code{nil}, it sets up Outline minor mode. | ||
| 1895 | @end itemize | 1904 | @end itemize |
| 1896 | 1905 | ||
| 1897 | @c TODO: Add treesit-thing-settings stuff once we finalize it. | 1906 | @c TODO: Add treesit-thing-settings stuff once we finalize it. |
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index f1f23f007a4..74719d4779f 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi | |||
| @@ -434,12 +434,44 @@ but their relative order is also preserved: | |||
| 434 | (9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")] | 434 | (9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")] |
| 435 | @end group | 435 | @end group |
| 436 | @end example | 436 | @end example |
| 437 | |||
| 438 | @xref{Sorting}, for more functions that perform sorting. | ||
| 439 | See @code{documentation} in @ref{Accessing Documentation}, for a | ||
| 440 | useful example of @code{sort}. | ||
| 441 | @end defun | 437 | @end defun |
| 442 | 438 | ||
| 439 | Sometimes, computation of sort keys of list or vector elements is | ||
| 440 | expensive, and therefore it is important to perform it the minimum | ||
| 441 | number of times. By contrast, computing the sort keys of elements | ||
| 442 | inside the @var{predicate} function passed to @code{sort} will generally | ||
| 443 | perform this computation each time @var{predicate} is called with some | ||
| 444 | element. If you can separate the computation of the sort key of an | ||
| 445 | element into a function of its own, you can use the following sorting | ||
| 446 | function, which guarantees that the key will be computed for each list | ||
| 447 | or vector element exactly once. | ||
| 448 | |||
| 449 | @cindex decorate-sort-undecorate | ||
| 450 | @cindex Schwartzian transform | ||
| 451 | @defun sort-on sequence predicate accessor | ||
| 452 | This function stably sorts @var{sequence}, which can be a list, a | ||
| 453 | vector, a bool-vector, or a string. It sorts by comparing the sort | ||
| 454 | keys of the elements using @var{predicate}. The comparison function | ||
| 455 | @var{predicate} accepts two arguments, the sort keys to compare, and | ||
| 456 | should return non-@code{nil} if the element corresponding to the first | ||
| 457 | key should sort before the element corresponding to the second key. The | ||
| 458 | function computes a sort key of each element by calling the | ||
| 459 | @var{accessor} function on that element; it does so exactly once for | ||
| 460 | each element of @var{sequence}. The @var{accessor} function is called | ||
| 461 | with a single argument, an element of @var{sequence}. | ||
| 462 | |||
| 463 | This function implements what is known as @dfn{decorate-sort-undecorate} | ||
| 464 | paradigm, or the Schwartzian transform. It basically trades CPU for | ||
| 465 | memory, creating a temporary list with the computed sort keys, then | ||
| 466 | mapping @code{car} over the result of sorting that temporary list. | ||
| 467 | Unlike with @code{sort}, the return value is always a new list; the | ||
| 468 | original @var{sequence} is left intact. | ||
| 469 | @end defun | ||
| 470 | |||
| 471 | @xref{Sorting}, for more functions that perform sorting. See | ||
| 472 | @code{documentation} in @ref{Accessing Documentation}, for a useful | ||
| 473 | example of @code{sort}. | ||
| 474 | |||
| 443 | @cindex sequence functions in seq | 475 | @cindex sequence functions in seq |
| 444 | @cindex seq library | 476 | @cindex seq library |
| 445 | @cindex sequences, generalized | 477 | @cindex sequences, generalized |
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 367bd195f16..5207ea4ea7b 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi | |||
| @@ -177,34 +177,16 @@ know how Lisp reads them. Lisp must ensure that it finds the same | |||
| 177 | symbol every time it reads the same sequence of characters in the same | 177 | symbol every time it reads the same sequence of characters in the same |
| 178 | context. Failure to do so would cause complete confusion. | 178 | context. Failure to do so would cause complete confusion. |
| 179 | 179 | ||
| 180 | @cindex symbol name hashing | ||
| 181 | @cindex hashing | ||
| 182 | @cindex obarray | 180 | @cindex obarray |
| 183 | @cindex bucket (in obarray) | ||
| 184 | When the Lisp reader encounters a name that references a symbol in | 181 | When the Lisp reader encounters a name that references a symbol in |
| 185 | the source code, it reads all the characters of that name. Then it | 182 | the source code, it looks up that name in a table called an @dfn{obarray} |
| 186 | looks up that name in a table called an @dfn{obarray} to find the | 183 | to find the symbol that the programmer meant. An obarray is an unordered |
| 187 | symbol that the programmer meant. The technique used in this lookup | 184 | container of symbols, indexed by name. |
| 188 | is called ``hashing'', an efficient method of looking something up by | 185 | |
| 189 | converting a sequence of characters to a number, known as a ``hash | 186 | The Lisp reader also considers ``shorthands''. |
| 190 | code''. For example, instead of searching a telephone book cover to | ||
| 191 | cover when looking up Jan Jones, you start with the J's and go from | ||
| 192 | there. That is a simple version of hashing. Each element of the | ||
| 193 | obarray is a @dfn{bucket} which holds all the symbols with a given | ||
| 194 | hash code; to look for a given name, it is sufficient to look through | ||
| 195 | all the symbols in the bucket for that name's hash code. (The same | ||
| 196 | idea is used for general Emacs hash tables, but they are a different | ||
| 197 | data type; see @ref{Hash Tables}.) | ||
| 198 | |||
| 199 | When looking up names, the Lisp reader also considers ``shorthands''. | ||
| 200 | If the programmer supplied them, this allows the reader to find a | 187 | If the programmer supplied them, this allows the reader to find a |
| 201 | symbol even if its name isn't present in its full form in the source | 188 | symbol even if its name isn't present in its full form in the source |
| 202 | code. Of course, the reader needs to be aware of some pre-established | 189 | code. @xref{Shorthands}. |
| 203 | context about such shorthands, much as one needs context to be to able | ||
| 204 | to refer uniquely to Jan Jones by just the name ``Jan'': it's probably | ||
| 205 | fine when amongst the Joneses, or when Jan has been mentioned | ||
| 206 | recently, but very ambiguous in any other situation. | ||
| 207 | @xref{Shorthands}. | ||
| 208 | 190 | ||
| 209 | @cindex interning | 191 | @cindex interning |
| 210 | If a symbol with the desired name is found, the reader uses that | 192 | If a symbol with the desired name is found, the reader uses that |
| @@ -236,23 +218,6 @@ to gain access to it is by finding it in some other object or as the | |||
| 236 | value of a variable. Uninterned symbols are sometimes useful in | 218 | value of a variable. Uninterned symbols are sometimes useful in |
| 237 | generating Lisp code, see below. | 219 | generating Lisp code, see below. |
| 238 | 220 | ||
| 239 | In Emacs Lisp, an obarray is actually a vector. Each element of the | ||
| 240 | vector is a bucket; its value is either an interned symbol whose name | ||
| 241 | hashes to that bucket, or 0 if the bucket is empty. Each interned | ||
| 242 | symbol has an internal link (invisible to the user) to the next symbol | ||
| 243 | in the bucket. Because these links are invisible, there is no way to | ||
| 244 | find all the symbols in an obarray except using @code{mapatoms} (below). | ||
| 245 | The order of symbols in a bucket is not significant. | ||
| 246 | |||
| 247 | In an empty obarray, every element is 0, so you can create an obarray | ||
| 248 | with @code{(make-vector @var{length} 0)}. @strong{This is the only | ||
| 249 | valid way to create an obarray.} Prime numbers as lengths tend | ||
| 250 | to result in good hashing; lengths one less than a power of two are also | ||
| 251 | good. | ||
| 252 | |||
| 253 | @strong{Do not try to put symbols in an obarray yourself.} This does | ||
| 254 | not work---only @code{intern} can enter a symbol in an obarray properly. | ||
| 255 | |||
| 256 | @cindex CL note---symbol in obarrays | 221 | @cindex CL note---symbol in obarrays |
| 257 | @quotation | 222 | @quotation |
| 258 | @b{Common Lisp note:} Unlike Common Lisp, Emacs Lisp does not provide | 223 | @b{Common Lisp note:} Unlike Common Lisp, Emacs Lisp does not provide |
| @@ -262,9 +227,21 @@ Emacs Lisp provides a different namespacing system called | |||
| 262 | ``shorthands'' (@pxref{Shorthands}). | 227 | ``shorthands'' (@pxref{Shorthands}). |
| 263 | @end quotation | 228 | @end quotation |
| 264 | 229 | ||
| 230 | @defun obarray-make &optional size | ||
| 231 | This function creates and returns a new obarray. | ||
| 232 | The optional @var{size} may be used to specify the number of symbols | ||
| 233 | that it is expected to hold, but since obarrays grow automatically | ||
| 234 | as needed, this rarely provide any benefit. | ||
| 235 | @end defun | ||
| 236 | |||
| 237 | @defun obarrayp object | ||
| 238 | This function returns @code{t} if @var{object} is an obarray, | ||
| 239 | @code{nil} otherwise. | ||
| 240 | @end defun | ||
| 241 | |||
| 265 | Most of the functions below take a name and sometimes an obarray as | 242 | Most of the functions below take a name and sometimes an obarray as |
| 266 | arguments. A @code{wrong-type-argument} error is signaled if the name | 243 | arguments. A @code{wrong-type-argument} error is signaled if the name |
| 267 | is not a string, or if the obarray is not a vector. | 244 | is not a string, or if the obarray is not an obarray object. |
| 268 | 245 | ||
| 269 | @defun symbol-name symbol | 246 | @defun symbol-name symbol |
| 270 | This function returns the string that is @var{symbol}'s name. For example: | 247 | This function returns the string that is @var{symbol}'s name. For example: |
| @@ -416,6 +393,10 @@ If @code{unintern} does delete a symbol, it returns @code{t}. Otherwise | |||
| 416 | it returns @code{nil}. | 393 | it returns @code{nil}. |
| 417 | @end defun | 394 | @end defun |
| 418 | 395 | ||
| 396 | @defun obarray-clear obarray | ||
| 397 | This function removes all symbols from @var{obarray}. | ||
| 398 | @end defun | ||
| 399 | |||
| 419 | @node Symbol Properties | 400 | @node Symbol Properties |
| 420 | @section Symbol Properties | 401 | @section Symbol Properties |
| 421 | @cindex symbol property | 402 | @cindex symbol property |
| @@ -761,6 +742,23 @@ instead of @code{snu-}. | |||
| 761 | ;; End: | 742 | ;; End: |
| 762 | @end example | 743 | @end example |
| 763 | 744 | ||
| 745 | Note that if you have two shorthands in the same file where one is the | ||
| 746 | prefix of the other, the longer shorthand will be attempted first. | ||
| 747 | This happens regardless of the order you specify shorthands in the | ||
| 748 | local variables section of your file. | ||
| 749 | |||
| 750 | @example | ||
| 751 | '( | ||
| 752 | t//foo ; reads to 'my-tricks--foo', not 'my-tricks-/foo' | ||
| 753 | t/foo ; reads to 'my-tricks-foo' | ||
| 754 | ) | ||
| 755 | |||
| 756 | ;; Local Variables: | ||
| 757 | ;; read-symbol-shorthands: (("t/" . "my-tricks-") | ||
| 758 | ;; ("t//" . "my-tricks--") | ||
| 759 | ;; End: | ||
| 760 | @end example | ||
| 761 | |||
| 764 | @subsection Exceptions | 762 | @subsection Exceptions |
| 765 | 763 | ||
| 766 | There are two exceptions to rules governing Shorthand transformations: | 764 | There are two exceptions to rules governing Shorthand transformations: |
diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index 27a9e2b0ebb..f450b9cbdd9 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi | |||
| @@ -289,6 +289,15 @@ also ask you whether or not to sign the text before encryption and if | |||
| 289 | you answered yes, it will let you select the signing keys. | 289 | you answered yes, it will let you select the signing keys. |
| 290 | @end deffn | 290 | @end deffn |
| 291 | 291 | ||
| 292 | @defvar epa-keys-select-method | ||
| 293 | This variable controls the method used for key selection in | ||
| 294 | @code{epa-select-keys}. The default value @code{buffer} pops up a | ||
| 295 | special buffer where you can select the keys. If the value is | ||
| 296 | @code{minibuffer}, @code{epa-select-keys} will instead prompt for the | ||
| 297 | keys in the minibuffer, where you should type the keys separated by | ||
| 298 | commas. | ||
| 299 | @end defvar | ||
| 300 | |||
| 292 | @node Cryptographic operations on files | 301 | @node Cryptographic operations on files |
| 293 | @section Cryptographic Operations on Files | 302 | @section Cryptographic Operations on Files |
| 294 | @cindex cryptographic operations on files | 303 | @cindex cryptographic operations on files |
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index f877fb681fe..c7ab7e7bf21 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi | |||
| @@ -1230,25 +1230,30 @@ machine Example.Net login aph-bot password sesame | |||
| 1230 | 1230 | ||
| 1231 | (defun my-erc-up (network) | 1231 | (defun my-erc-up (network) |
| 1232 | (interactive "Snetwork: ") | 1232 | (interactive "Snetwork: ") |
| 1233 | 1233 | (require 'erc-sasl) | |
| 1234 | (pcase network | 1234 | (or (let ((erc-modules (cons 'sasl erc-modules))) |
| 1235 | ('libera | 1235 | (pcase network |
| 1236 | (let ((erc-sasl-mechanism 'external)) | 1236 | ('libera |
| 1237 | (erc-tls :server "irc.libera.chat" :port 6697 | 1237 | (let ((erc-sasl-mechanism 'external)) |
| 1238 | :client-certificate t))) | 1238 | (erc-tls :server "irc.libera.chat" |
| 1239 | ('example | 1239 | :client-certificate t))) |
| 1240 | (let ((erc-sasl-auth-source-function | 1240 | ('example |
| 1241 | #'erc-sasl-auth-source-password-as-host)) | 1241 | (let ((erc-sasl-auth-source-function |
| 1242 | (erc-tls :server "irc.example.net" :port 6697 | 1242 | #'erc-sasl-auth-source-password-as-host)) |
| 1243 | :user "alyssa" | 1243 | (erc-tls :server "irc.example.net" |
| 1244 | :password "Example.Net"))))) | 1244 | :user "alyssa" |
| 1245 | :password "Example.Net"))))) | ||
| 1246 | ;; Non-SASL | ||
| 1247 | (call-interactively #'erc-tls))) | ||
| 1245 | @end lisp | 1248 | @end lisp |
| 1246 | 1249 | ||
| 1247 | You've started storing your credentials with auth-source and have | 1250 | You've started storing your credentials with auth-source and have |
| 1248 | decided to try SASL on another network as well. But there's a catch: | 1251 | decided to try SASL on another network as well. But there's a catch: |
| 1249 | this network doesn't support @samp{EXTERNAL}. You use | 1252 | this network doesn't support @samp{EXTERNAL}. You use |
| 1250 | @code{let}-binding to get around this and successfully authenticate to | 1253 | @code{let}-binding to work around this and successfully authenticate |
| 1251 | both networks. | 1254 | to both networks. (Note that this example assumes you've removed |
| 1255 | @code{sasl} from @code{erc-modules} globally and have instead opted to | ||
| 1256 | add it locally when connecting to preconfigured networks.) | ||
| 1252 | 1257 | ||
| 1253 | @end itemize | 1258 | @end itemize |
| 1254 | 1259 | ||
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index da5e1ef1d03..30c85da795b 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi | |||
| @@ -3,7 +3,7 @@ | |||
| 3 | @setfilename ../../info/eshell.info | 3 | @setfilename ../../info/eshell.info |
| 4 | @settitle Eshell: The Emacs Shell | 4 | @settitle Eshell: The Emacs Shell |
| 5 | @include docstyle.texi | 5 | @include docstyle.texi |
| 6 | @defindex cm | 6 | @defcodeindex cm |
| 7 | @syncodeindex vr fn | 7 | @syncodeindex vr fn |
| 8 | @c %**end of header | 8 | @c %**end of header |
| 9 | 9 | ||
| @@ -416,7 +416,7 @@ elisp, The Emacs Lisp Reference Manual}). | |||
| 416 | @end table | 416 | @end table |
| 417 | 417 | ||
| 418 | @node Built-ins | 418 | @node Built-ins |
| 419 | @section Built-in commands | 419 | @section Built-in Commands |
| 420 | Eshell provides a number of built-in commands, many of them | 420 | Eshell provides a number of built-in commands, many of them |
| 421 | implementing common command-line utilities, but enhanced for Eshell. | 421 | implementing common command-line utilities, but enhanced for Eshell. |
| 422 | (These built-in commands are just ordinary Lisp functions whose names | 422 | (These built-in commands are just ordinary Lisp functions whose names |
| @@ -477,98 +477,133 @@ default target for the commands @command{cp}, @command{mv}, and | |||
| 477 | @command{ln} is the current directory. | 477 | @command{ln} is the current directory. |
| 478 | 478 | ||
| 479 | A few commands are wrappers for more niche Emacs features, and can be | 479 | A few commands are wrappers for more niche Emacs features, and can be |
| 480 | loaded as part of the eshell-xtra module. @xref{Extension modules}. | 480 | loaded as part of the @code{eshell-xtra} module. @xref{Extra built-in |
| 481 | commands}. | ||
| 482 | |||
| 483 | @menu | ||
| 484 | * List of Built-ins:: | ||
| 485 | * Defining New Built-ins:: | ||
| 486 | @end menu | ||
| 487 | |||
| 488 | @node List of Built-ins | ||
| 489 | @subsection List of Built-in Commands | ||
| 481 | 490 | ||
| 482 | @table @code | 491 | @table @code |
| 483 | 492 | ||
| 484 | @item . | ||
| 485 | @cmindex . | 493 | @cmindex . |
| 486 | Source an Eshell file in the current environment. This is not to be | 494 | @item . @var{file} [@var{argument}]@dots{} |
| 487 | confused with the command @command{source}, which sources a file in a | 495 | Source an Eshell script named @var{file} in the current environment, |
| 488 | subshell environment. | 496 | passing any @var{arguments} to the script (@pxref{Scripts}). This is |
| 497 | not to be confused with the command @command{source}, which sources a | ||
| 498 | file in a subshell environment. | ||
| 489 | 499 | ||
| 490 | @item addpath | ||
| 491 | @cmindex addpath | 500 | @cmindex addpath |
| 492 | Adds a given path or set of paths to the PATH environment variable, or, | 501 | @item addpath |
| 493 | with no arguments, prints the current paths in this variable. | 502 | @itemx addpath [-b] @var{directory}@dots{} |
| 503 | Adds each specified @var{directory} to the @code{$PATH} environment | ||
| 504 | variable. By default, this adds the directories to the end of | ||
| 505 | @code{$PATH}, in the order they were passed on the command line; by | ||
| 506 | passing @code{-b} or @code{--begin}, Eshell will instead add the | ||
| 507 | directories to the beginning. | ||
| 508 | |||
| 509 | With no directories, print the list of directories currently stored in | ||
| 510 | @code{$PATH}. | ||
| 494 | 511 | ||
| 495 | @item alias | ||
| 496 | @cmindex alias | 512 | @cmindex alias |
| 497 | Define an alias (@pxref{Aliases}). This adds it to the aliases file. | 513 | @item alias |
| 514 | @itemx alias @var{name} [@var{command}] | ||
| 515 | Define an alias named @var{name} and expanding to @var{command}, | ||
| 516 | adding it to the aliases file (@pxref{Aliases}). If @var{command} is | ||
| 517 | omitted, delete the alias named @var{name}. With no arguments at all, | ||
| 518 | list all the currently-defined aliases. | ||
| 498 | 519 | ||
| 499 | @item basename | ||
| 500 | @cmindex basename | 520 | @cmindex basename |
| 501 | Return a file name without its directory. | 521 | @item basename @var{filename} |
| 522 | Return @var{filename} without its directory. | ||
| 502 | 523 | ||
| 503 | @item cat | ||
| 504 | @cmindex cat | 524 | @cmindex cat |
| 505 | Concatenate file contents into standard output. If in a pipeline, or | 525 | @item cat @var{file}@dots{} |
| 506 | if the file is not a regular file, directory, or symlink, then this | 526 | Concatenate the contents of @var{file}s to standard output. If in a |
| 507 | command reverts to the system's definition of @command{cat}. | 527 | pipeline, or if any of the files is not a regular file, directory, or |
| 528 | symlink, then this command reverts to the system's definition of | ||
| 529 | @command{cat}. | ||
| 508 | 530 | ||
| 509 | @item cd | ||
| 510 | @cmindex cd | 531 | @cmindex cd |
| 511 | This command changes the current working directory. Usually, it is | 532 | @cindex directories, changing |
| 512 | invoked as @kbd{cd @var{dir}} where @file{@var{dir}} is the new | 533 | @item cd |
| 513 | working directory. But @command{cd} knows about a few special | 534 | @itemx cd @var{directory} |
| 514 | arguments: | 535 | @itemx cd -[@var{n}] |
| 536 | @itemx cd =[@var{regexp}] | ||
| 537 | Change the current working directory. This command can take several | ||
| 538 | forms: | ||
| 515 | 539 | ||
| 516 | @itemize @minus{} | 540 | @table @code |
| 517 | @item | ||
| 518 | When it receives no argument at all, it changes to the home directory. | ||
| 519 | 541 | ||
| 520 | @item | 542 | @item cd |
| 521 | Giving the command @kbd{cd -} changes back to the previous working | 543 | Change to the user's home directory. |
| 522 | directory (this is the same as @kbd{cd $-}). | ||
| 523 | 544 | ||
| 524 | @item | 545 | @item cd @var{directory} |
| 525 | The command @kbd{cd =} shows the directory ring. Each line is | 546 | Change to the specified @var{directory}. |
| 526 | numbered. | ||
| 527 | 547 | ||
| 528 | @item | 548 | @item cd - |
| 529 | With @kbd{cd =foo}, Eshell searches the directory ring for a directory | 549 | Change back to the previous working directory (this is the same as |
| 530 | matching the regular expression @samp{foo}, and changes to that | 550 | @kbd{cd $-}). |
| 531 | directory. | ||
| 532 | 551 | ||
| 533 | @item | 552 | @item cd -@var{n} |
| 534 | With @kbd{cd -42}, you can access the directory stack slots by number. | 553 | Change to the directory in the @var{nth} slot of the directory stack. |
| 554 | |||
| 555 | @item cd = | ||
| 556 | Show the directory ring. Each line is numbered. | ||
| 557 | |||
| 558 | @item cd =@var{regexp} | ||
| 559 | Search the directory ring for a directory matching the regular | ||
| 560 | expression @var{regexp} and change to that directory. | ||
| 561 | |||
| 562 | @end table | ||
| 535 | 563 | ||
| 536 | @item | ||
| 537 | @vindex eshell-cd-shows-directory | 564 | @vindex eshell-cd-shows-directory |
| 538 | @vindex eshell-list-files-after-cd | 565 | @vindex eshell-list-files-after-cd |
| 539 | If @code{eshell-cd-shows-directory} is non-@code{nil}, @command{cd} | 566 | If @code{eshell-cd-shows-directory} is non-@code{nil}, @command{cd} |
| 540 | will report the directory it changes to. If | 567 | will report the directory it changes to. If |
| 541 | @code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls} | 568 | @code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls} |
| 542 | is called with any remaining arguments after changing directories. | 569 | is called with any remaining arguments after changing directories. |
| 543 | @end itemize | ||
| 544 | 570 | ||
| 545 | @item clear | ||
| 546 | @cmindex clear | 571 | @cmindex clear |
| 572 | @item clear [@var{scrollback}] | ||
| 547 | Scrolls the contents of the Eshell window out of sight, leaving a | 573 | Scrolls the contents of the Eshell window out of sight, leaving a |
| 548 | blank window. If provided with an optional non-@code{nil} argument, | 574 | blank window. If @var{scrollback} is non-@code{nil}, the scrollback |
| 549 | the scrollback contents are cleared instead. | 575 | contents are cleared instead, as with @command{clear-scrollback}. |
| 550 | 576 | ||
| 551 | @item clear-scrollback | ||
| 552 | @cmindex clear-scrollback | 577 | @cmindex clear-scrollback |
| 578 | @item clear-scrollback | ||
| 553 | Clear the scrollback contents of the Eshell window. Unlike the | 579 | Clear the scrollback contents of the Eshell window. Unlike the |
| 554 | command @command{clear}, this command deletes content in the Eshell | 580 | command @command{clear}, this command deletes content in the Eshell |
| 555 | buffer. | 581 | buffer. |
| 556 | 582 | ||
| 557 | @item compile | ||
| 558 | @cmindex compile | 583 | @cmindex compile |
| 584 | @item compile [-p | -i] [-m @var{mode-name}] @var{command}@dots{} | ||
| 559 | Run an external command, sending its output to a compilation buffer if | 585 | Run an external command, sending its output to a compilation buffer if |
| 560 | the command would output to the screen and is not part of a pipeline | 586 | the command would output to the screen and is not part of a pipeline |
| 561 | or subcommand. This is particularly useful when defining aliases, so | 587 | or subcommand. |
| 588 | |||
| 589 | With the @code{-p} or @code{--plain} options, always send the output | ||
| 590 | to the Eshell buffer; similarly, with @code{-i} or | ||
| 591 | @code{--interactive}, always send the output to a compilation buffer. | ||
| 592 | You can also set the mode of the compilation buffer with @code{-m | ||
| 593 | @var{mode-name}} or @code{--mode @var{mode-name}}. | ||
| 594 | |||
| 595 | @command{compile} is particularly useful when defining aliases, so | ||
| 562 | that interactively, the output shows up in a compilation buffer, but | 596 | that interactively, the output shows up in a compilation buffer, but |
| 563 | you can still pipe the output elsewhere if desired. For example, if | 597 | you can still pipe the output elsewhere if desired. For example, if |
| 564 | you have a grep-like command on your system, you might define an alias | 598 | you have a grep-like command on your system, you might define an alias |
| 565 | for it like so: @samp{alias mygrep 'compile --mode=grep-mode -- mygrep | 599 | for it like so: @samp{alias mygrep 'compile --mode=grep-mode -- mygrep |
| 566 | $*'}. | 600 | $*'}. |
| 567 | 601 | ||
| 568 | @item cp | ||
| 569 | @cmindex cp | 602 | @cmindex cp |
| 570 | Copy a file to a new location or copy multiple files to the same | 603 | @item cp [@var{option}@dots{}] @var{source} @var{dest} |
| 571 | directory. | 604 | @item cp [@var{option}@dots{}] @var{source}@dots{} @var{directory} |
| 605 | Copy the file @var{source} to @var{dest} or @var{source} into | ||
| 606 | @var{directory}. | ||
| 572 | 607 | ||
| 573 | @vindex eshell-cp-overwrite-files | 608 | @vindex eshell-cp-overwrite-files |
| 574 | @vindex eshell-cp-interactive-query | 609 | @vindex eshell-cp-interactive-query |
| @@ -577,61 +612,145 @@ If @code{eshell-cp-overwrite-files} is non-@code{nil}, then | |||
| 577 | @code{eshell-cp-interactive-query} is non-@code{nil}, then | 612 | @code{eshell-cp-interactive-query} is non-@code{nil}, then |
| 578 | @command{cp} will ask before overwriting anything. | 613 | @command{cp} will ask before overwriting anything. |
| 579 | 614 | ||
| 580 | @item date | 615 | @command{cp} accepts the following options: |
| 616 | |||
| 617 | @table @asis | ||
| 618 | |||
| 619 | @item @code{-a}, @code{--archive} | ||
| 620 | Equivalent to @code{--no-dereference --preserve --recursive}. | ||
| 621 | |||
| 622 | @item @code{-d}, @code{--no-dereference} | ||
| 623 | Don't dereference symbolic links when copying; instead, copy the link | ||
| 624 | itself. | ||
| 625 | |||
| 626 | @item @code{-f}, @code{--force} | ||
| 627 | Never prompt for confirmation before copying a file. | ||
| 628 | |||
| 629 | @item @code{-i}, @code{--interactive} | ||
| 630 | Prompt for confirmation before copying a file if the target already | ||
| 631 | exists. | ||
| 632 | |||
| 633 | @item @code{-n}, @code{--preview} | ||
| 634 | Run the command, but don't copy anything. This is useful if you | ||
| 635 | want to preview what would be removed when calling @command{cp}. | ||
| 636 | |||
| 637 | @item @code{-p}, @code{--preserve} | ||
| 638 | Attempt to preserve file attributes when copying. | ||
| 639 | |||
| 640 | @item @code{-r}, @code{-R}, @code{--recursive} | ||
| 641 | Copy any specified directories and their contents recursively. | ||
| 642 | |||
| 643 | @item @code{-v}, @code{--verbose} | ||
| 644 | Print the name of each file before copying it. | ||
| 645 | |||
| 646 | @end table | ||
| 647 | |||
| 581 | @cmindex date | 648 | @cmindex date |
| 649 | @item date [@var{specified-time} [@var{zone}]] | ||
| 582 | Print the current local time as a human-readable string. This command | 650 | Print the current local time as a human-readable string. This command |
| 583 | is similar to, but slightly different from, the GNU Coreutils | 651 | is an alias to the Emacs Lisp function @code{current-time-string} |
| 584 | @command{date} command. | 652 | (@pxref{Time of Day,,, elisp, GNU Emacs Lisp Reference Manual}). |
| 585 | 653 | ||
| 586 | @item diff | ||
| 587 | @cmindex diff | 654 | @cmindex diff |
| 588 | Compare files using Emacs's internal @code{diff} (not to be confused | 655 | @item diff [@var{option}]@dots{} @var{old} @var{new} |
| 589 | with @code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs | 656 | Compare the files @var{old} and @var{new} using Emacs's internal |
| 590 | Manual}. | 657 | @code{diff} (not to be confused with @code{ediff}). @xref{Comparing |
| 658 | Files, , , emacs, The GNU Emacs Manual}. | ||
| 591 | 659 | ||
| 592 | @vindex eshell-plain-diff-behavior | 660 | @vindex eshell-plain-diff-behavior |
| 593 | If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this | 661 | If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this |
| 594 | command does not use Emacs's internal @code{diff}. This is the same | 662 | command does not use Emacs's internal @code{diff}. This is the same |
| 595 | as using @samp{alias diff '*diff $@@*'}. | 663 | as using @samp{alias diff '*diff $@@*'}. |
| 596 | 664 | ||
| 597 | @item dirname | ||
| 598 | @cmindex dirname | 665 | @cmindex dirname |
| 599 | Return the directory component of a file name. | 666 | @item dirname @var{filename} |
| 667 | Return the directory component of @var{filename}. | ||
| 600 | 668 | ||
| 601 | @item dirs | ||
| 602 | @cmindex dirs | 669 | @cmindex dirs |
| 670 | @cindex directory stack, listing | ||
| 671 | @item dirs | ||
| 603 | Prints the directory stack. Directories can be added or removed from | 672 | Prints the directory stack. Directories can be added or removed from |
| 604 | the stack using the commands @command{pushd} and @command{popd}, | 673 | the stack using the commands @command{pushd} and @command{popd}, |
| 605 | respectively. | 674 | respectively. |
| 606 | 675 | ||
| 607 | @item du | ||
| 608 | @cmindex du | 676 | @cmindex du |
| 609 | Summarize disk usage for each file. | 677 | @item du [@var{option}]@dots{} @var{file}@dots{} |
| 678 | Summarize disk usage for each file, recursing into directories. | ||
| 679 | |||
| 680 | @command{du} accepts the following options: | ||
| 681 | |||
| 682 | @table @asis | ||
| 683 | |||
| 684 | @item @code{-a}, @code{--all} | ||
| 685 | Print sizes for files, not just directories. | ||
| 686 | |||
| 687 | @item @code{--block-size=@var{size}} | ||
| 688 | Print sizes as number of blocks of size @var{size}. | ||
| 689 | |||
| 690 | @item @code{-b}, @code{--bytes} | ||
| 691 | Print file sizes in bytes. | ||
| 692 | |||
| 693 | @item @code{-c}, @code{--total} | ||
| 694 | Print a grand total of the sizes at the end. | ||
| 695 | |||
| 696 | @item @code{-d}, @code{--max-depth=@var{depth}} | ||
| 697 | Only print sizes for directories (or files with @code{--all}) that are | ||
| 698 | @var{depth} or fewer levels below the command line arguments. | ||
| 699 | |||
| 700 | @item @code{-h}, @code{--human-readable} | ||
| 701 | Print sizes in human-readable format, with binary prefixes (so 1 KB is | ||
| 702 | 1024 bytes). | ||
| 703 | |||
| 704 | @item @code{-H}, @code{--si} | ||
| 705 | Print sizes in human-readable format, with decimal prefixes (so 1 KB | ||
| 706 | is 1000 bytes). | ||
| 707 | |||
| 708 | @item @code{-k}, @code{--kilobytes} | ||
| 709 | Print file sizes in kilobytes (like @code{--block-size=1024}). | ||
| 710 | |||
| 711 | @item @code{-L}, @code{--dereference} | ||
| 712 | Follow symbolic links when traversing files. | ||
| 713 | |||
| 714 | @item @code{-m}, @code{--megabytes} | ||
| 715 | Print file sizes in megabytes (like @code{--block-size=1048576}). | ||
| 716 | |||
| 717 | @item @code{-s}, @code{--summarize} | ||
| 718 | Don't recurse into subdirectories (like @code{--max-depth=0}). | ||
| 719 | |||
| 720 | @item @code{-x}, @code{--one-file-system} | ||
| 721 | Skip any directories that reside on different filesystems. | ||
| 722 | |||
| 723 | @end table | ||
| 610 | 724 | ||
| 611 | @item echo | ||
| 612 | @cmindex echo | 725 | @cmindex echo |
| 613 | Echoes its input. By default, this prints in a Lisp-friendly fashion | 726 | @item echo [-n | -N] [@var{arg}]@dots{} |
| 614 | (so that the value is useful to a Lisp command using the result of | 727 | Prints the value of each @var{arg}. By default, this prints in a |
| 615 | @command{echo} as an argument). If a single argument is passed, | 728 | Lisp-friendly fashion (so that the value is useful to a Lisp command |
| 616 | @command{echo} prints that; if multiple arguments are passed, it | 729 | using the result of @command{echo} as an argument). If a single |
| 617 | prints a list of all the arguments; otherwise, it prints the empty | 730 | argument is passed, @command{echo} prints that; if multiple arguments |
| 618 | string. | 731 | are passed, it prints a list of all the arguments; otherwise, it |
| 732 | prints the empty string. | ||
| 619 | 733 | ||
| 620 | @vindex eshell-plain-echo-behavior | 734 | @vindex eshell-plain-echo-behavior |
| 621 | If @code{eshell-plain-echo-behavior} is non-@code{nil}, @command{echo} | 735 | If @code{eshell-plain-echo-behavior} is non-@code{nil}, @command{echo} |
| 622 | will try to behave more like a plain shell's @command{echo}, printing | 736 | will try to behave more like a plain shell's @command{echo}, printing |
| 623 | each argument as a string, separated by a space. | 737 | each argument as a string, separated by a space. |
| 624 | 738 | ||
| 625 | @item env | 739 | You can control whether @command{echo} outputs a trailing newline |
| 740 | using @code{-n} to disable the trailing newline (the default behavior) | ||
| 741 | or @code{-N} to enable it (the default when | ||
| 742 | @code{eshell-plain-echo-behavior} is non-@code{nil}). | ||
| 743 | |||
| 626 | @cmindex env | 744 | @cmindex env |
| 745 | @item env [@var{var}=@var{value}]@dots{} [@var{command}]@dots{} | ||
| 627 | With no arguments, print the current environment variables. If you | 746 | With no arguments, print the current environment variables. If you |
| 628 | pass arguments to this command, then @command{env} will execute the | 747 | pass arguments to this command, then @command{env} will execute the |
| 629 | arguments as a command. If you pass any initial arguments of the form | 748 | arguments as a command. If you pass any initial arguments of the form |
| 630 | @samp{@var{var}=@var{value}}, @command{env} will first set @var{var} | 749 | @samp{@var{var}=@var{value}}, @command{env} will first set @var{var} |
| 631 | to @var{value} before running the command. | 750 | to @var{value} before running the command. |
| 632 | 751 | ||
| 633 | @item eshell-debug | ||
| 634 | @cmindex eshell-debug | 752 | @cmindex eshell-debug |
| 753 | @item eshell-debug [error | form | process]@dots{} | ||
| 635 | Toggle debugging information for Eshell itself. You can pass this | 754 | Toggle debugging information for Eshell itself. You can pass this |
| 636 | command one or more of the following arguments: | 755 | command one or more of the following arguments: |
| 637 | 756 | ||
| @@ -651,72 +770,95 @@ buffer @code{*eshell last cmd*}; or | |||
| 651 | 770 | ||
| 652 | @end itemize | 771 | @end itemize |
| 653 | 772 | ||
| 654 | @item exit | ||
| 655 | @cmindex exit | 773 | @cmindex exit |
| 774 | @item exit | ||
| 656 | @vindex eshell-kill-on-exit | 775 | @vindex eshell-kill-on-exit |
| 657 | Exit Eshell and save the history. By default, this command kills the | 776 | Exit Eshell and save the history. By default, this command kills the |
| 658 | Eshell buffer, but if @code{eshell-kill-on-exit} is @code{nil}, then | 777 | Eshell buffer, but if @code{eshell-kill-on-exit} is @code{nil}, then |
| 659 | the buffer is merely buried instead. | 778 | the buffer is merely buried instead. |
| 660 | 779 | ||
| 661 | @item export | ||
| 662 | @cmindex export | 780 | @cmindex export |
| 781 | @item export [@var{name}=@var{value}]@dots{} | ||
| 663 | Set environment variables using input like Bash's @command{export}, as | 782 | Set environment variables using input like Bash's @command{export}, as |
| 664 | in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}. | 783 | in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}. |
| 665 | 784 | ||
| 666 | @item grep | ||
| 667 | @cmindex grep | 785 | @cmindex grep |
| 668 | @itemx agrep | 786 | @item grep [@var{arg}]@dots{} |
| 669 | @cmindex agrep | 787 | @cmindex agrep |
| 670 | @itemx egrep | 788 | @itemx agrep [@var{arg}]@dots{} |
| 671 | @cmindex egrep | 789 | @cmindex egrep |
| 672 | @itemx fgrep | 790 | @itemx egrep [@var{arg}]@dots{} |
| 673 | @cmindex fgrep | 791 | @cmindex fgrep |
| 674 | @itemx rgrep | 792 | @itemx fgrep [@var{arg}]@dots{} |
| 675 | @cmindex rgrep | 793 | @cmindex rgrep |
| 676 | @itemx glimpse | 794 | @itemx rgrep [@var{arg}]@dots{} |
| 677 | @cmindex glimpse | 795 | @cmindex glimpse |
| 796 | @itemx glimpse [@var{arg}]@dots{} | ||
| 678 | The @command{grep} commands are compatible with GNU @command{grep}, | 797 | The @command{grep} commands are compatible with GNU @command{grep}, |
| 679 | but use Emacs's internal @code{grep} instead. | 798 | but open a compilation buffer in @code{grep-mode} instead. |
| 680 | @xref{Grep Searching, , , emacs, The GNU Emacs Manual}. | 799 | @xref{Grep Searching, , , emacs, The GNU Emacs Manual}. |
| 681 | 800 | ||
| 682 | @vindex eshell-plain-grep-behavior | 801 | @vindex eshell-plain-grep-behavior |
| 683 | If @code{eshell-plain-grep-behavior} is non-@code{nil}, then these | 802 | If @code{eshell-plain-grep-behavior} is non-@code{nil}, then these |
| 684 | commands do not use Emacs's internal @code{grep}. This is the same as | 803 | commands do not use open a compilation buffer, instead printing output |
| 685 | using @samp{alias grep '*grep $@@*'}, though this setting applies to | 804 | to Eshell's buffer. This is the same as using @samp{alias grep '*grep |
| 686 | all of the built-in commands for which you would need to create a | 805 | $@@*'}, though this setting applies to all of the built-in commands |
| 687 | separate alias. | 806 | for which you would need to create a separate alias. |
| 688 | 807 | ||
| 689 | @item history | ||
| 690 | @cmindex history | 808 | @cmindex history |
| 691 | Prints Eshell's input history. With a numeric argument @var{N}, this | 809 | @item history [@var{n}] |
| 692 | command prints the @var{N} most recent items in the history. | 810 | @itemx history [-arw] [@var{filename}] |
| 811 | Prints Eshell's input history. With a numeric argument @var{n}, this | ||
| 812 | command prints the @var{n} most recent items in the history. | ||
| 813 | Alternately, you can specify the following options: | ||
| 814 | |||
| 815 | @table @asis | ||
| 816 | |||
| 817 | @item @code{-a}, @code{--append} | ||
| 818 | Append new history items to the history file. | ||
| 819 | |||
| 820 | @item @code{-r}, @code{--read} | ||
| 821 | Read history items from the history file and append them to the | ||
| 822 | current shell's history. | ||
| 823 | |||
| 824 | @item @code{-w}, @code{--write} | ||
| 825 | Write the current history list to the history file. | ||
| 826 | |||
| 827 | @end table | ||
| 693 | 828 | ||
| 694 | @item info | ||
| 695 | @cmindex info | 829 | @cmindex info |
| 696 | Browse the available Info documentation. This command is the same as | 830 | @item info [@var{manual} [@var{item}]@dots{}] |
| 697 | the external @command{info} command, but uses Emacs's internal Info | 831 | Browse the available Info documentation. With no arguments, browse |
| 698 | reader. | 832 | the top-level menu. Otherwise, show the manual for @var{manual}, |
| 699 | @xref{Misc Help, , , emacs, The GNU Emacs Manual}. | 833 | selecting the menu entry for @var{item}. |
| 834 | |||
| 835 | This command is the same as the external @command{info} command, but | ||
| 836 | uses Emacs's internal Info reader. @xref{Misc Help, , , emacs, The | ||
| 837 | GNU Emacs Manual}. | ||
| 700 | 838 | ||
| 701 | @item jobs | ||
| 702 | @cmindex jobs | 839 | @cmindex jobs |
| 840 | @cindex processes, listing | ||
| 841 | @item jobs | ||
| 703 | List subprocesses of the Emacs process, if any, using the function | 842 | List subprocesses of the Emacs process, if any, using the function |
| 704 | @code{list-processes}. | 843 | @code{list-processes}. |
| 705 | 844 | ||
| 706 | @item kill | ||
| 707 | @cmindex kill | 845 | @cmindex kill |
| 846 | @cindex processes, signaling | ||
| 847 | @item kill [-@var{signal}] [@var{pid} | @var{process}] | ||
| 708 | Kill processes. Takes a PID or a process object and an optional | 848 | Kill processes. Takes a PID or a process object and an optional |
| 709 | signal specifier which can either be a number or a signal name. | 849 | @var{signal} specifier which can either be a number or a signal name. |
| 710 | 850 | ||
| 711 | @item listify | ||
| 712 | @cmindex listify | 851 | @cmindex listify |
| 713 | Eshell version of @code{list}. Allows you to create a list using Eshell | 852 | @item listify [@var{arg}]@dots{} |
| 714 | syntax, rather than Elisp syntax. For example, @samp{listify foo bar} | 853 | Return the arguments as a single list. With a single argument, return |
| 715 | and @code{("foo" "bar")} both evaluate to @code{("foo" "bar")}. | 854 | it as-is if it's already a list, or otherwise wrap it in a list. With |
| 855 | multiple arguments, return a list of all of them. | ||
| 716 | 856 | ||
| 717 | @item ln | ||
| 718 | @cmindex ln | 857 | @cmindex ln |
| 719 | Create links to files. | 858 | @item ln [@var{option}]@dots{} @var{target} [@var{link-name}] |
| 859 | @itemx ln [@var{option}]@dots{} @var{target}@dots{} @var{directory} | ||
| 860 | Create a link to the specified @var{target} named @var{link-name} or | ||
| 861 | create links to multiple @var{targets} in @var{directory}. | ||
| 720 | 862 | ||
| 721 | @vindex eshell-ln-overwrite-files | 863 | @vindex eshell-ln-overwrite-files |
| 722 | @vindex eshell-ln-interactive-query | 864 | @vindex eshell-ln-interactive-query |
| @@ -725,8 +867,31 @@ will overwrite files without warning. If | |||
| 725 | @code{eshell-ln-interactive-query} is non-@code{nil}, then | 867 | @code{eshell-ln-interactive-query} is non-@code{nil}, then |
| 726 | @command{ln} will ask before overwriting files. | 868 | @command{ln} will ask before overwriting files. |
| 727 | 869 | ||
| 728 | @item locate | 870 | @command{ln} accepts the following options: |
| 871 | |||
| 872 | @table @asis | ||
| 873 | |||
| 874 | @item @code{-f}, @code{--force} | ||
| 875 | Never prompt for confirmation before linking a target. | ||
| 876 | |||
| 877 | @item @code{-i}, @code{--interactive} | ||
| 878 | Prompt for confirmation before linking to an item if the source | ||
| 879 | already exists. | ||
| 880 | |||
| 881 | @item @code{-n}, @code{--preview} | ||
| 882 | Run the command, but don't move anything. This is useful if you | ||
| 883 | want to preview what would be linked when calling @command{ln}. | ||
| 884 | |||
| 885 | @item @code{-s}, @code{--symbolic} | ||
| 886 | Make symbolic links instead of hard links. | ||
| 887 | |||
| 888 | @item @code{-v}, @code{--verbose} | ||
| 889 | Print the name of each file before linking it. | ||
| 890 | |||
| 891 | @end table | ||
| 892 | |||
| 729 | @cmindex locate | 893 | @cmindex locate |
| 894 | @item locate @var{arg}@dots{} | ||
| 730 | Alias to Emacs's @code{locate} function, which simply runs the external | 895 | Alias to Emacs's @code{locate} function, which simply runs the external |
| 731 | @command{locate} command and parses the results. | 896 | @command{locate} command and parses the results. |
| 732 | @xref{Dired and Find, , , emacs, The GNU Emacs Manual}. | 897 | @xref{Dired and Find, , , emacs, The GNU Emacs Manual}. |
| @@ -736,51 +901,129 @@ If @code{eshell-plain-locate-behavior} is non-@code{nil}, then Emacs's | |||
| 736 | internal @code{locate} is not used. This is the same as using | 901 | internal @code{locate} is not used. This is the same as using |
| 737 | @samp{alias locate '*locate $@@*'}. | 902 | @samp{alias locate '*locate $@@*'}. |
| 738 | 903 | ||
| 739 | @item ls | ||
| 740 | @cmindex ls | 904 | @cmindex ls |
| 741 | Lists the contents of directories. | 905 | @item ls [@var{option}]@dots{} [@var{file}]@dots{} |
| 906 | List information about each @var{file}, including the contents of any | ||
| 907 | specified directories. If @var{file} is unspecified, list the | ||
| 908 | contents of the current directory. | ||
| 909 | |||
| 910 | @vindex eshell-ls-initial-args | ||
| 911 | The user option @code{eshell-ls-initial-args} contains a list of | ||
| 912 | arguments to include with any call to @command{ls}. For example, you | ||
| 913 | can include the option @option{-h} to always use a more human-readable | ||
| 914 | format. | ||
| 742 | 915 | ||
| 743 | @vindex eshell-ls-use-colors | 916 | @vindex eshell-ls-use-colors |
| 744 | If @code{eshell-ls-use-colors} is non-@code{nil}, the contents of a | 917 | If @code{eshell-ls-use-colors} is non-@code{nil}, the contents of a |
| 745 | directory is color-coded according to file type and status. These | 918 | directory is color-coded according to file type and status. These |
| 746 | colors and the regexps used to identify their corresponding files can | 919 | colors and the regexps used to identify their corresponding files can |
| 747 | be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls @key{RET}}}. | 920 | be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls |
| 921 | @key{RET}}}. | ||
| 922 | |||
| 923 | @command{ls} supports the following options: | ||
| 924 | |||
| 925 | @table @asis | ||
| 926 | |||
| 927 | @item @code{-a}, @code{--all} | ||
| 928 | List all files, including ones starting with @samp{.}. | ||
| 929 | |||
| 930 | @item @code{-A}, @code{--almost-all} | ||
| 931 | Like @code{--all}, but don't list the current directory (@file{.}) or | ||
| 932 | the parent directory (@file{..}). | ||
| 933 | |||
| 934 | @item @code{-c}, @code{--by-ctime} | ||
| 935 | Sort files by last status change time, with newest files first. | ||
| 936 | |||
| 937 | @item @code{-C} | ||
| 938 | List entries by columns. | ||
| 939 | |||
| 940 | @item @code{-d}, @code{--directory} | ||
| 941 | List directory entries instead of their contents. | ||
| 942 | |||
| 943 | @item @code{-h}, @code{--human-readable} | ||
| 944 | Print sizes in human-readable format, with binary prefixes (so 1 KB is | ||
| 945 | 1024 bytes). | ||
| 946 | |||
| 947 | @item @code{-H}, @code{--si} | ||
| 948 | Print sizes in human-readable format, with decimal prefixes (so 1 KB | ||
| 949 | is 1000 bytes). | ||
| 950 | |||
| 951 | @item @code{-I@var{pattern}}, @code{--ignore=@var{pattern}} | ||
| 952 | Don't list directory entries matching @var{pattern}. | ||
| 953 | |||
| 954 | @item @code{-k}, @code{--kilobytes} | ||
| 955 | Print sizes as 1024-byte kilobytes. | ||
| 748 | 956 | ||
| 749 | @vindex eshell-ls-date-format | 957 | @vindex eshell-ls-date-format |
| 750 | The user option @code{eshell-ls-date-format} determines how the date | 958 | @item @code{-l} |
| 751 | is displayed when using the @option{-l} option. The date is produced | 959 | Use a long listing format showing details for each file. The user |
| 752 | using the function @code{format-time-string} (@pxref{Time Parsing,,, | 960 | option @code{eshell-ls-date-format} determines how the date is |
| 753 | elisp, GNU Emacs Lisp Reference Manual}). | 961 | displayed when using this option. The date is produced using the |
| 962 | function @code{format-time-string} (@pxref{Time Parsing,,, elisp, GNU | ||
| 963 | Emacs Lisp Reference Manual}). | ||
| 754 | 964 | ||
| 755 | @vindex eshell-ls-initial-args | 965 | @item @code{-L}, @code{--dereference} |
| 756 | The user option @code{eshell-ls-initial-args} contains a list of | 966 | Follow symbolic links when listing entries. |
| 757 | arguments to include with any call to @command{ls}. For example, you | 967 | |
| 758 | can include the option @option{-h} to always use a more human-readable | 968 | @item @code{-n}, @code{--numeric-uid-gid} |
| 759 | format. | 969 | Show UIDs and GIDs numerically, instead of using their names. |
| 970 | |||
| 971 | @item @code{-r}, @code{--reverse} | ||
| 972 | Reverse order when sorting. | ||
| 973 | |||
| 974 | @item @code{-R}, @code{--recursive} | ||
| 975 | List subdirectories recursively. | ||
| 976 | |||
| 977 | @item @code{-s}, @code{--size} | ||
| 978 | Show the size of each file in blocks. | ||
| 760 | 979 | ||
| 761 | @vindex eshell-ls-default-blocksize | 980 | @vindex eshell-ls-default-blocksize |
| 762 | The user option @code{eshell-ls-default-blocksize} determines the | 981 | @item @code{-S} |
| 763 | default blocksize used when displaying file sizes with the option | 982 | Sort by file size, with largest files first. The user option |
| 764 | @option{-s}. | 983 | @code{eshell-ls-default-blocksize} determines the default blocksize |
| 984 | used when displaying file sizes with this option. | ||
| 985 | |||
| 986 | @item @code{-t} | ||
| 987 | Sort by modification time, with newest files first. | ||
| 988 | |||
| 989 | @item @code{-u} | ||
| 990 | Sort by last access time, with newest files first. | ||
| 991 | |||
| 992 | @item @code{-U} | ||
| 993 | Do not sort results. Instead, list entries in their directory order. | ||
| 994 | |||
| 995 | @item @code{-x} | ||
| 996 | List entries by lines instead of by columns. | ||
| 997 | |||
| 998 | @item @code{-X} | ||
| 999 | Sort alphabetically by file extension. | ||
| 1000 | |||
| 1001 | @item @code{-1} | ||
| 1002 | List one file per line. | ||
| 1003 | |||
| 1004 | @end table | ||
| 765 | 1005 | ||
| 766 | @item make | ||
| 767 | @cmindex make | 1006 | @cmindex make |
| 1007 | @item make [@var{arg}]@dots{} | ||
| 768 | Run @command{make} through @code{compile} when run asynchronously | 1008 | Run @command{make} through @code{compile} when run asynchronously |
| 769 | (e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs | 1009 | (e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs |
| 770 | Manual}. Otherwise call the external @command{make} command. | 1010 | Manual}. Otherwise call the external @command{make} command. |
| 771 | 1011 | ||
| 772 | @item man | ||
| 773 | @cmindex man | 1012 | @cmindex man |
| 1013 | @item man [@var{arg}]@dots{} | ||
| 774 | Display Man pages using the Emacs @code{man} command. | 1014 | Display Man pages using the Emacs @code{man} command. |
| 775 | @xref{Man Page, , , emacs, The GNU Emacs Manual}. | 1015 | @xref{Man Page, , , emacs, The GNU Emacs Manual}. |
| 776 | 1016 | ||
| 777 | @item mkdir | ||
| 778 | @cmindex mkdir | 1017 | @cmindex mkdir |
| 779 | Make new directories. | 1018 | @item mkdir [-p] @var{directory}@dots{} |
| 1019 | Make new directories. With @code{-p} or @code{--parents}, | ||
| 1020 | automatically make any necessary parent directories as well. | ||
| 780 | 1021 | ||
| 781 | @item mv | ||
| 782 | @cmindex mv | 1022 | @cmindex mv |
| 783 | Move or rename files. | 1023 | @item mv [@var{option}]@dots{} @var{source} @var{dest} |
| 1024 | @itemx mv [@var{option}]@dots{} @var{source}@dots{} @var{directory} | ||
| 1025 | Rename the file @var{source} to @var{dest} or move @var{source} into | ||
| 1026 | @var{directory}. | ||
| 784 | 1027 | ||
| 785 | @vindex eshell-mv-overwrite-files | 1028 | @vindex eshell-mv-overwrite-files |
| 786 | @vindex eshell-mv-interactive-query | 1029 | @vindex eshell-mv-interactive-query |
| @@ -789,40 +1032,95 @@ will overwrite files without warning. If | |||
| 789 | @code{eshell-mv-interactive-query} is non-@code{nil}, @command{mv} | 1032 | @code{eshell-mv-interactive-query} is non-@code{nil}, @command{mv} |
| 790 | will prompt before overwriting anything. | 1033 | will prompt before overwriting anything. |
| 791 | 1034 | ||
| 792 | @item occur | 1035 | @command{mv} accepts the following options: |
| 1036 | |||
| 1037 | @table @asis | ||
| 1038 | |||
| 1039 | @item @code{-f}, @code{--force} | ||
| 1040 | Never prompt for confirmation before moving an item. | ||
| 1041 | |||
| 1042 | @item @code{-i}, @code{--interactive} | ||
| 1043 | Prompt for confirmation before moving an item if the target already | ||
| 1044 | exists. | ||
| 1045 | |||
| 1046 | @item @code{-n}, @code{--preview} | ||
| 1047 | Run the command, but don't move anything. This is useful if you | ||
| 1048 | want to preview what would be moved when calling @command{mv}. | ||
| 1049 | |||
| 1050 | @item @code{-v}, @code{--verbose} | ||
| 1051 | Print the name of each item before moving it. | ||
| 1052 | |||
| 1053 | @end table | ||
| 1054 | |||
| 793 | @cmindex occur | 1055 | @cmindex occur |
| 1056 | @item occur @var{regexp} [@var{nlines}] | ||
| 794 | Alias to Emacs's @code{occur}. | 1057 | Alias to Emacs's @code{occur}. |
| 795 | @xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}. | 1058 | @xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}. |
| 796 | 1059 | ||
| 797 | @item popd | ||
| 798 | @cmindex popd | 1060 | @cmindex popd |
| 1061 | @cindex directory stack, removing from | ||
| 1062 | @item popd | ||
| 1063 | @item popd +@var{n} | ||
| 799 | Pop a directory from the directory stack and switch to a another place | 1064 | Pop a directory from the directory stack and switch to a another place |
| 800 | in the stack. | 1065 | in the stack. This command can take the following forms: |
| 1066 | |||
| 1067 | @table @code | ||
| 1068 | |||
| 1069 | @item popd | ||
| 1070 | Remove the current directory from the directory stack and change to | ||
| 1071 | the directory beneath it. | ||
| 1072 | |||
| 1073 | @item popd +@var{n} | ||
| 1074 | Remove the current directory from the directory stack and change to | ||
| 1075 | the @var{nth} directory in the stack (counting from zero). | ||
| 1076 | |||
| 1077 | @end table | ||
| 801 | 1078 | ||
| 802 | @item printnl | ||
| 803 | @cmindex printnl | 1079 | @cmindex printnl |
| 804 | Print the arguments separated by newlines. | 1080 | @item printnl [@var{arg}]@dots{} |
| 1081 | Print all the @var{arg}s separated by newlines. | ||
| 805 | 1082 | ||
| 806 | @item pushd | ||
| 807 | @cmindex pushd | 1083 | @cmindex pushd |
| 1084 | @cindex directory stack, adding to | ||
| 1085 | @item pushd | ||
| 1086 | @itemx pushd @var{directory} | ||
| 1087 | @itemx pushd +@var{n} | ||
| 808 | Push the current directory onto the directory stack, then change to | 1088 | Push the current directory onto the directory stack, then change to |
| 809 | another directory. | 1089 | another directory. This command can take the following forms: |
| 1090 | |||
| 1091 | @table @code | ||
| 1092 | |||
| 1093 | @vindex eshell-pushd-tohome | ||
| 1094 | @item pushd | ||
| 1095 | Swap the current directory with the directory on the top of the stack. | ||
| 1096 | If @code{eshell-pushd-tohome} is non-@code{nil}, push the current | ||
| 1097 | directory onto the stack and change to the user's home directory (like | ||
| 1098 | @samp{pushd ~}). | ||
| 810 | 1099 | ||
| 811 | @vindex eshell-pushd-dunique | 1100 | @vindex eshell-pushd-dunique |
| 1101 | @item pushd @var{directory} | ||
| 1102 | Push the current directory onto the stack and change to | ||
| 1103 | @var{directory}. If @code{eshell-pushd-dunique} is non-@code{nil}, | ||
| 1104 | then only unique directories will be added to the stack. | ||
| 1105 | |||
| 812 | @vindex eshell-pushd-dextract | 1106 | @vindex eshell-pushd-dextract |
| 813 | If @code{eshell-pushd-dunique} is non-@code{nil}, then only unique | 1107 | @item pushd +@var{n} |
| 814 | directories will be added to the stack. If | 1108 | Change to the @var{nth} directory in the directory stack (counting |
| 815 | @code{eshell-pushd-dextract} is non-@code{nil}, then @samp{pushd | 1109 | from zero), and ``rotate'' the stack by moving any elements before the |
| 816 | +@var{n}} will pop the @var{n}th directory to the top of the stack. | 1110 | @var{nth} to the bottom. If @code{eshell-pushd-dextract} is |
| 1111 | non-@code{nil}, then @samp{pushd +@var{n}} will instead pop the | ||
| 1112 | @var{n}th directory to the top of the stack. | ||
| 1113 | |||
| 1114 | @end table | ||
| 817 | 1115 | ||
| 818 | @item pwd | ||
| 819 | @cmindex pwd | 1116 | @cmindex pwd |
| 1117 | @item pwd | ||
| 820 | Prints the current working directory. | 1118 | Prints the current working directory. |
| 821 | 1119 | ||
| 822 | @item rm | ||
| 823 | @cmindex rm | 1120 | @cmindex rm |
| 1121 | @item rm [@var{option}]@dots{} @var{item}@dots{} | ||
| 824 | Removes files, buffers, processes, or Emacs Lisp symbols, depending on | 1122 | Removes files, buffers, processes, or Emacs Lisp symbols, depending on |
| 825 | the argument. | 1123 | the type of each @var{item}. |
| 826 | 1124 | ||
| 827 | @vindex eshell-rm-interactive-query | 1125 | @vindex eshell-rm-interactive-query |
| 828 | @vindex eshell-rm-removes-directories | 1126 | @vindex eshell-rm-removes-directories |
| @@ -832,59 +1130,89 @@ will prompt before removing anything. If | |||
| 832 | @command{rm} can also remove directories. Otherwise, @command{rmdir} | 1130 | @command{rm} can also remove directories. Otherwise, @command{rmdir} |
| 833 | is required. | 1131 | is required. |
| 834 | 1132 | ||
| 835 | @item rmdir | 1133 | @command{rm} accepts the following options: |
| 1134 | |||
| 1135 | @table @asis | ||
| 1136 | |||
| 1137 | @item @code{-f}, @code{--force} | ||
| 1138 | Never prompt for confirmation before removing an item. | ||
| 1139 | |||
| 1140 | @item @code{-i}, @code{--interactive} | ||
| 1141 | Prompt for confirmation before removing each item. | ||
| 1142 | |||
| 1143 | @item @code{-n}, @code{--preview} | ||
| 1144 | Run the command, but don't remove anything. This is useful if you | ||
| 1145 | want to preview what would be removed when calling @command{rm}. | ||
| 1146 | |||
| 1147 | @item @code{-r}, @code{-R}, @code{--recursive} | ||
| 1148 | Remove any specified directories and their contents recursively. | ||
| 1149 | |||
| 1150 | @item @code{-v}, @code{--verbose} | ||
| 1151 | Print the name of each item before removing it. | ||
| 1152 | |||
| 1153 | @end table | ||
| 1154 | |||
| 836 | @cmindex rmdir | 1155 | @cmindex rmdir |
| 1156 | @item rmdir @var{directory}@dots{} | ||
| 837 | Removes directories if they are empty. | 1157 | Removes directories if they are empty. |
| 838 | 1158 | ||
| 839 | @item set | ||
| 840 | @cmindex set | 1159 | @cmindex set |
| 1160 | @item set [@var{var} @var{value}]@dots{} | ||
| 841 | Set variable values, using the function @code{set} like a command | 1161 | Set variable values, using the function @code{set} like a command |
| 842 | (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). | 1162 | (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). |
| 843 | A variable name can be a symbol, in which case it refers to a Lisp | 1163 | The value of @var{var} can be a symbol, in which case it refers to a |
| 844 | variable, or a string, referring to an environment variable | 1164 | Lisp variable, or a string, referring to an environment variable |
| 845 | (@pxref{Arguments}). | 1165 | (@pxref{Arguments}). |
| 846 | 1166 | ||
| 847 | @item setq | ||
| 848 | @cmindex setq | 1167 | @cmindex setq |
| 1168 | @item setq [@var{symbol} @var{value}]@dots{} | ||
| 849 | Set variable values, using the function @code{setq} like a command | 1169 | Set variable values, using the function @code{setq} like a command |
| 850 | (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). | 1170 | (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). |
| 851 | 1171 | ||
| 852 | @item source | ||
| 853 | @cmindex source | 1172 | @cmindex source |
| 854 | Source an Eshell file in a subshell environment. This is not to be | 1173 | @item source @var{file} [@var{argument}]@dots{} |
| 855 | confused with the command @command{.}, which sources a file in the | 1174 | Source an Eshell script named @var{file} in a subshell environment, |
| 856 | current environment. | 1175 | passing any @var{argument}s to the script (@pxref{Scripts}). This is |
| 1176 | not to be confused with the command @command{.}, which sources a file | ||
| 1177 | in the current environment. | ||
| 857 | 1178 | ||
| 858 | @item time | ||
| 859 | @cmindex time | 1179 | @cmindex time |
| 860 | Show the time elapsed during a command's execution. | 1180 | @item time @var{command}@dots{} |
| 1181 | Show the time elapsed during the execution of @var{command}. | ||
| 861 | 1182 | ||
| 862 | @item umask | ||
| 863 | @cmindex umask | 1183 | @cmindex umask |
| 864 | Set or view the default file permissions for newly created files and | 1184 | @item umask [-S] |
| 865 | directories. | 1185 | @itemx umask @var{mode} |
| 1186 | View the default file permissions for newly created files and | ||
| 1187 | directories. If you pass @code{-S} or @code{--symbolic}, view the | ||
| 1188 | mode symbolically. With @var{mode}, set the default permissions to | ||
| 1189 | this value. | ||
| 866 | 1190 | ||
| 867 | @item unset | ||
| 868 | @cmindex unset | 1191 | @cmindex unset |
| 869 | Unset one or more variables. As with @command{set}, a variable name | 1192 | @item unset [@var{var}]@dots{} |
| 870 | can be a symbol, in which case it refers to a Lisp variable, or a | 1193 | Unset one or more variables. As with @command{set}, the value of |
| 871 | string, referring to an environment variable. | 1194 | @var{var} can be a symbol, in which case it refers to a Lisp variable, |
| 1195 | or a string, referring to an environment variable. | ||
| 872 | 1196 | ||
| 873 | @item wait | ||
| 874 | @cmindex wait | 1197 | @cmindex wait |
| 875 | Wait until a process has successfully completed. | 1198 | @cindex processes, waiting for |
| 1199 | @item wait [@var{process}]@dots{} | ||
| 1200 | Wait until each specified @var{process} has exited. | ||
| 876 | 1201 | ||
| 877 | @item which | ||
| 878 | @cmindex which | 1202 | @cmindex which |
| 879 | Identify a command and its location. | 1203 | @item which @var{command}@dots{} |
| 1204 | For each @var{command}, identify what kind of command it is and its | ||
| 1205 | location. | ||
| 880 | 1206 | ||
| 881 | @item whoami | ||
| 882 | @cmindex whoami | 1207 | @cmindex whoami |
| 883 | Print the current user. This Eshell version of @command{whoami} | 1208 | @item whoami |
| 884 | supports Tramp. | 1209 | Print the current user. This Eshell version of @command{whoami} is |
| 1210 | connection-aware, so for remote directories, it will print the user | ||
| 1211 | associated with that connection. | ||
| 885 | @end table | 1212 | @end table |
| 886 | 1213 | ||
| 887 | @subsection Defining new built-in commands | 1214 | @node Defining New Built-ins |
| 1215 | @subsection Defining New Built-in Commands | ||
| 888 | While Eshell can run Lisp functions directly as commands, it may be | 1216 | While Eshell can run Lisp functions directly as commands, it may be |
| 889 | more convenient to provide a special built-in command for | 1217 | more convenient to provide a special built-in command for |
| 890 | Eshell. Built-in commands are just ordinary Lisp functions designed | 1218 | Eshell. Built-in commands are just ordinary Lisp functions designed |
| @@ -1180,7 +1508,7 @@ create and switch to a directory called @samp{foo}. | |||
| 1180 | 1508 | ||
| 1181 | @node Remote Access | 1509 | @node Remote Access |
| 1182 | @section Remote Access | 1510 | @section Remote Access |
| 1183 | @cmindex remote access | 1511 | @cindex remote access |
| 1184 | 1512 | ||
| 1185 | Since Eshell uses Emacs facilities for most of its functionality, you | 1513 | Since Eshell uses Emacs facilities for most of its functionality, you |
| 1186 | can access remote hosts transparently. To connect to a remote host, | 1514 | can access remote hosts transparently. To connect to a remote host, |
| @@ -1353,6 +1681,11 @@ sequence of commands, as with almost any other shell script. Scripts | |||
| 1353 | are invoked from Eshell with @command{source}, or from anywhere in Emacs | 1681 | are invoked from Eshell with @command{source}, or from anywhere in Emacs |
| 1354 | with @code{eshell-source-file}. | 1682 | with @code{eshell-source-file}. |
| 1355 | 1683 | ||
| 1684 | Like with aliases (@pxref{Aliases}), Eshell scripts can accept any | ||
| 1685 | number of arguments. Within the script, you can refer to these with | ||
| 1686 | the special variables @code{$0}, @code{$1}, @dots{}, @code{$9}, and | ||
| 1687 | @code{$*}. | ||
| 1688 | |||
| 1356 | @cmindex . | 1689 | @cmindex . |
| 1357 | If you wish to load a script into your @emph{current} environment, | 1690 | If you wish to load a script into your @emph{current} environment, |
| 1358 | rather than in a subshell, use the @code{.} command. | 1691 | rather than in a subshell, use the @code{.} command. |
| @@ -1452,7 +1785,7 @@ As with @samp{$@{@var{command}@}}, evaluates the Eshell command invocation | |||
| 1452 | @command{@var{command}}, but writes the output to a temporary file and | 1785 | @command{@var{command}}, but writes the output to a temporary file and |
| 1453 | returns the file name. | 1786 | returns the file name. |
| 1454 | 1787 | ||
| 1455 | @item $@var{expr}[@var{i...}] | 1788 | @item $@var{expr}[@var{i@dots{}}] |
| 1456 | Expands to the @var{i}th element of the result of @var{expr}, an | 1789 | Expands to the @var{i}th element of the result of @var{expr}, an |
| 1457 | expression in one of the above forms listed here. If multiple indices | 1790 | expression in one of the above forms listed here. If multiple indices |
| 1458 | are supplied, this will return a list containing the elements for each | 1791 | are supplied, this will return a list containing the elements for each |
| @@ -1501,7 +1834,7 @@ Multiple sets of indices can also be specified. For example, if | |||
| 1501 | expand to @code{2}, i.e.@: the second element of the first list member | 1834 | expand to @code{2}, i.e.@: the second element of the first list member |
| 1502 | (all indices are zero-based). | 1835 | (all indices are zero-based). |
| 1503 | 1836 | ||
| 1504 | @item $@var{expr}[@var{regexp} @var{i...}] | 1837 | @item $@var{expr}[@var{regexp} @var{i@dots{}}] |
| 1505 | As above (when @var{expr} expands to a string), but use @var{regexp} | 1838 | As above (when @var{expr} expands to a string), but use @var{regexp} |
| 1506 | to split the string. @var{regexp} can be any form other than a | 1839 | to split the string. @var{regexp} can be any form other than a |
| 1507 | number. For example, @samp{$@var{var}[: 0]} will return the first | 1840 | number. For example, @samp{$@var{var}[: 0]} will return the first |
| @@ -2275,15 +2608,23 @@ external commands. To enable it, add @code{eshell-tramp} to | |||
| 2275 | 2608 | ||
| 2276 | @table @code | 2609 | @table @code |
| 2277 | 2610 | ||
| 2278 | @item su | ||
| 2279 | @cmindex su | 2611 | @cmindex su |
| 2280 | @itemx sudo | 2612 | @item su [- | -l] [@var{user}] |
| 2613 | Uses TRAMP's @command{su} method (@pxref{Inline methods, , , tramp, | ||
| 2614 | The Tramp Manual}) to change the current user to @var{user} (or root | ||
| 2615 | if unspecified). With @code{-}, @code{-l}, or @code{--login}, provide | ||
| 2616 | a login environment. | ||
| 2617 | |||
| 2281 | @cmindex sudo | 2618 | @cmindex sudo |
| 2282 | @itemx doas | 2619 | @item sudo [-u @var{user}] [-s | @var{command}@dots{}] |
| 2283 | @cmindex doas | 2620 | @cmindex doas |
| 2284 | Uses TRAMP's @command{su}, @command{sudo}, or @command{doas} method | 2621 | @itemx doas [-u @var{user}] [-s | @var{command}@dots{}] |
| 2285 | (@pxref{Inline methods, , , tramp, The Tramp Manual}) to run a command | 2622 | Uses TRAMP's @command{sudo} or @command{doas} method (@pxref{Inline |
| 2286 | via @command{su}, @command{sudo}, or @command{doas}. | 2623 | methods, , , tramp, The Tramp Manual}) to run @var{command} as root |
| 2624 | via @command{sudo} or @command{doas}. When specifying @code{-u | ||
| 2625 | @var{user}} or @code{--user @var{user}}, run the command as @var{user} | ||
| 2626 | instead. With @code{-s} or @code{--shell}, start a shell instead of | ||
| 2627 | running @var{command}. | ||
| 2287 | 2628 | ||
| 2288 | @end table | 2629 | @end table |
| 2289 | 2630 | ||
| @@ -2296,59 +2637,59 @@ add @code{eshell-xtra} to @code{eshell-modules-list}. | |||
| 2296 | 2637 | ||
| 2297 | @table @code | 2638 | @table @code |
| 2298 | 2639 | ||
| 2299 | @item count | ||
| 2300 | @cmindex count | 2640 | @cmindex count |
| 2641 | @item count @var{item} @var{seq} [@var{option}]@dots{} | ||
| 2301 | A wrapper around the function @code{cl-count} (@pxref{Searching | 2642 | A wrapper around the function @code{cl-count} (@pxref{Searching |
| 2302 | Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can | 2643 | Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can |
| 2303 | be used for comparing lists of strings. | 2644 | be used for comparing lists of strings. |
| 2304 | 2645 | ||
| 2305 | @item expr | ||
| 2306 | @cmindex expr | 2646 | @cmindex expr |
| 2647 | @item expr @var{str} [@var{separator}] [@var{arg}]@dots{} | ||
| 2307 | An implementation of @command{expr} using the Calc package. | 2648 | An implementation of @command{expr} using the Calc package. |
| 2308 | @xref{Top,,, calc, The GNU Emacs Calculator}. | 2649 | @xref{Top,,, calc, The GNU Emacs Calculator}. |
| 2309 | 2650 | ||
| 2310 | @item ff | ||
| 2311 | @cmindex ff | 2651 | @cmindex ff |
| 2652 | @item ff @var{directory} @var{pattern} | ||
| 2312 | Shorthand for the the function @code{find-name-dired} (@pxref{Dired | 2653 | Shorthand for the the function @code{find-name-dired} (@pxref{Dired |
| 2313 | and Find, , , emacs, The Emacs Editor}). | 2654 | and Find, , , emacs, The Emacs Editor}). |
| 2314 | 2655 | ||
| 2315 | @item gf | ||
| 2316 | @cmindex gf | 2656 | @cmindex gf |
| 2657 | @item gf @var{directory} @var{regexp} | ||
| 2317 | Shorthand for the the function @code{find-grep-dired} (@pxref{Dired | 2658 | Shorthand for the the function @code{find-grep-dired} (@pxref{Dired |
| 2318 | and Find, , , emacs, The Emacs Editor}). | 2659 | and Find, , , emacs, The Emacs Editor}). |
| 2319 | 2660 | ||
| 2320 | @item intersection | ||
| 2321 | @cmindex intersection | 2661 | @cmindex intersection |
| 2662 | @item intersection @var{list1} @var{list2} [@var{option}]@dots{} | ||
| 2322 | A wrapper around the function @code{cl-intersection} (@pxref{Lists as | 2663 | A wrapper around the function @code{cl-intersection} (@pxref{Lists as |
| 2323 | Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command | 2664 | Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command |
| 2324 | can be used for comparing lists of strings. | 2665 | can be used for comparing lists of strings. |
| 2325 | 2666 | ||
| 2326 | @item mismatch | ||
| 2327 | @cmindex mismatch | 2667 | @cmindex mismatch |
| 2668 | @item mismatch @var{seq1} @var{seq2} [@var{option}]@dots{} | ||
| 2328 | A wrapper around the function @code{cl-mismatch} (@pxref{Searching | 2669 | A wrapper around the function @code{cl-mismatch} (@pxref{Searching |
| 2329 | Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can | 2670 | Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can |
| 2330 | be used for comparing lists of strings. | 2671 | be used for comparing lists of strings. |
| 2331 | 2672 | ||
| 2332 | @item set-difference | ||
| 2333 | @cmindex set-difference | 2673 | @cmindex set-difference |
| 2674 | @item set-difference @var{list1} @var{list2} [@var{option}]@dots{} | ||
| 2334 | A wrapper around the function @code{cl-set-difference} (@pxref{Lists | 2675 | A wrapper around the function @code{cl-set-difference} (@pxref{Lists |
| 2335 | as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be | 2676 | as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be |
| 2336 | used for comparing lists of strings. | 2677 | used for comparing lists of strings. |
| 2337 | 2678 | ||
| 2338 | @item set-exclusive-or | ||
| 2339 | @cmindex set-exclusive-or | 2679 | @cmindex set-exclusive-or |
| 2680 | @item set-exclusive-or @var{list1} @var{list2} [@var{option}]@dots{} | ||
| 2340 | A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists | 2681 | A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists |
| 2341 | as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be | 2682 | as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be |
| 2342 | used for comparing lists of strings. | 2683 | used for comparing lists of strings. |
| 2343 | 2684 | ||
| 2344 | @item substitute | ||
| 2345 | @cmindex substitute | 2685 | @cmindex substitute |
| 2686 | @item substitute @var{new} @var{old} @var{seq} [@var{option}]@dots{} | ||
| 2346 | A wrapper around the function @code{cl-substitute} (@pxref{Sequence | 2687 | A wrapper around the function @code{cl-substitute} (@pxref{Sequence |
| 2347 | Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can | 2688 | Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can |
| 2348 | be used for comparing lists of strings. | 2689 | be used for comparing lists of strings. |
| 2349 | 2690 | ||
| 2350 | @item union | ||
| 2351 | @cmindex union | 2691 | @cmindex union |
| 2692 | @item union @var{list1} @var{list2} [@var{option}]@dots{} | ||
| 2352 | A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,, | 2693 | A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,, |
| 2353 | cl, GNU Emacs Common Lisp Emulation}). This command can be used for | 2694 | cl, GNU Emacs Common Lisp Emulation}). This command can be used for |
| 2354 | comparing lists of strings. | 2695 | comparing lists of strings. |
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 08554d0d9b9..419a5390374 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi | |||
| @@ -5832,10 +5832,11 @@ message to the mailing list, and include the original message | |||
| 5832 | @kindex S v @r{(Summary)} | 5832 | @kindex S v @r{(Summary)} |
| 5833 | @findex gnus-summary-very-wide-reply | 5833 | @findex gnus-summary-very-wide-reply |
| 5834 | Mail a very wide reply to the author of the current article | 5834 | Mail a very wide reply to the author of the current article |
| 5835 | (@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a reply | 5835 | (@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a |
| 5836 | that goes out to all people listed in the @code{To}, @code{From} (or | 5836 | reply that goes out to all people listed in the @code{To}, @code{From} |
| 5837 | @code{Reply-To}) and @code{Cc} headers in all the process/prefixed | 5837 | (or @code{Reply-To}) and @code{Cc} headers in all the process/prefixed |
| 5838 | articles. This command uses the process/prefix convention. | 5838 | articles. This command uses the process/prefix convention. If given a |
| 5839 | prefix argument, the body of the current article will also be yanked. | ||
| 5839 | 5840 | ||
| 5840 | @item S V | 5841 | @item S V |
| 5841 | @kindex S V @r{(Summary)} | 5842 | @kindex S V @r{(Summary)} |
| @@ -26694,9 +26695,12 @@ buffers. It is enabled with | |||
| 26694 | @table @kbd | 26695 | @table @kbd |
| 26695 | @item C-c C-m C-a | 26696 | @item C-c C-m C-a |
| 26696 | @findex gnus-dired-attach | 26697 | @findex gnus-dired-attach |
| 26698 | @vindex gnus-dired-attach-at-end | ||
| 26697 | @cindex attachments, selection via dired | 26699 | @cindex attachments, selection via dired |
| 26698 | Send dired's marked files as an attachment (@code{gnus-dired-attach}). | 26700 | Send dired's marked files as an attachment (@code{gnus-dired-attach}). |
| 26699 | You will be prompted for a message buffer. | 26701 | The function prompts for a message buffer, and by default attaches files |
| 26702 | to the end of that buffer; customize @code{gnus-dired-attach-at-end} to | ||
| 26703 | place the attachments at point instead. | ||
| 26700 | 26704 | ||
| 26701 | @item C-c C-m C-l | 26705 | @item C-c C-m C-l |
| 26702 | @findex gnus-dired-find-file-mailcap | 26706 | @findex gnus-dired-find-file-mailcap |
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index e8c382f5967..93d592193a0 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex | |||
| @@ -3,9 +3,9 @@ | |||
| 3 | % Load plain if necessary, i.e., if running under initex. | 3 | % Load plain if necessary, i.e., if running under initex. |
| 4 | \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi | 4 | \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi |
| 5 | % | 5 | % |
| 6 | \def\texinfoversion{2023-09-19.19} | 6 | \def\texinfoversion{2024-02-10.22} |
| 7 | % | 7 | % |
| 8 | % Copyright 1985, 1986, 1988, 1990-2023 Free Software Foundation, Inc. | 8 | % Copyright 1985, 1986, 1988, 1990-2024 Free Software Foundation, Inc. |
| 9 | % | 9 | % |
| 10 | % This texinfo.tex file is free software: you can redistribute it and/or | 10 | % This texinfo.tex file is free software: you can redistribute it and/or |
| 11 | % modify it under the terms of the GNU General Public License as | 11 | % modify it under the terms of the GNU General Public License as |
| @@ -5238,14 +5238,14 @@ $$% | |||
| 5238 | % the current value of \escapechar. | 5238 | % the current value of \escapechar. |
| 5239 | \def\escapeisbackslash{\escapechar=`\\} | 5239 | \def\escapeisbackslash{\escapechar=`\\} |
| 5240 | 5240 | ||
| 5241 | % Use \ in index files by default. texi2dvi didn't support @ as the escape | 5241 | % Uncomment to use \ in index files by default. Old texi2dvi (before 2019) |
| 5242 | % character (as it checked for "\entry" in the files, and not "@entry"). When | 5242 | % didn't support @ as the escape character (as it checked for "\entry" in |
| 5243 | % the new version of texi2dvi has had a chance to become more prevalent, then | 5243 | % the files, and not "@entry"). |
| 5244 | % the escape character can change back to @ again. This should be an easy | 5244 | % In the future we can remove this flag and simplify the code for |
| 5245 | % change to make now because both @ and \ are only used as escape characters in | 5245 | % index files and backslashes, once the support is no longer likely to be |
| 5246 | % index files, never standing for themselves. | 5246 | % useful. |
| 5247 | % | 5247 | % |
| 5248 | \set txiindexescapeisbackslash | 5248 | % \set txiindexescapeisbackslash |
| 5249 | 5249 | ||
| 5250 | % Write the entry in \indextext to the index file. | 5250 | % Write the entry in \indextext to the index file. |
| 5251 | % | 5251 | % |
| @@ -6137,8 +6137,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% | |||
| 6137 | % normally unnmhead0 calls unnumberedzzz: | 6137 | % normally unnmhead0 calls unnumberedzzz: |
| 6138 | \outer\parseargdef\unnumbered{\unnmhead0{#1}} | 6138 | \outer\parseargdef\unnumbered{\unnmhead0{#1}} |
| 6139 | \def\unnumberedzzz#1{% | 6139 | \def\unnumberedzzz#1{% |
| 6140 | \global\secno=0 \global\subsecno=0 \global\subsubsecno=0 | 6140 | \global\advance\unnumberedno by 1 |
| 6141 | \global\advance\unnumberedno by 1 | ||
| 6142 | % | 6141 | % |
| 6143 | % Since an unnumbered has no number, no prefix for figures. | 6142 | % Since an unnumbered has no number, no prefix for figures. |
| 6144 | \global\let\chaplevelprefix = \empty | 6143 | \global\let\chaplevelprefix = \empty |
| @@ -6194,8 +6193,8 @@ might help (with 'rm \jobname.?? \jobname.??s')% | |||
| 6194 | % normally calls unnumberedseczzz: | 6193 | % normally calls unnumberedseczzz: |
| 6195 | \outer\parseargdef\unnumberedsec{\unnmhead1{#1}} | 6194 | \outer\parseargdef\unnumberedsec{\unnmhead1{#1}} |
| 6196 | \def\unnumberedseczzz#1{% | 6195 | \def\unnumberedseczzz#1{% |
| 6197 | \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1 | 6196 | \global\advance\unnumberedno by 1 |
| 6198 | \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno.\the\secno}% | 6197 | \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno}% |
| 6199 | } | 6198 | } |
| 6200 | 6199 | ||
| 6201 | % Subsections. | 6200 | % Subsections. |
| @@ -6218,9 +6217,8 @@ might help (with 'rm \jobname.?? \jobname.??s')% | |||
| 6218 | % normally calls unnumberedsubseczzz: | 6217 | % normally calls unnumberedsubseczzz: |
| 6219 | \outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}} | 6218 | \outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}} |
| 6220 | \def\unnumberedsubseczzz#1{% | 6219 | \def\unnumberedsubseczzz#1{% |
| 6221 | \global\subsubsecno=0 \global\advance\subsecno by 1 | 6220 | \global\advance\unnumberedno by 1 |
| 6222 | \sectionheading{#1}{subsec}{Ynothing}% | 6221 | \sectionheading{#1}{subsec}{Ynothing}{\the\unnumberedno}% |
| 6223 | {\the\unnumberedno.\the\secno.\the\subsecno}% | ||
| 6224 | } | 6222 | } |
| 6225 | 6223 | ||
| 6226 | % Subsubsections. | 6224 | % Subsubsections. |
| @@ -6244,9 +6242,8 @@ might help (with 'rm \jobname.?? \jobname.??s')% | |||
| 6244 | % normally unnumberedsubsubseczzz: | 6242 | % normally unnumberedsubsubseczzz: |
| 6245 | \outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}} | 6243 | \outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}} |
| 6246 | \def\unnumberedsubsubseczzz#1{% | 6244 | \def\unnumberedsubsubseczzz#1{% |
| 6247 | \global\advance\subsubsecno by 1 | 6245 | \global\advance\unnumberedno by 1 |
| 6248 | \sectionheading{#1}{subsubsec}{Ynothing}% | 6246 | \sectionheading{#1}{subsubsec}{Ynothing}{\the\unnumberedno}% |
| 6249 | {\the\unnumberedno.\the\secno.\the\subsecno.\the\subsubsecno}% | ||
| 6250 | } | 6247 | } |
| 6251 | 6248 | ||
| 6252 | % These macros control what the section commands do, according | 6249 | % These macros control what the section commands do, according |
| @@ -8205,8 +8202,6 @@ might help (with 'rm \jobname.?? \jobname.??s')% | |||
| 8205 | \let\commondummyword\unmacrodo | 8202 | \let\commondummyword\unmacrodo |
| 8206 | \xdef\macrolist{\macrolist}% | 8203 | \xdef\macrolist{\macrolist}% |
| 8207 | \endgroup | 8204 | \endgroup |
| 8208 | \else | ||
| 8209 | \errmessage{Macro #1 not defined}% | ||
| 8210 | \fi | 8205 | \fi |
| 8211 | } | 8206 | } |
| 8212 | 8207 | ||
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 56945d3071c..09b875ad3fa 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi | |||
| @@ -523,9 +523,11 @@ is used as the group to change to. The default host name is the same. | |||
| 523 | @cindex @option{sudo} method | 523 | @cindex @option{sudo} method |
| 524 | @cindex method @option{doas} | 524 | @cindex method @option{doas} |
| 525 | @cindex @option{doas} method | 525 | @cindex @option{doas} method |
| 526 | @cindex method @option{androidsu} | ||
| 527 | @cindex @option{androidsu} method | ||
| 526 | 528 | ||
| 527 | If the @option{su}, @option{sudo} or @option{doas} option should be | 529 | If the @option{su}, @option{sudo} or @option{doas} option should be |
| 528 | performed on another host, it can be comnbined with a leading | 530 | performed on another host, it can be combined with a leading |
| 529 | @option{ssh} or @option{plink} option. That means that @value{tramp} | 531 | @option{ssh} or @option{plink} option. That means that @value{tramp} |
| 530 | connects first to the other host with non-administrative credentials, | 532 | connects first to the other host with non-administrative credentials, |
| 531 | and changes to administrative credentials on that host afterwards. In | 533 | and changes to administrative credentials on that host afterwards. In |
| @@ -533,6 +535,11 @@ a simple case, the syntax looks like | |||
| 533 | @file{@trampfn{ssh@value{postfixhop}user@@host|sudo,,/path/to/file}}. | 535 | @file{@trampfn{ssh@value{postfixhop}user@@host|sudo,,/path/to/file}}. |
| 534 | @xref{Ad-hoc multi-hops}. | 536 | @xref{Ad-hoc multi-hops}. |
| 535 | 537 | ||
| 538 | The @option{su} method and other shell-based methods conflict with | ||
| 539 | non-standard @command{su} implementations popular among Android users | ||
| 540 | and the restricted command-line utilities distributed with that system. | ||
| 541 | The @option{androidsu} method enables accessing files through | ||
| 542 | @command{su} on such systems, but multi-hops are not supported. | ||
| 536 | 543 | ||
| 537 | @anchor{Quick Start Guide sudoedit method} | 544 | @anchor{Quick Start Guide sudoedit method} |
| 538 | @section Using @command{sudoedit} | 545 | @section Using @command{sudoedit} |
| @@ -1059,6 +1066,20 @@ session. | |||
| 1059 | 1066 | ||
| 1060 | These methods support the @samp{-P} argument. | 1067 | These methods support the @samp{-P} argument. |
| 1061 | 1068 | ||
| 1069 | @item @option{dockercp} | ||
| 1070 | @item @option{podmancp} | ||
| 1071 | @cindex method @option{dockercp} | ||
| 1072 | @cindex @option{dockercp} method | ||
| 1073 | @cindex method @option{podmancp} | ||
| 1074 | @cindex @option{podmancp} method | ||
| 1075 | |||
| 1076 | These methods are similar to @option{docker} or @option{podman}, but | ||
| 1077 | they use the command @command{docker cp} or @command{podman cp} for | ||
| 1078 | transferring large files. | ||
| 1079 | |||
| 1080 | These copy commands do not support file globs, and they ignore a user | ||
| 1081 | name. | ||
| 1082 | |||
| 1062 | @item @option{fcp} | 1083 | @item @option{fcp} |
| 1063 | @cindex method @option{fcp} | 1084 | @cindex method @option{fcp} |
| 1064 | @cindex @option{fcp} method | 1085 | @cindex @option{fcp} method |
| @@ -5238,9 +5259,14 @@ Does @value{tramp} support @acronym{SSH} security keys? | |||
| 5238 | Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware | 5259 | Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware |
| 5239 | devices via special key types @option{*-sk}. @value{tramp} supports | 5260 | devices via special key types @option{*-sk}. @value{tramp} supports |
| 5240 | the additional handshaking messages for them. This requires at least | 5261 | the additional handshaking messages for them. This requires at least |
| 5241 | @command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible | 5262 | @command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} or |
| 5242 | security key, like yubikey, solokey, nitrokey, or titankey. | 5263 | @acronym{FIDO2} compatible security key, like yubikey, solokey, |
| 5243 | 5264 | nitrokey, or titankey. | |
| 5265 | @c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/} | ||
| 5266 | |||
| 5267 | @strong{Note} that there are reports on problems of handling FIDO2 | ||
| 5268 | (residential) keys by @command{ssh-agent}. As workaround, you might | ||
| 5269 | disable @command{ssh-agent} for such keys. | ||
| 5244 | 5270 | ||
| 5245 | @item | 5271 | @item |
| 5246 | @value{tramp} does not connect to Samba or MS Windows hosts running | 5272 | @value{tramp} does not connect to Samba or MS Windows hosts running |
diff --git a/doc/translations/README b/doc/translations/README new file mode 100644 index 00000000000..02edb829dcf --- /dev/null +++ b/doc/translations/README | |||
| @@ -0,0 +1,211 @@ | |||
| 1 | * Translating the Emacs manuals | ||
| 2 | |||
| 3 | ** Copyright assignment | ||
| 4 | |||
| 5 | People who contribute translated documents should provide a copyright | ||
| 6 | assignment to the Free Software Foundation. See the "Copyright | ||
| 7 | Assignment" section in the Emacs manual. | ||
| 8 | |||
| 9 | |||
| 10 | ** Translated documents license | ||
| 11 | |||
| 12 | The translated documents are distributed under the same license as the | ||
| 13 | original documents: the GNU Free Documentation License, Version 1.3 or | ||
| 14 | any later version published by the Free Software Foundation. | ||
| 15 | |||
| 16 | See https://www.gnu.org/licenses/fdl-1.3.html for more information. | ||
| 17 | |||
| 18 | If you have any questions regarding the use of the FDL license in your | ||
| 19 | translation work that do not appear in the FAQ, feel free to contact the | ||
| 20 | GNU project. | ||
| 21 | |||
| 22 | See https://www.gnu.org/contact/ for more information. | ||
| 23 | |||
| 24 | ** Location of the translated files | ||
| 25 | |||
| 26 | *** Texinfo source files | ||
| 27 | |||
| 28 | The source files of the translated manuals are located in the | ||
| 29 | doc/translations directory, under the sub-directory corresponding to the | ||
| 30 | translated language. | ||
| 31 | |||
| 32 | E.g., French manual sources are found under doc/translations/fr. | ||
| 33 | |||
| 34 | The structure of each language's folder should match that of the English | ||
| 35 | manuals (i.e. include misc, man, lispref, lispintro, emacs). | ||
| 36 | |||
| 37 | *** Built files | ||
| 38 | |||
| 39 | Translated deliverables in Info format are built at release time and are | ||
| 40 | made available for local installation. | ||
| 41 | |||
| 42 | |||
| 43 | ** Source files format | ||
| 44 | |||
| 45 | The manuals and their translations are written in the Texinfo format | ||
| 46 | (with the exception of the org-mode manual, which is written in Org, and | ||
| 47 | illustrations for the Introduction to Emacs Lisp Programming, which are | ||
| 48 | EPS files). | ||
| 49 | |||
| 50 | See https://www.gnu.org/software/Texinfo/ for more information. | ||
| 51 | |||
| 52 | You must install the Texinfo package in order to verify the translated | ||
| 53 | files, and refer to the Texinfo manual for information on the various | ||
| 54 | Texinfo features. | ||
| 55 | |||
| 56 | Emacs has a Texinfo mode that highlights the parts of the Texinfo code | ||
| 57 | to be translated for easy reference. | ||
| 58 | |||
| 59 | |||
| 60 | *** Texinfo specific issues | ||
| 61 | |||
| 62 | Until the Emacs/Texinfo projects provide better solutions, here are a | ||
| 63 | few rules to follow: | ||
| 64 | |||
| 65 | - Under each @node, add an @anchor that has the same content as the | ||
| 66 | original English @node. | ||
| 67 | |||
| 68 | - Translate the @node content but leave the @anchor in English. | ||
| 69 | |||
| 70 | - Most Emacs manuals are set to include the docstyle.Texi file. This | ||
| 71 | file adds the "@documentencoding UTF-8" directive to the targeted | ||
| 72 | manual. There is no need to add this directive in a manual that | ||
| 73 | includes docstyle.texi. | ||
| 74 | |||
| 75 | - Add a @documentlanguage directive that includes your language. | ||
| 76 | |||
| 77 | E.g., @documentlanguage zh | ||
| 78 | |||
| 79 | This directive currently has little effect but will be useful in the | ||
| 80 | future. | ||
| 81 | |||
| 82 | - The @author directive can be used for the translator's name. | ||
| 83 | |||
| 84 | E.g., @author traduit en français par Achile Talon | ||
| 85 | |||
| 86 | |||
| 87 | ** Fixing the original document | ||
| 88 | |||
| 89 | During the course of the translation, you might encounter passages in | ||
| 90 | the original document that need to be updated or otherwise corrected, or | ||
| 91 | even run into a bug in Emacs. If you cannot immediately correct the | ||
| 92 | problem, please file a bug report promptly. | ||
| 93 | |||
| 94 | See the 'Bugs' section in the Emacs manual. | ||
| 95 | |||
| 96 | ** Sending your contributions | ||
| 97 | |||
| 98 | Send your contributions (files or revisions) for review to the Emacs | ||
| 99 | development list at emacs-devel@gnu.org. Subscribing to the list is not | ||
| 100 | obligatory. | ||
| 101 | |||
| 102 | Always send contributions in the format of the original document. Most | ||
| 103 | of the content in the Emacs manuals is in Texinfo format, so please do | ||
| 104 | not send contributions in derivative formats (e.g. info, html, docbook, | ||
| 105 | plain text, etc.) | ||
| 106 | |||
| 107 | Before sending files for review, please ensure that they have been | ||
| 108 | thoroughly checked for spelling/grammar/typography by at least using the | ||
| 109 | tools provided by Emacs. | ||
| 110 | |||
| 111 | Please also make sure that the Texinfo files build properly on your | ||
| 112 | system. | ||
| 113 | |||
| 114 | Send your contributions as patches (git diff -p --stat), and prefer the | ||
| 115 | git format-patch form, since that format allows for easier review and | ||
| 116 | easier installation of the changes by the persons with write access to | ||
| 117 | the repository. | ||
| 118 | |||
| 119 | The Emacs project has a lot of coding, documentation and commenting | ||
| 120 | conventions. Sending such patches allows the project managers to make | ||
| 121 | sure that the contributions comply with the various conventions. | ||
| 122 | |||
| 123 | |||
| 124 | ** Discussing translation issues | ||
| 125 | |||
| 126 | Translation-related discussions are welcome on the emacs development | ||
| 127 | list. Discussions specific to your language do not have to be in | ||
| 128 | English. | ||
| 129 | |||
| 130 | |||
| 131 | ** Translation teams | ||
| 132 | |||
| 133 | The number of words in the Emacs manuals is over 2,000,000 words and | ||
| 134 | growing. While one individual could theoretically translate all the | ||
| 135 | files, it is more practical to work in language teams. | ||
| 136 | |||
| 137 | If you have a small group of translators willing to help, please make | ||
| 138 | sure that the files are properly reviewed before sending them to the | ||
| 139 | Emacs development list (see above). | ||
| 140 | |||
| 141 | Please refer to the translation-related documents maintained by the GNU | ||
| 142 | Project, and contact your language translation team to learn the | ||
| 143 | practices they have developed over the years. | ||
| 144 | |||
| 145 | See https://www.gnu.org/server/standards/README.translations.html for | ||
| 146 | more information. | ||
| 147 | |||
| 148 | |||
| 149 | ** Translation processes | ||
| 150 | |||
| 151 | Emacs does not yet provide tools that significantly help the translation | ||
| 152 | process. A few useful functions would be: | ||
| 153 | |||
| 154 | - automatic lookup of a list of glossary items when starting to work on | ||
| 155 | a translation "unit" (paragraph or otherwise); such glossary terms | ||
| 156 | should be easily insertable at point, | ||
| 157 | |||
| 158 | - automatic lookup of past translations to check for similarity and | ||
| 159 | improve homogeneity over the whole document set; such past translation | ||
| 160 | matches should be easily insertable at point, etc. | ||
| 161 | |||
| 162 | |||
| 163 | *** Using the PO format as an intermediate translation format | ||
| 164 | |||
| 165 | Although the PO format has not been developed with documentation in | ||
| 166 | mind, it is well-known among free software translation teams, and you | ||
| 167 | can easily use the po4a utility to convert Texinfo to PO for work in | ||
| 168 | translation tools that support the PO format. | ||
| 169 | |||
| 170 | See https://po4a.org for more information. | ||
| 171 | |||
| 172 | However, regardless of the intermediate file format that you might use, | ||
| 173 | you should only send files in the original format (Texinfo, org-mode, | ||
| 174 | eps) for review and installation. | ||
| 175 | |||
| 176 | |||
| 177 | *** Free tools that you can use in your processes | ||
| 178 | |||
| 179 | A number of free software tools are available outside the Emacs project, | ||
| 180 | to help translators (both amateur and professional) in the translation | ||
| 181 | process. | ||
| 182 | |||
| 183 | If they have any features that you think Emacs should implement, you are | ||
| 184 | welcome to provide patches to the Emacs project. | ||
| 185 | |||
| 186 | Such tools include: | ||
| 187 | |||
| 188 | - the GNOME Translation Editor, https://wiki.gnome.org/Apps/Gtranslator/ | ||
| 189 | - KDE's Lokalize, https://apps.kde.org/lokalize/ | ||
| 190 | - OmegaT, https://omegat.org | ||
| 191 | - the Okapi Framework, https://www.okapiframework.org | ||
| 192 | - pootle, https://pootle.translatehouse.org | ||
| 193 | |||
| 194 | etc. | ||
| 195 | |||
| 196 | |||
| 197 | * Licence of this document | ||
| 198 | |||
| 199 | Copyright (C) 2024 Free Software Foundation, Inc. | ||
| 200 | |||
| 201 | Copying and distribution of this file, with or without modification, are | ||
| 202 | permitted in any medium without royalty provided the copyright notice | ||
| 203 | and this notice are preserved. This file is offered as-is, without any | ||
| 204 | warranty. | ||
| 205 | |||
| 206 | |||
| 207 | Local Variables: | ||
| 208 | mode: outline | ||
| 209 | paragraph-separate: "[ ]*$" | ||
| 210 | coding: utf-8 | ||
| 211 | End: | ||
diff --git a/doc/lang/fr/misc/ses-fr.texi b/doc/translations/fr/misc/ses-fr.texi index e1b9cac5fc3..e1b9cac5fc3 100644 --- a/doc/lang/fr/misc/ses-fr.texi +++ b/doc/translations/fr/misc/ses-fr.texi | |||
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index f91d3fcb351..d7f513addfb 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS | |||
| @@ -334,6 +334,11 @@ has changed in some way. At present, ERC does not perform this step | |||
| 334 | automatically on your behalf, even if a change was made in a | 334 | automatically on your behalf, even if a change was made in a |
| 335 | 'Custom-mode' buffer or via 'setopt'. | 335 | 'Custom-mode' buffer or via 'setopt'. |
| 336 | 336 | ||
| 337 | ** New broadcast-oriented slash commands /AME, /GME, and /GMSG. | ||
| 338 | Also available as the library functions 'erc-cmd-AME', 'erc-cmd-GME', | ||
| 339 | and 'erc-cmd-GMSG', these new slash commands can prove handy in test | ||
| 340 | environments. | ||
| 341 | |||
| 337 | ** Miscellaneous UX changes. | 342 | ** Miscellaneous UX changes. |
| 338 | Some minor quality-of-life niceties have finally made their way to | 343 | Some minor quality-of-life niceties have finally made their way to |
| 339 | ERC. For example, fool visibility has become togglable with the new | 344 | ERC. For example, fool visibility has become togglable with the new |
| @@ -435,9 +440,12 @@ contains unique closures and thus no longer proves effective for | |||
| 435 | traversing inserted messages. For now, ERC only provides an internal | 440 | traversing inserted messages. For now, ERC only provides an internal |
| 436 | means of visiting messages, but a public interface is forthcoming. | 441 | means of visiting messages, but a public interface is forthcoming. |
| 437 | Also affecting the 'stamp' module is the deprecation of the function | 442 | Also affecting the 'stamp' module is the deprecation of the function |
| 438 | 'erc-insert-aligned' and its removal from client code. Additionally, | 443 | 'erc-insert-aligned' and its removal from the default client's code. |
| 439 | the module now merges its 'invisible' property with existing ones and | 444 | In the same library, the function 'erc-munge-invisibility-spec' has |
| 440 | includes all white space around stamps when doing so. | 445 | been renamed to 'erc-stamp--manage-local-options-state' to better |
| 446 | reflect its purpose. Additionally, the module now merges its | ||
| 447 | 'invisible' property with existing ones and includes all white space | ||
| 448 | around stamps when doing so. | ||
| 441 | 449 | ||
| 442 | This "propertizing" of surrounding white space extends to all | 450 | This "propertizing" of surrounding white space extends to all |
| 443 | 'stamp'-applied properties, like 'field', in all intervening space | 451 | 'stamp'-applied properties, like 'field', in all intervening space |
| @@ -499,6 +507,16 @@ encouraged to keep a module's name aligned with its group's as well as | |||
| 499 | the provided feature of its containing library, if only for the usual | 507 | the provided feature of its containing library, if only for the usual |
| 500 | reasons of namespace hygiene and discoverability. | 508 | reasons of namespace hygiene and discoverability. |
| 501 | 509 | ||
| 510 | *** The function 'erc-open' no longer uses the 'TGT-LIST' parameter. | ||
| 511 | ERC has always used the parameter to initialize the local variable | ||
| 512 | 'erc-default-recipients', which stores a list of routing targets with | ||
| 513 | the topmost considered "active." However, since at least ERC 5.1, a | ||
| 514 | buffer and its active target effectively mate for life, making | ||
| 515 | 'TGT-LIST', in practice, a read-only list of a single target. And | ||
| 516 | because that target must also appear as the 'CHANNEL' parameter, | ||
| 517 | 'TGT-LIST' mainly serves to reinforce 'erc-open's reputation of being | ||
| 518 | unruly. | ||
| 519 | |||
| 502 | *** ERC supports arbitrary CHANTYPES. | 520 | *** ERC supports arbitrary CHANTYPES. |
| 503 | Specifically, channels can be prefixed with any predesignated | 521 | Specifically, channels can be prefixed with any predesignated |
| 504 | character, mainly to afford more flexibility to specialty services, | 522 | character, mainly to afford more flexibility to specialty services, |
| @@ -681,8 +699,6 @@ by toggling a provided compatibility switch. See source code around | |||
| 681 | the function 'erc-send-action' for details. | 699 | the function 'erc-send-action' for details. |
| 682 | 700 | ||
| 683 | *** Miscellaneous changes | 701 | *** Miscellaneous changes |
| 684 | Two helper macros from GNU ELPA's Compat library are now available to | ||
| 685 | third-party modules as 'erc-compat-call' and 'erc-compat-function'. | ||
| 686 | In 'erc-button-alist', 'Info-goto-node' has been supplanted by plain | 702 | In 'erc-button-alist', 'Info-goto-node' has been supplanted by plain |
| 687 | old 'info', and the "<URL:...>" entry has been removed because it was | 703 | old 'info', and the "<URL:...>" entry has been removed because it was |
| 688 | more or less redundant. In all ERC buffers, the "<TAB>" key is now | 704 | more or less redundant. In all ERC buffers, the "<TAB>" key is now |
| @@ -1364,7 +1380,7 @@ reconnection attempts that ERC will make per server. | |||
| 1364 | in seconds, that ERC will wait between successive reconnect attempts. | 1380 | in seconds, that ERC will wait between successive reconnect attempts. |
| 1365 | 1381 | ||
| 1366 | *** erc-server-send-ping-timeout: Determines when to consider a connection | 1382 | *** erc-server-send-ping-timeout: Determines when to consider a connection |
| 1367 | stalled and restart it. The default is after 120 seconds. | 1383 | stalled and restart it. The default is after 120 seconds. |
| 1368 | 1384 | ||
| 1369 | *** erc-system-name: Determines the system name to use when logging in. | 1385 | *** erc-system-name: Determines the system name to use when logging in. |
| 1370 | The default is to figure this out by calling `system-name'. | 1386 | The default is to figure this out by calling `system-name'. |
| @@ -2325,7 +2341,7 @@ in XEmacs. | |||
| 2325 | Please use M-x customize-variable RET erc-modules RET to change the | 2341 | Please use M-x customize-variable RET erc-modules RET to change the |
| 2326 | default if it does not suite your needs. | 2342 | default if it does not suite your needs. |
| 2327 | 2343 | ||
| 2328 | ** THe symbol used in `erc-nickserv-passwords' for debian.org IRC servers | 2344 | ** The symbol used in `erc-nickserv-passwords' for debian.org IRC servers |
| 2329 | (formerly called OpenProjects, now FreeNode) has changed from | 2345 | (formerly called OpenProjects, now FreeNode) has changed from |
| 2330 | openprojects to freenode. You may need to update your configuration | 2346 | openprojects to freenode. You may need to update your configuration |
| 2331 | for a successful automatic nickserv identification. | 2347 | for a successful automatic nickserv identification. |
| @@ -76,7 +76,7 @@ see the variable 'url-request-extra-headers'. | |||
| 76 | 76 | ||
| 77 | +++ | 77 | +++ |
| 78 | ** 'completion-auto-help' now affects 'icomplete-in-buffer'. | 78 | ** 'completion-auto-help' now affects 'icomplete-in-buffer'. |
| 79 | Previously, completion-auto-help mostly affected only minibuffer | 79 | Previously, 'completion-auto-help' mostly affected only minibuffer |
| 80 | completion. Now, if 'completion-auto-help' has the value 'lazy', then | 80 | completion. Now, if 'completion-auto-help' has the value 'lazy', then |
| 81 | Icomplete's in-buffer display of possible completions will only appear | 81 | Icomplete's in-buffer display of possible completions will only appear |
| 82 | after the 'completion-at-point' command has been invoked twice, and if | 82 | after the 'completion-at-point' command has been invoked twice, and if |
| @@ -85,12 +85,12 @@ completely suppressed. Thus, if you use 'icomplete-in-buffer', ensure | |||
| 85 | 'completion-auto-help' is not customized to 'lazy' or nil. | 85 | 'completion-auto-help' is not customized to 'lazy' or nil. |
| 86 | 86 | ||
| 87 | +++ | 87 | +++ |
| 88 | ** The *Completions* buffer now always accompanies 'icomplete-in-buffer'. | 88 | ** The "*Completions*" buffer now always accompanies 'icomplete-in-buffer'. |
| 89 | Previously, it was not consistent when the *Completions* buffer would | 89 | Previously, it was not consistent whether the "*Completions*" buffer would |
| 90 | appear when using 'icomplete-in-buffer'. Now the *Completions* buffer | 90 | appear when using 'icomplete-in-buffer'. Now the "*Completions*" buffer |
| 91 | and Icomplete's in-buffer display of possible completions always | 91 | and Icomplete's in-buffer display of possible completions always |
| 92 | appear together. If you would prefer to see only Icomplete's | 92 | appear together. If you would prefer to see only Icomplete's |
| 93 | in-buffer display, and not the *Completions* buffer, you can add this | 93 | in-buffer display, and not the "*Completions*" buffer, you can add this |
| 94 | to your init: | 94 | to your init: |
| 95 | 95 | ||
| 96 | (advice-add 'completion-at-point :after #'minibuffer-hide-completions) | 96 | (advice-add 'completion-at-point :after #'minibuffer-hide-completions) |
| @@ -130,6 +130,17 @@ the signature) the automatically inferred function type as well. | |||
| 130 | This user option controls outline visibility in the output buffer of | 130 | This user option controls outline visibility in the output buffer of |
| 131 | 'describe-bindings' when 'describe-bindings-outline' is non-nil. | 131 | 'describe-bindings' when 'describe-bindings-outline' is non-nil. |
| 132 | 132 | ||
| 133 | --- | ||
| 134 | *** 'C-h m' ('describe-mode') uses outlining by default. | ||
| 135 | Set 'describe-mode-outline' to nil to get back the old behavior. | ||
| 136 | |||
| 137 | ** Outline Mode | ||
| 138 | |||
| 139 | +++ | ||
| 140 | *** 'outline-minor-mode' is supported in tree-sitter major modes. | ||
| 141 | It can be used in all tree-sitter major modes that set either the | ||
| 142 | variable 'treesit-simple-imenu-settings' or 'treesit-outline-predicate'. | ||
| 143 | |||
| 133 | ** X selection requests are now handled much faster and asynchronously. | 144 | ** X selection requests are now handled much faster and asynchronously. |
| 134 | This means it should be less necessary to disable the likes of | 145 | This means it should be less necessary to disable the likes of |
| 135 | 'select-active-regions' when Emacs is running over a slow network | 146 | 'select-active-regions' when Emacs is running over a slow network |
| @@ -258,7 +269,7 @@ right-aligned to is controlled by the new user option | |||
| 258 | 269 | ||
| 259 | ** Windows | 270 | ** Windows |
| 260 | 271 | ||
| 261 | *** New action alist entry 'post-command-select-window' for display-buffer. | 272 | *** New action alist entry 'post-command-select-window' for 'display-buffer'. |
| 262 | It specifies whether the window of the displayed buffer should be | 273 | It specifies whether the window of the displayed buffer should be |
| 263 | selected or deselected at the end of executing the current command. | 274 | selected or deselected at the end of executing the current command. |
| 264 | 275 | ||
| @@ -305,8 +316,17 @@ between the auto save file and the current file. | |||
| 305 | 316 | ||
| 306 | --- | 317 | --- |
| 307 | ** 'ffap-lax-url' now defaults to nil. | 318 | ** 'ffap-lax-url' now defaults to nil. |
| 308 | Previously, it was set to 'ffap-lax-url' to t but this broke remote file | 319 | Previously, it was set to t but this broke remote file name detection. |
| 309 | name detection. | 320 | |
| 321 | +++ | ||
| 322 | ** Multi-character key echo now ends with a suggestion to use Help. | ||
| 323 | Customize 'echo-keystrokes-help' to nil to prevent that. | ||
| 324 | |||
| 325 | +++ | ||
| 326 | ** 'read-passwd' can toggle the visibility of passwords. | ||
| 327 | Use 'TAB' in the minibuffer to show or hide the password. Likewise, | ||
| 328 | there is an icon on the mode-line, which toggles the visibility of the | ||
| 329 | password when clicking with 'mouse-1'. | ||
| 310 | 330 | ||
| 311 | 331 | ||
| 312 | * Editing Changes in Emacs 30.1 | 332 | * Editing Changes in Emacs 30.1 |
| @@ -318,7 +338,9 @@ will receive a 'wrap-prefix' automatically computed from the line's | |||
| 318 | surrounding context, such that continuation lines are indented on | 338 | surrounding context, such that continuation lines are indented on |
| 319 | display as if they were filled with 'M-q' or similar. Unlike 'M-q', | 339 | display as if they were filled with 'M-q' or similar. Unlike 'M-q', |
| 320 | the indentation only happens on display, and doesn't change the buffer | 340 | the indentation only happens on display, and doesn't change the buffer |
| 321 | text in any way. | 341 | text in any way. The global minor mode |
| 342 | 'global-visual-wrap-prefix-mode' enables this minor mode in all | ||
| 343 | buffers. | ||
| 322 | 344 | ||
| 323 | (This minor mode is the 'adaptive-wrap' ELPA package renamed and | 345 | (This minor mode is the 'adaptive-wrap' ELPA package renamed and |
| 324 | lightly edited for inclusion in Emacs.) | 346 | lightly edited for inclusion in Emacs.) |
| @@ -419,6 +441,11 @@ respectively, in addition to the existing translations 'C-x 8 / e' and | |||
| 419 | * Changes in Specialized Modes and Packages in Emacs 30.1 | 441 | * Changes in Specialized Modes and Packages in Emacs 30.1 |
| 420 | 442 | ||
| 421 | --- | 443 | --- |
| 444 | ** Titdic-cnv | ||
| 445 | Most of the variables and functions in the file have been renamed to | ||
| 446 | make sure they all use a 'tit-' namespace prefix. | ||
| 447 | |||
| 448 | --- | ||
| 422 | ** Trace | 449 | ** Trace |
| 423 | In batch mode, tracing now sends the trace to stdout. | 450 | In batch mode, tracing now sends the trace to stdout. |
| 424 | 451 | ||
| @@ -431,7 +458,7 @@ configurations such as X11 when the X server does not support at least | |||
| 431 | version 2.1 of the X Input Extension, and 'xterm-mouse-mode'. | 458 | version 2.1 of the X Input Extension, and 'xterm-mouse-mode'. |
| 432 | 459 | ||
| 433 | ** 'xterm-mouse-mode' | 460 | ** 'xterm-mouse-mode' |
| 434 | This mode now emits `wheel-up/down/right/left' events instead of | 461 | This mode now emits 'wheel-up/down/right/left' events instead of |
| 435 | 'mouse-4/5/6/7' events for the mouse wheel. | 462 | 'mouse-4/5/6/7' events for the mouse wheel. |
| 436 | It uses the 'mouse-wheel-up/down/left/right-event' | 463 | It uses the 'mouse-wheel-up/down/left/right-event' |
| 437 | variables to decide which button maps to which wheel event (if any). | 464 | variables to decide which button maps to which wheel event (if any). |
| @@ -440,11 +467,14 @@ variables to decide which button maps to which wheel event (if any). | |||
| 440 | 467 | ||
| 441 | --- | 468 | --- |
| 442 | *** New user option 'Info-url-alist'. | 469 | *** New user option 'Info-url-alist'. |
| 443 | This user option associates manual-names with URLs. It affects the | 470 | This user option associates manual names with URLs. It affects the |
| 444 | 'Info-goto-node-web' command. By default, associations for all | 471 | 'Info-goto-node-web' command. By default, associations for all |
| 445 | Emacs-included manuals are set. Further associations can be added for | 472 | Emacs-included manuals are set. Further associations can be added for |
| 446 | arbitrary Info manuals. | 473 | arbitrary Info manuals. |
| 447 | 474 | ||
| 475 | *** Emacs can now display Info manuals compressed with 'lzip'. | ||
| 476 | This requires the 'lzip' program to be installed on your system. | ||
| 477 | |||
| 448 | +++ | 478 | +++ |
| 449 | ** New command 'lldb'. | 479 | ** New command 'lldb'. |
| 450 | Run the LLDB debugger, analogous to the 'gud-gdb' command. | 480 | Run the LLDB debugger, analogous to the 'gud-gdb' command. |
| @@ -572,6 +602,14 @@ It allows tweaking the thresholds for rename and copy detection. | |||
| 572 | 602 | ||
| 573 | ** Diff mode | 603 | ** Diff mode |
| 574 | 604 | ||
| 605 | --- | ||
| 606 | *** New user option 'diff-refine-nonmodified'. | ||
| 607 | When this is non-nil, 'diff-refine' will highlight lines that were added | ||
| 608 | or removed in their entirety (as opposed to modified lines, where some | ||
| 609 | parts of the line were modified), using the same faces as for | ||
| 610 | highlighting the words added and removed within modified lines. The | ||
| 611 | default value is nil. | ||
| 612 | |||
| 575 | +++ | 613 | +++ |
| 576 | *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. | 614 | *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. |
| 577 | When called with a non-nil prefix argument, | 615 | When called with a non-nil prefix argument, |
| @@ -689,7 +727,7 @@ arguments of the form 'VAR=VALUE', 'env' will first set 'VAR' to | |||
| 689 | Now, you can pass an argument like "u+w,o-r" to Eshell's 'umask' | 727 | Now, you can pass an argument like "u+w,o-r" to Eshell's 'umask' |
| 690 | command, which will give write permission for owners of newly-created | 728 | command, which will give write permission for owners of newly-created |
| 691 | files and deny read permission for users who are not members of the | 729 | files and deny read permission for users who are not members of the |
| 692 | file's group. See the Info node '(coreutils)File permissions' for | 730 | file's group. See the Info node "(coreutils) File permissions" for |
| 693 | more information on this notation. | 731 | more information on this notation. |
| 694 | 732 | ||
| 695 | +++ | 733 | +++ |
| @@ -808,14 +846,14 @@ in the minibuffer history, with more recent candidates appearing first. | |||
| 808 | *** 'completion-category-overrides' supports more metadata. | 846 | *** 'completion-category-overrides' supports more metadata. |
| 809 | The new supported completion properties are 'cycle-sort-function', | 847 | The new supported completion properties are 'cycle-sort-function', |
| 810 | 'display-sort-function', 'annotation-function', 'affixation-function', | 848 | 'display-sort-function', 'annotation-function', 'affixation-function', |
| 811 | 'group-function'. You can now customize them for any category in | 849 | and 'group-function'. You can now customize them for any category in |
| 812 | 'completion-category-overrides' that will override the properties | 850 | 'completion-category-overrides' that will override the properties |
| 813 | defined in completion metadata. | 851 | defined in completion metadata. |
| 814 | 852 | ||
| 815 | +++ | 853 | +++ |
| 816 | *** 'completion-extra-properties' supports more metadata. | 854 | *** 'completion-extra-properties' supports more metadata. |
| 817 | The new supported completion properties are 'category', | 855 | The new supported completion properties are 'category', |
| 818 | 'group-function', 'display-sort-function', 'cycle-sort-function'. | 856 | 'group-function', 'display-sort-function', and 'cycle-sort-function'. |
| 819 | 857 | ||
| 820 | ** Pcomplete | 858 | ** Pcomplete |
| 821 | 859 | ||
| @@ -865,6 +903,16 @@ mode line. 'header' will display in the header line; | |||
| 865 | ** Tramp | 903 | ** Tramp |
| 866 | 904 | ||
| 867 | +++ | 905 | +++ |
| 906 | *** New connection method "androidsu". | ||
| 907 | This provides access to system files with elevated privileges granted by | ||
| 908 | the idiosyncratic 'su' implementations and system utilities customary on | ||
| 909 | Android. | ||
| 910 | |||
| 911 | +++ | ||
| 912 | *** New connection methods "dockercp" and "podmancp". | ||
| 913 | These are the external methods counterparts of "docker" and "podman". | ||
| 914 | |||
| 915 | +++ | ||
| 868 | *** New connection methods "toolbox" and "flatpak". | 916 | *** New connection methods "toolbox" and "flatpak". |
| 869 | They allow accessing system containers provided by Toolbox or | 917 | They allow accessing system containers provided by Toolbox or |
| 870 | sandboxes provided by Flatpak. | 918 | sandboxes provided by Flatpak. |
| @@ -1057,8 +1105,8 @@ which calls 'xref-find-definitions'. If the previous one worked | |||
| 1057 | better for you, use 'define-key' in your init script to bind | 1105 | better for you, use 'define-key' in your init script to bind |
| 1058 | 'js-find-symbol' to that combination again. | 1106 | 'js-find-symbol' to that combination again. |
| 1059 | 1107 | ||
| 1060 | ** Json mode | 1108 | ** Json mode. |
| 1061 | `js-json-mode` does not derive from `js-mode` any more so as not | 1109 | 'js-json-mode' does not derive from 'js-mode' any more so as not |
| 1062 | to confuse tools like Eglot or YASnippet into thinking that those | 1110 | to confuse tools like Eglot or YASnippet into thinking that those |
| 1063 | buffers contain Javascript code. | 1111 | buffers contain Javascript code. |
| 1064 | 1112 | ||
| @@ -1097,6 +1145,12 @@ The gmane.org website is, sadly, down since a number of years with no | |||
| 1097 | prospect of it coming back. Therefore, it is no longer valid to set | 1145 | prospect of it coming back. Therefore, it is no longer valid to set |
| 1098 | the user option 'nnweb-type' to 'gmane'. | 1146 | the user option 'nnweb-type' to 'gmane'. |
| 1099 | 1147 | ||
| 1148 | --- | ||
| 1149 | *** New user option 'gnus-mode-line-logo'. | ||
| 1150 | This allows the user to either disable the display of any logo or | ||
| 1151 | specify which logo will be displayed as part of the | ||
| 1152 | buffer-identification in the mode-line of Gnus buffers. | ||
| 1153 | |||
| 1100 | ** Rmail | 1154 | ** Rmail |
| 1101 | 1155 | ||
| 1102 | --- | 1156 | --- |
| @@ -1168,6 +1222,11 @@ Previously, the '@' character, which normally has 'symbol' syntax, | |||
| 1168 | would combine with a following Lisp symbol and interfere with symbol | 1222 | would combine with a following Lisp symbol and interfere with symbol |
| 1169 | searching. | 1223 | searching. |
| 1170 | 1224 | ||
| 1225 | --- | ||
| 1226 | *** 'emacs-lisp-docstring-fill-column' now defaults to 72. | ||
| 1227 | It was previously 65. The new default formats documentation strings to | ||
| 1228 | fit on fewer lines without negatively impacting readability. | ||
| 1229 | |||
| 1171 | ** CPerl mode | 1230 | ** CPerl mode |
| 1172 | 1231 | ||
| 1173 | --- | 1232 | --- |
| @@ -1188,8 +1247,8 @@ comment, like Perl mode does. | |||
| 1188 | 1247 | ||
| 1189 | *** New command 'cperl-file-style'. | 1248 | *** New command 'cperl-file-style'. |
| 1190 | This command sets the indentation style for the current buffer. To | 1249 | This command sets the indentation style for the current buffer. To |
| 1191 | change the default style, either use the option with the same name or | 1250 | change the default style, either use the user option with the same name |
| 1192 | use the command cperl-set-style. | 1251 | or use the command 'cperl-set-style'. |
| 1193 | 1252 | ||
| 1194 | *** Commands using the Perl info page are obsolete. | 1253 | *** Commands using the Perl info page are obsolete. |
| 1195 | The Perl documentation in info format is no longer distributed with | 1254 | The Perl documentation in info format is no longer distributed with |
| @@ -1297,21 +1356,51 @@ will return the URL for that bug. | |||
| 1297 | This allows for rcirc logs to use a custom timestamp format, than the | 1356 | This allows for rcirc logs to use a custom timestamp format, than the |
| 1298 | chat buffers use by default. | 1357 | chat buffers use by default. |
| 1299 | 1358 | ||
| 1359 | --- | ||
| 1360 | *** New command 'Buffer-menu-toggle-internal'. | ||
| 1361 | This command toggles the display of internal buffers in Buffer Menu mode; | ||
| 1362 | that is, buffers not visiting a file and whose names start with a space. | ||
| 1363 | Previously, such buffers were never shown. This command is bound to 'I' | ||
| 1364 | in Buffer Menu mode. | ||
| 1365 | |||
| 1300 | ** Customize | 1366 | ** Customize |
| 1301 | 1367 | ||
| 1302 | +++ | 1368 | +++ |
| 1303 | *** New command 'customize-dirlocals'. | 1369 | *** New command 'customize-dirlocals'. |
| 1304 | This command pops up a buffer to edit the settings in ".dir-locals.el". | 1370 | This command pops up a buffer to edit the settings in ".dir-locals.el". |
| 1371 | |||
| 1372 | --- | ||
| 1373 | ** New command 'customize-toggle-option'. | ||
| 1374 | This command can toggle boolean options for the duration of a session. | ||
| 1375 | |||
| 1305 | ** Calc | 1376 | ** Calc |
| 1377 | |||
| 1306 | +++ | 1378 | +++ |
| 1307 | *** Calc parses fractions written using U+2044 FRACTION SLASH | 1379 | *** Calc parses fractions written using U+2044 FRACTION SLASH. |
| 1308 | Fractions of the form 123⁄456 are handled as if written 123:456. Note | 1380 | Fractions of the form "123⁄456" are handled as if written "123:456". |
| 1309 | in particular the difference in behavior from U+2215 DIVISION SLASH | 1381 | Note in particular the difference in behavior from U+2215 DIVISION SLASH |
| 1310 | and U+002F SOLIDUS, which result in division rather than a rational | 1382 | and U+002F SOLIDUS, which result in division rather than a rational |
| 1311 | fraction. You may also be interested to know that precomposed | 1383 | fraction. You may also be interested to know that precomposed fraction |
| 1312 | fraction characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are | 1384 | characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are also |
| 1313 | also recognized as rational fractions. They have been since 2004, but | 1385 | recognized as rational fractions. They have been since 2004, but it |
| 1314 | it looks like it was never mentioned in the NEWS, or even the manual. | 1386 | looks like it was never mentioned in the NEWS, or even the manual. |
| 1387 | |||
| 1388 | ** IELM | ||
| 1389 | |||
| 1390 | --- | ||
| 1391 | *** IELM now remembers input history between sessions. | ||
| 1392 | The new user option 'ielm-history-file-name' is the name of the file | ||
| 1393 | where IELM input history will be saved. Customize it to nil to revert | ||
| 1394 | to the old behavior of not remembering input history between sessions. | ||
| 1395 | |||
| 1396 | ** EasyPG | ||
| 1397 | |||
| 1398 | +++ | ||
| 1399 | *** New user option 'epa-keys-select-method'. | ||
| 1400 | This allows the user to customize the key selection method, which can be | ||
| 1401 | either by using a pop-up buffer or from the minibuffer. The pop-up | ||
| 1402 | buffer method is the default, which preserves previous behavior. | ||
| 1403 | |||
| 1315 | 1404 | ||
| 1316 | * New Modes and Packages in Emacs 30.1 | 1405 | * New Modes and Packages in Emacs 30.1 |
| 1317 | 1406 | ||
| @@ -1367,13 +1456,30 @@ This minor mode generates the tags table automatically based on the | |||
| 1367 | current project configuration, and later updates it as you edit the | 1456 | current project configuration, and later updates it as you edit the |
| 1368 | files and save the changes. | 1457 | files and save the changes. |
| 1369 | 1458 | ||
| 1459 | +++ | ||
| 1460 | ** New package Compat. | ||
| 1461 | Emacs now comes with a stub implementation of the | ||
| 1462 | forwards-compatibility Compat package from GNU ELPA. This allows | ||
| 1463 | built-in packages to use the library more effectively, and helps | ||
| 1464 | preventing the installation of Compat if unnecessary. | ||
| 1465 | |||
| 1370 | 1466 | ||
| 1371 | * Incompatible Lisp Changes in Emacs 30.1 | 1467 | * Incompatible Lisp Changes in Emacs 30.1 |
| 1372 | 1468 | ||
| 1469 | --- | ||
| 1470 | ** Old derived.el functions removed. | ||
| 1471 | The following functions have been deleted because they were only used | ||
| 1472 | by code compiled with Emacs<21: | ||
| 1473 | 'derived-mode-init-mode-variables', 'derived-mode-merge-abbrev-tables', | ||
| 1474 | 'derived-mode-merge-keymaps', 'derived-mode-merge-syntax-tables', | ||
| 1475 | 'derived-mode-run-hooks', 'derived-mode-set-abbrev-table', | ||
| 1476 | 'derived-mode-set-keymap', 'derived-mode-set-syntax-table', | ||
| 1477 | 'derived-mode-setup-function-name'. | ||
| 1478 | |||
| 1373 | +++ | 1479 | +++ |
| 1374 | ** 'M-TAB' now invokes 'completion-at-point' also in Text mode. | 1480 | ** 'M-TAB' now invokes 'completion-at-point' also in Text mode. |
| 1375 | By default, Text mode no longer binds 'M-TAB' to | 1481 | By default, Text mode no longer binds 'M-TAB' to |
| 1376 | 'ispell-complete-word'. Instead this mode arranges for | 1482 | 'ispell-complete-word'. Instead, this mode arranges for |
| 1377 | 'completion-at-point', globally bound to 'M-TAB', to perform word | 1483 | 'completion-at-point', globally bound to 'M-TAB', to perform word |
| 1378 | completion as well. You can have Text mode bind 'M-TAB' to | 1484 | completion as well. You can have Text mode bind 'M-TAB' to |
| 1379 | 'ispell-complete-word' as it did in previous Emacs versions, or | 1485 | 'ispell-complete-word' as it did in previous Emacs versions, or |
| @@ -1481,8 +1587,12 @@ values. | |||
| 1481 | * Lisp Changes in Emacs 30.1 | 1587 | * Lisp Changes in Emacs 30.1 |
| 1482 | 1588 | ||
| 1483 | +++ | 1589 | +++ |
| 1484 | ** 'define-advice' now sets the new advice's 'name' property to NAME | 1590 | ** Pcase's functions (in 'pred' and 'app') can specify the argument position. |
| 1485 | Named advice defined with 'define-advice' can now be removed with | 1591 | For example, instead of '(pred (< 5))' you can write '(pred (> _ 5))'. |
| 1592 | |||
| 1593 | +++ | ||
| 1594 | ** 'define-advice' now sets the new advice's 'name' property to NAME. | ||
| 1595 | Named advices defined with 'define-advice' can now be removed with | ||
| 1486 | '(advice-remove SYMBOL NAME)' in addition to '(advice-remove SYMBOL | 1596 | '(advice-remove SYMBOL NAME)' in addition to '(advice-remove SYMBOL |
| 1487 | SYMBOL@NAME)'. | 1597 | SYMBOL@NAME)'. |
| 1488 | 1598 | ||
| @@ -1499,10 +1609,10 @@ It puts a limit to the amount by which Emacs can temporarily increase | |||
| 1499 | 1609 | ||
| 1500 | +++ | 1610 | +++ |
| 1501 | ** New special form 'handler-bind'. | 1611 | ** New special form 'handler-bind'. |
| 1502 | Provides a functionality similar to `condition-case` except it runs the | 1612 | It provides a functionality similar to 'condition-case' except it runs |
| 1503 | handler code without unwinding the stack, such that we can record the | 1613 | the handler code without unwinding the stack, such that we can record |
| 1504 | backtrace and other dynamic state at the point of the error. | 1614 | the backtrace and other dynamic state at the point of the error. See |
| 1505 | See the Info node "(elisp) Handling Errors". | 1615 | the Info node "(elisp) Handling Errors". |
| 1506 | 1616 | ||
| 1507 | +++ | 1617 | +++ |
| 1508 | ** New 'pop-up-frames' action alist entry for 'display-buffer'. | 1618 | ** New 'pop-up-frames' action alist entry for 'display-buffer'. |
| @@ -1513,6 +1623,11 @@ precedence over the variable when present. | |||
| 1513 | Mostly used internally to do a kind of topological sort of | 1623 | Mostly used internally to do a kind of topological sort of |
| 1514 | inheritance hierarchies. | 1624 | inheritance hierarchies. |
| 1515 | 1625 | ||
| 1626 | ** New function 'sort-on'. | ||
| 1627 | This function implements the Schwartzian transform, and is appropriate | ||
| 1628 | for sorting lists when the computation of the sort key of a list | ||
| 1629 | element can be expensive. | ||
| 1630 | |||
| 1516 | ** New API for 'derived-mode-p' and control of the graph of major modes. | 1631 | ** New API for 'derived-mode-p' and control of the graph of major modes. |
| 1517 | 1632 | ||
| 1518 | *** 'derived-mode-p' now takes the list of modes as a single argument. | 1633 | *** 'derived-mode-p' now takes the list of modes as a single argument. |
| @@ -1827,6 +1942,21 @@ The warning will only be issued for calls to functions declared | |||
| 1827 | 'important-return-value' or 'side-effect-free' (but not 'error-free'). | 1942 | 'important-return-value' or 'side-effect-free' (but not 'error-free'). |
| 1828 | 1943 | ||
| 1829 | --- | 1944 | --- |
| 1945 | *** Warn about docstrings that contain control characters. | ||
| 1946 | The compiler now warns about docstrings with control characters other | ||
| 1947 | than newline and tab. This is often a result of improper escaping. | ||
| 1948 | Example: | ||
| 1949 | |||
| 1950 | (defun my-fun () | ||
| 1951 | "Uses c:\remote\dir\files and the key \C-x." | ||
| 1952 | ...) | ||
| 1953 | |||
| 1954 | where the docstring contains four control characters 'CR', 'DEL', 'FF' | ||
| 1955 | and 'C-x'. | ||
| 1956 | |||
| 1957 | The warning name is 'docstrings-control-chars'. | ||
| 1958 | |||
| 1959 | --- | ||
| 1830 | *** The warning about wide docstrings can now be disabled separately. | 1960 | *** The warning about wide docstrings can now be disabled separately. |
| 1831 | Its warning name is 'docstrings-wide'. | 1961 | Its warning name is 'docstrings-wide'. |
| 1832 | 1962 | ||
| @@ -1836,6 +1966,13 @@ The declaration '(important-return-value t)' sets the | |||
| 1836 | 'important-return-value' property which indicates that the function | 1966 | 'important-return-value' property which indicates that the function |
| 1837 | return value should probably not be thrown away implicitly. | 1967 | return value should probably not be thrown away implicitly. |
| 1838 | 1968 | ||
| 1969 | ** Bytecode is now always loaded eagerly. | ||
| 1970 | Bytecode compiled with older Emacs versions for lazy loading using | ||
| 1971 | 'byte-compile-dynamic' is now loaded all at once. | ||
| 1972 | As a consequence, 'fetch-bytecode' has no use, does nothing, and is | ||
| 1973 | now obsolete. The variable 'byte-compile-dynamic' has no effect any | ||
| 1974 | more; compilation will always yield bytecode for eager loading. | ||
| 1975 | |||
| 1839 | +++ | 1976 | +++ |
| 1840 | ** New functions 'file-user-uid' and 'file-group-gid'. | 1977 | ** New functions 'file-user-uid' and 'file-group-gid'. |
| 1841 | These functions are like 'user-uid' and 'group-gid', respectively, but | 1978 | These functions are like 'user-uid' and 'group-gid', respectively, but |
| @@ -1891,6 +2028,31 @@ The 'test' parameter is omitted if it is 'eql' (the default), as is | |||
| 1891 | 'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are | 2028 | 'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are |
| 1892 | always omitted, and ignored if present when the object is read back in. | 2029 | always omitted, and ignored if present when the object is read back in. |
| 1893 | 2030 | ||
| 2031 | ** Obarrays | ||
| 2032 | |||
| 2033 | +++ | ||
| 2034 | *** New obarray type. | ||
| 2035 | Obarrays are now represented by an opaque type instead of using vectors. | ||
| 2036 | They are created by 'obarray-make' and manage their internal storage | ||
| 2037 | automatically, which means that the size parameter to 'obarray-make' can | ||
| 2038 | safely be omitted. That is, they do not become slower as they fill up. | ||
| 2039 | |||
| 2040 | The old vector representation is still accepted by functions operating | ||
| 2041 | on obarrays, but 'obarrayp' only returns t for obarray objects. | ||
| 2042 | 'type-of' now returns 'obarray' for obarray objects. | ||
| 2043 | |||
| 2044 | Old code which (incorrectly) created "obarrays" as Lisp vectors filled | ||
| 2045 | with something other than 0, as in '(make-vector N nil)', will no longer | ||
| 2046 | work, and should be rewritten to use 'obarray-make'. Alternatively, you | ||
| 2047 | can fill the vector with 0. | ||
| 2048 | |||
| 2049 | +++ | ||
| 2050 | *** New function 'obarray-clear' removes all symbols from an obarray. | ||
| 2051 | |||
| 2052 | --- | ||
| 2053 | *** 'obarray-size' and 'obarray-default-size' are now obsolete. | ||
| 2054 | They pertained to the internal storage size which is now irrelevant. | ||
| 2055 | |||
| 1894 | +++ | 2056 | +++ |
| 1895 | ** 'treesit-install-language-grammar' can handle local directory instead of URL. | 2057 | ** 'treesit-install-language-grammar' can handle local directory instead of URL. |
| 1896 | It is now possible to pass a directory of a local repository as URL | 2058 | It is now possible to pass a directory of a local repository as URL |
diff --git a/etc/NEWS.25 b/etc/NEWS.25 index 3c5e9569b49..f647809074b 100644 --- a/etc/NEWS.25 +++ b/etc/NEWS.25 | |||
| @@ -1158,6 +1158,11 @@ few or no entries have changed. | |||
| 1158 | 1158 | ||
| 1159 | * New Modes and Packages in Emacs 25.1 | 1159 | * New Modes and Packages in Emacs 25.1 |
| 1160 | 1160 | ||
| 1161 | ** New preloaded package 'obarray' | ||
| 1162 | |||
| 1163 | Provides obarray operations under the 'obarray-' prefix, such as | ||
| 1164 | 'obarray-make', 'obarrayp', and 'obarray-map'. | ||
| 1165 | |||
| 1161 | ** pinentry.el allows GnuPG passphrase to be prompted through the | 1166 | ** pinentry.el allows GnuPG passphrase to be prompted through the |
| 1162 | minibuffer instead of a graphical dialog, depending on whether the gpg | 1167 | minibuffer instead of a graphical dialog, depending on whether the gpg |
| 1163 | command is called from Emacs (i.e., INSIDE_EMACS environment variable | 1168 | command is called from Emacs (i.e., INSIDE_EMACS environment variable |
diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 048c56baa1a..19456640299 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS | |||
| @@ -432,7 +432,7 @@ than the corresponding .el file. | |||
| 432 | Alternatively, if you set the option 'load-prefer-newer' non-nil, | 432 | Alternatively, if you set the option 'load-prefer-newer' non-nil, |
| 433 | Emacs will load whichever version of a file is the newest. | 433 | Emacs will load whichever version of a file is the newest. |
| 434 | 434 | ||
| 435 | *** Watch out for the EMACSLOADPATH environment variable | 435 | *** Watch out for the EMACSLOADPATH environment variable. |
| 436 | 436 | ||
| 437 | EMACSLOADPATH overrides which directories the function "load" will search. | 437 | EMACSLOADPATH overrides which directories the function "load" will search. |
| 438 | 438 | ||
| @@ -441,7 +441,7 @@ environment. | |||
| 441 | 441 | ||
| 442 | ** Keyboard problems | 442 | ** Keyboard problems |
| 443 | 443 | ||
| 444 | *** PGTK build of Emacs running on Wayland doesn't recognize Hyper modifier | 444 | *** PGTK build of Emacs running on Wayland doesn't recognize Hyper modifier. |
| 445 | 445 | ||
| 446 | If you arrange for the Wayland compositor to send the Hyper key | 446 | If you arrange for the Wayland compositor to send the Hyper key |
| 447 | modifier (e.g., via XKB customizations), the Hyper modifier will still | 447 | modifier (e.g., via XKB customizations), the Hyper modifier will still |
| @@ -452,6 +452,17 @@ Since GDK 3.x is no longer developed, this bug in GDK will probably | |||
| 452 | never be solved. And the Emacs PGTK build cannot yet support GTK4, | 452 | never be solved. And the Emacs PGTK build cannot yet support GTK4, |
| 453 | where this problem is reportedly solved. | 453 | where this problem is reportedly solved. |
| 454 | 454 | ||
| 455 | *** Emacs built with GTK lags in its response to keyboard input. | ||
| 456 | This can happen when input methods are used. It happens because Emacs | ||
| 457 | behaves in an unconventional way with respect to GTK input methods: it | ||
| 458 | registers to receive keyboard input as unprocessed key events with | ||
| 459 | metadata (as opposed to receiving them as text strings). Most GTK | ||
| 460 | programs use the latter approach, so some modern input methods have | ||
| 461 | bugs and misbehave when faced with the way Emacs does it. | ||
| 462 | |||
| 463 | A workaround is to set GTK_IM_MODULE=none in the environment, or maybe | ||
| 464 | find a different input method without these problems. | ||
| 465 | |||
| 455 | *** Unable to enter the M-| key on some German keyboards. | 466 | *** Unable to enter the M-| key on some German keyboards. |
| 456 | Some users have reported that M-| suffers from "keyboard ghosting". | 467 | Some users have reported that M-| suffers from "keyboard ghosting". |
| 457 | This can't be fixed by Emacs, as the keypress never gets passed to it | 468 | This can't be fixed by Emacs, as the keypress never gets passed to it |
| @@ -476,6 +487,29 @@ You are probably using a shell that doesn't support job control, even | |||
| 476 | though the system itself is capable of it. Either use a different shell, | 487 | though the system itself is capable of it. Either use a different shell, |
| 477 | or set the variable 'cannot-suspend' to a non-nil value. | 488 | or set the variable 'cannot-suspend' to a non-nil value. |
| 478 | 489 | ||
| 490 | *** Emacs running on WSL receives stray characters as input. | ||
| 491 | |||
| 492 | For example, you could see Emacs inserting 'z' characters even though | ||
| 493 | nothing is typed on the keyboard, and even if you unplug the keyboard. | ||
| 494 | |||
| 495 | The reason is a bug in the WSL X server's handling of key-press and | ||
| 496 | key-repeat events. A workaround is to use the Cygwin or native | ||
| 497 | MS-Windows build of Emacs instead. | ||
| 498 | |||
| 499 | *** On MS-Windows, the Windows key gets "stuck". | ||
| 500 | When this problem happens, Windows behaves as if the Windows key were | ||
| 501 | permanently pressed down. This could be a side effect of Emacs on | ||
| 502 | MS-Windows hooking keyboard input on a low level, in order to support | ||
| 503 | registering the Windows keys as hot keys. If that hook takes too much | ||
| 504 | time for some reason, Windows can decide to remove the hook, which | ||
| 505 | then has this effect. | ||
| 506 | |||
| 507 | This is arguably a bug in Emacs, for which we don't yet have a | ||
| 508 | solution. To work around, set the 'LowLevelHooksTimeout' value in the | ||
| 509 | registry key "HKEY_CURRENT_USER\Control Panel\Desktop" to a number | ||
| 510 | higher than 200 msec; the maximum allowed value is 1000 msec (create | ||
| 511 | the value if it doesn't exist under that key). | ||
| 512 | |||
| 479 | ** Mailers and other helper programs | 513 | ** Mailers and other helper programs |
| 480 | 514 | ||
| 481 | *** movemail compiled with POP support can't connect to the POP server. | 515 | *** movemail compiled with POP support can't connect to the POP server. |
| @@ -545,15 +579,6 @@ As a workaround, input the passphrase with a GUI-capable pinentry | |||
| 545 | program like 'pinentry-gnome' or 'pinentry-qt5'. Alternatively, you | 579 | program like 'pinentry-gnome' or 'pinentry-qt5'. Alternatively, you |
| 546 | can use the 'pinentry' package from Emacs 25. | 580 | can use the 'pinentry' package from Emacs 25. |
| 547 | 581 | ||
| 548 | *** Emacs running on WSL receives stray characters as input. | ||
| 549 | |||
| 550 | For example, you could see Emacs inserting 'z' characters even though | ||
| 551 | nothing is typed on the keyboard, and even if you unplug the keyboard. | ||
| 552 | |||
| 553 | The reason is a bug in the WSL X server's handling of key-press and | ||
| 554 | key-repeat events. A workaround is to use the Cygwin or native | ||
| 555 | MS-Windows build of Emacs instead. | ||
| 556 | |||
| 557 | ** Problems with hostname resolution | 582 | ** Problems with hostname resolution |
| 558 | 583 | ||
| 559 | *** Emacs does not know your host's fully-qualified domain name. | 584 | *** Emacs does not know your host's fully-qualified domain name. |
diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index fdf4314e2d0..9865fe391a2 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py | |||
| @@ -56,6 +56,7 @@ class Lisp_Object: | |||
| 56 | "PVEC_BOOL_VECTOR": "struct Lisp_Bool_Vector", | 56 | "PVEC_BOOL_VECTOR": "struct Lisp_Bool_Vector", |
| 57 | "PVEC_BUFFER": "struct buffer", | 57 | "PVEC_BUFFER": "struct buffer", |
| 58 | "PVEC_HASH_TABLE": "struct Lisp_Hash_Table", | 58 | "PVEC_HASH_TABLE": "struct Lisp_Hash_Table", |
| 59 | "PVEC_OBARRAY": "struct Lisp_Obarray", | ||
| 59 | "PVEC_TERMINAL": "struct terminal", | 60 | "PVEC_TERMINAL": "struct terminal", |
| 60 | "PVEC_WINDOW_CONFIGURATION": "struct save_window_data", | 61 | "PVEC_WINDOW_CONFIGURATION": "struct save_window_data", |
| 61 | "PVEC_SUBR": "struct Lisp_Subr", | 62 | "PVEC_SUBR": "struct Lisp_Subr", |
diff --git a/etc/images/README b/etc/images/README index a778d9ce6c3..8e112448373 100644 --- a/etc/images/README +++ b/etc/images/README | |||
| @@ -125,7 +125,7 @@ For more information see the adwaita-icon-theme repository at: | |||
| 125 | 125 | ||
| 126 | https://gitlab.gnome.org/GNOME/adwaita-icon-theme | 126 | https://gitlab.gnome.org/GNOME/adwaita-icon-theme |
| 127 | 127 | ||
| 128 | Emacs images and their source in the Adwaita/scalable directory: | 128 | Emacs images and their source in the Adwaita/symbolic directory: |
| 129 | 129 | ||
| 130 | checked.svg ui/checkbox-checked-symbolic.svg | 130 | checked.svg ui/checkbox-checked-symbolic.svg |
| 131 | unchecked.svg ui/checkbox-symbolic.svg | 131 | unchecked.svg ui/checkbox-symbolic.svg |
| @@ -137,3 +137,8 @@ Emacs images and their source in the Adwaita/scalable directory: | |||
| 137 | left.svg ui/pan-start-symbolic.svg | 137 | left.svg ui/pan-start-symbolic.svg |
| 138 | right.svg ui/pan-end-symbolic.svg | 138 | right.svg ui/pan-end-symbolic.svg |
| 139 | up.svg ui/pan-up-symbolic.svg | 139 | up.svg ui/pan-up-symbolic.svg |
| 140 | conceal.svg actions/view-conceal-symbolic.svg | ||
| 141 | reveal.svg actions/view-reveal-symbolic.svg | ||
| 142 | |||
| 143 | conceal.pbm and reveal.pbm are generated from the respective *.svg | ||
| 144 | files, using the ImageMagick converter tool. | ||
diff --git a/etc/images/conceal.pbm b/etc/images/conceal.pbm new file mode 100644 index 00000000000..3df787d6fd6 --- /dev/null +++ b/etc/images/conceal.pbm | |||
| Binary files differ | |||
diff --git a/etc/images/conceal.svg b/etc/images/conceal.svg new file mode 100644 index 00000000000..172b73ed3d3 --- /dev/null +++ b/etc/images/conceal.svg | |||
| @@ -0,0 +1,4 @@ | |||
| 1 | <?xml version="1.0" encoding="UTF-8"?> | ||
| 2 | <svg height="16px" viewBox="0 0 16 16" width="16px" xmlns="http://www.w3.org/2000/svg"> | ||
| 3 | <path d="m 1.53125 0.46875 l -1.0625 1.0625 l 14 14 l 1.0625 -1.0625 l -2.382812 -2.382812 c 1.265624 -1.0625 2.171874 -2.496094 2.589843 -4.097657 c -0.914062 -3.523437 -4.097656 -5.984375 -7.738281 -5.988281 c -1.367188 0.011719 -2.707031 0.371094 -3.894531 1.042969 z m 6.46875 3.53125 c 2.210938 0 4 1.789062 4 4 c -0.003906 0.800781 -0.246094 1.578125 -0.699219 2.238281 l -1.46875 -1.46875 c 0.105469 -0.242187 0.164063 -0.503906 0.167969 -0.769531 c 0 -1.105469 -0.894531 -2 -2 -2 c -0.265625 0.003906 -0.527344 0.0625 -0.769531 0.167969 l -1.46875 -1.46875 c 0.660156 -0.453125 1.4375 -0.695313 2.238281 -0.699219 z m -6.144531 0.917969 c -0.753907 0.898437 -1.296875 1.957031 -1.59375 3.09375 c 0.914062 3.523437 4.097656 5.984375 7.738281 5.988281 c 0.855469 -0.007812 1.703125 -0.152344 2.511719 -0.425781 l -1.667969 -1.667969 c -0.277344 0.058594 -0.5625 0.089844 -0.84375 0.09375 c -2.210938 0 -4 -1.789062 -4 -4 c 0.003906 -0.28125 0.035156 -0.566406 0.09375 -0.84375 z m 0 0" fill="#2e3436"/> | ||
| 4 | </svg> | ||
diff --git a/etc/images/reveal.pbm b/etc/images/reveal.pbm new file mode 100644 index 00000000000..79d2f1f3307 --- /dev/null +++ b/etc/images/reveal.pbm | |||
| Binary files differ | |||
diff --git a/etc/images/reveal.svg b/etc/images/reveal.svg new file mode 100644 index 00000000000..41ae3733a53 --- /dev/null +++ b/etc/images/reveal.svg | |||
| @@ -0,0 +1,4 @@ | |||
| 1 | <?xml version="1.0" encoding="UTF-8"?> | ||
| 2 | <svg height="16px" viewBox="0 0 16 16" width="16px" xmlns="http://www.w3.org/2000/svg"> | ||
| 3 | <path d="m 8 2 c -3.648438 0.003906 -6.832031 2.476562 -7.738281 6.007812 c 0.914062 3.527344 4.097656 5.988282 7.738281 5.992188 c 3.648438 -0.003906 6.832031 -2.476562 7.738281 -6.011719 c -0.914062 -3.523437 -4.097656 -5.984375 -7.738281 -5.988281 z m 0 2 c 2.210938 0 4 1.789062 4 4 s -1.789062 4 -4 4 s -4 -1.789062 -4 -4 s 1.789062 -4 4 -4 z m 0 2 c -1.105469 0 -2 0.894531 -2 2 s 0.894531 2 2 2 s 2 -0.894531 2 -2 s -0.894531 -2 -2 -2 z m 0 0" fill="#2e3436"/> | ||
| 4 | </svg> | ||
diff --git a/java/debug.sh b/java/debug.sh index 8fc03d014cf..c5d40141355 100755 --- a/java/debug.sh +++ b/java/debug.sh | |||
| @@ -104,13 +104,14 @@ if [ -z "$devices" ]; then | |||
| 104 | exit 1 | 104 | exit 1 |
| 105 | fi | 105 | fi |
| 106 | 106 | ||
| 107 | if [ -z $device ]; then | 107 | if [ `wc -w <<< "$devices"` -gt 1 ] && [ -z $device ]; then |
| 108 | device=$devices | 108 | echo "Multiple devices are available. Please specify one with" |
| 109 | echo "the option --device and try again." | ||
| 110 | exit 1 | ||
| 109 | fi | 111 | fi |
| 110 | 112 | ||
| 111 | if [ `wc -w <<< "$devices"` -gt 1 ] && [ -z device ]; then | 113 | if [ -z $device ]; then |
| 112 | echo "Multiple devices are available. Please pick one using" | 114 | device=$devices |
| 113 | echo "--device and try again." | ||
| 114 | fi | 115 | fi |
| 115 | 116 | ||
| 116 | echo "Looking for $package on device $device" | 117 | echo "Looking for $package on device $device" |
| @@ -189,6 +190,8 @@ if [ "$attach_existing" != "yes" ]; then | |||
| 189 | package_pids=`awk -f tmp.awk <<< $package_pids` | 190 | package_pids=`awk -f tmp.awk <<< $package_pids` |
| 190 | fi | 191 | fi |
| 191 | 192 | ||
| 193 | rm tmp.awk | ||
| 194 | |||
| 192 | pid=$package_pids | 195 | pid=$package_pids |
| 193 | num_pids=`wc -w <<< "$package_pids"` | 196 | num_pids=`wc -w <<< "$package_pids"` |
| 194 | 197 | ||
diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index 3237f650240..66a1e41d84c 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java | |||
| @@ -97,7 +97,7 @@ public class EmacsActivity extends Activity | |||
| 97 | } | 97 | } |
| 98 | 98 | ||
| 99 | public static void | 99 | public static void |
| 100 | invalidateFocus () | 100 | invalidateFocus (int whence) |
| 101 | { | 101 | { |
| 102 | EmacsWindow oldFocus; | 102 | EmacsWindow oldFocus; |
| 103 | 103 | ||
| @@ -144,7 +144,7 @@ public class EmacsActivity extends Activity | |||
| 144 | layout.removeView (window.view); | 144 | layout.removeView (window.view); |
| 145 | window = null; | 145 | window = null; |
| 146 | 146 | ||
| 147 | invalidateFocus (); | 147 | invalidateFocus (0); |
| 148 | } | 148 | } |
| 149 | } | 149 | } |
| 150 | 150 | ||
| @@ -172,8 +172,17 @@ public class EmacsActivity extends Activity | |||
| 172 | if (isPaused) | 172 | if (isPaused) |
| 173 | window.noticeIconified (); | 173 | window.noticeIconified (); |
| 174 | 174 | ||
| 175 | /* Invalidate the focus. */ | 175 | /* Invalidate the focus. Since attachWindow may be called from |
| 176 | invalidateFocus (); | 176 | either the main or the UI thread, post this to the UI thread. */ |
| 177 | |||
| 178 | runOnUiThread (new Runnable () { | ||
| 179 | @Override | ||
| 180 | public void | ||
| 181 | run () | ||
| 182 | { | ||
| 183 | invalidateFocus (1); | ||
| 184 | } | ||
| 185 | }); | ||
| 177 | } | 186 | } |
| 178 | 187 | ||
| 179 | @Override | 188 | @Override |
| @@ -238,6 +247,10 @@ public class EmacsActivity extends Activity | |||
| 238 | } | 247 | } |
| 239 | 248 | ||
| 240 | super.onCreate (savedInstanceState); | 249 | super.onCreate (savedInstanceState); |
| 250 | |||
| 251 | /* Call `onWindowFocusChanged' to read the focus state, which fails | ||
| 252 | to be called after an activity is recreated. */ | ||
| 253 | onWindowFocusChanged (false); | ||
| 241 | } | 254 | } |
| 242 | 255 | ||
| 243 | @Override | 256 | @Override |
| @@ -261,7 +274,7 @@ public class EmacsActivity extends Activity | |||
| 261 | isMultitask = this instanceof EmacsMultitaskActivity; | 274 | isMultitask = this instanceof EmacsMultitaskActivity; |
| 262 | manager.removeWindowConsumer (this, isMultitask || isFinishing ()); | 275 | manager.removeWindowConsumer (this, isMultitask || isFinishing ()); |
| 263 | focusedActivities.remove (this); | 276 | focusedActivities.remove (this); |
| 264 | invalidateFocus (); | 277 | invalidateFocus (2); |
| 265 | 278 | ||
| 266 | /* Remove this activity from the static field, lest it leak. */ | 279 | /* Remove this activity from the static field, lest it leak. */ |
| 267 | if (lastFocusedActivity == this) | 280 | if (lastFocusedActivity == this) |
| @@ -274,9 +287,16 @@ public class EmacsActivity extends Activity | |||
| 274 | public final void | 287 | public final void |
| 275 | onWindowFocusChanged (boolean isFocused) | 288 | onWindowFocusChanged (boolean isFocused) |
| 276 | { | 289 | { |
| 277 | if (isFocused && !focusedActivities.contains (this)) | 290 | /* At times and on certain versions of Android ISFOCUSED does not |
| 291 | reflect whether the window actually holds focus, so replace it | ||
| 292 | with the value of `hasWindowFocus'. */ | ||
| 293 | isFocused = hasWindowFocus (); | ||
| 294 | |||
| 295 | if (isFocused) | ||
| 278 | { | 296 | { |
| 279 | focusedActivities.add (this); | 297 | if (!focusedActivities.contains (this)) |
| 298 | focusedActivities.add (this); | ||
| 299 | |||
| 280 | lastFocusedActivity = this; | 300 | lastFocusedActivity = this; |
| 281 | 301 | ||
| 282 | /* Update the window insets as the focus change may have | 302 | /* Update the window insets as the focus change may have |
| @@ -291,7 +311,7 @@ public class EmacsActivity extends Activity | |||
| 291 | else | 311 | else |
| 292 | focusedActivities.remove (this); | 312 | focusedActivities.remove (this); |
| 293 | 313 | ||
| 294 | invalidateFocus (); | 314 | invalidateFocus (3); |
| 295 | } | 315 | } |
| 296 | 316 | ||
| 297 | @Override | 317 | @Override |
diff --git a/java/org/gnu/emacs/EmacsContextMenu.java b/java/org/gnu/emacs/EmacsContextMenu.java index 17e6033377d..2bbf2a313d6 100644 --- a/java/org/gnu/emacs/EmacsContextMenu.java +++ b/java/org/gnu/emacs/EmacsContextMenu.java | |||
| @@ -361,8 +361,23 @@ public final class EmacsContextMenu | |||
| 361 | public Boolean | 361 | public Boolean |
| 362 | call () | 362 | call () |
| 363 | { | 363 | { |
| 364 | boolean rc; | ||
| 365 | |||
| 364 | lastMenuEventSerial = serial; | 366 | lastMenuEventSerial = serial; |
| 365 | return display1 (window, xPosition, yPosition); | 367 | rc = display1 (window, xPosition, yPosition); |
| 368 | |||
| 369 | /* Android 3.0 to Android 7.0 perform duplicate calls to | ||
| 370 | onContextMenuClosed the second time a context menu is | ||
| 371 | dismissed. Since the second call after such a dismissal is | ||
| 372 | otherwise liable to prematurely cancel any context menu | ||
| 373 | displayed immediately afterwards, ignore calls received | ||
| 374 | within 150 milliseconds of this menu's being displayed. */ | ||
| 375 | |||
| 376 | if (rc && Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB | ||
| 377 | && Build.VERSION.SDK_INT < Build.VERSION_CODES.N) | ||
| 378 | wasSubmenuSelected = System.currentTimeMillis () - 150; | ||
| 379 | |||
| 380 | return rc; | ||
| 366 | } | 381 | } |
| 367 | }); | 382 | }); |
| 368 | 383 | ||
diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 5cb1ceca0aa..d17ba597d8e 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java | |||
| @@ -60,6 +60,7 @@ import android.content.UriPermission; | |||
| 60 | import android.content.pm.PackageManager; | 60 | import android.content.pm.PackageManager; |
| 61 | 61 | ||
| 62 | import android.content.res.AssetManager; | 62 | import android.content.res.AssetManager; |
| 63 | import android.content.res.Configuration; | ||
| 63 | 64 | ||
| 64 | import android.hardware.input.InputManager; | 65 | import android.hardware.input.InputManager; |
| 65 | 66 | ||
| @@ -135,6 +136,10 @@ public final class EmacsService extends Service | |||
| 135 | been created yet. */ | 136 | been created yet. */ |
| 136 | private EmacsSafThread storageThread; | 137 | private EmacsSafThread storageThread; |
| 137 | 138 | ||
| 139 | /* The Thread object representing the Android user interface | ||
| 140 | thread. */ | ||
| 141 | private Thread mainThread; | ||
| 142 | |||
| 138 | static | 143 | static |
| 139 | { | 144 | { |
| 140 | servicingQuery = new AtomicInteger (); | 145 | servicingQuery = new AtomicInteger (); |
| @@ -235,6 +240,7 @@ public final class EmacsService extends Service | |||
| 235 | / metrics.density) | 240 | / metrics.density) |
| 236 | * pixelDensityX); | 241 | * pixelDensityX); |
| 237 | resolver = getContentResolver (); | 242 | resolver = getContentResolver (); |
| 243 | mainThread = Thread.currentThread (); | ||
| 238 | 244 | ||
| 239 | /* If the density used to compute the text size is lesser than | 245 | /* If the density used to compute the text size is lesser than |
| 240 | 160, there's likely a bug with display density computation. | 246 | 160, there's likely a bug with display density computation. |
| @@ -383,7 +389,13 @@ public final class EmacsService extends Service | |||
| 383 | { | 389 | { |
| 384 | if (DEBUG_THREADS) | 390 | if (DEBUG_THREADS) |
| 385 | { | 391 | { |
| 386 | if (Thread.currentThread () instanceof EmacsThread) | 392 | /* When SERVICE is NULL, Emacs is being executed non-interactively. */ |
| 393 | if (SERVICE == null | ||
| 394 | /* It was previously assumed that only instances of | ||
| 395 | `EmacsThread' were valid for graphics calls, but this is | ||
| 396 | no longer true now that Lisp threads can be attached to | ||
| 397 | the JVM. */ | ||
| 398 | || (Thread.currentThread () != SERVICE.mainThread)) | ||
| 387 | return; | 399 | return; |
| 388 | 400 | ||
| 389 | throw new RuntimeException ("Emacs thread function" | 401 | throw new RuntimeException ("Emacs thread function" |
| @@ -437,21 +449,6 @@ public final class EmacsService extends Service | |||
| 437 | EmacsDrawPoint.perform (drawable, gc, x, y); | 449 | EmacsDrawPoint.perform (drawable, gc, x, y); |
| 438 | } | 450 | } |
| 439 | 451 | ||
| 440 | public void | ||
| 441 | clearWindow (EmacsWindow window) | ||
| 442 | { | ||
| 443 | checkEmacsThread (); | ||
| 444 | window.clearWindow (); | ||
| 445 | } | ||
| 446 | |||
| 447 | public void | ||
| 448 | clearArea (EmacsWindow window, int x, int y, int width, | ||
| 449 | int height) | ||
| 450 | { | ||
| 451 | checkEmacsThread (); | ||
| 452 | window.clearArea (x, y, width, height); | ||
| 453 | } | ||
| 454 | |||
| 455 | @SuppressWarnings ("deprecation") | 452 | @SuppressWarnings ("deprecation") |
| 456 | public void | 453 | public void |
| 457 | ringBell (int duration) | 454 | ringBell (int duration) |
| @@ -581,6 +578,15 @@ public final class EmacsService extends Service | |||
| 581 | return false; | 578 | return false; |
| 582 | } | 579 | } |
| 583 | 580 | ||
| 581 | public boolean | ||
| 582 | detectKeyboard () | ||
| 583 | { | ||
| 584 | Configuration configuration; | ||
| 585 | |||
| 586 | configuration = getResources ().getConfiguration (); | ||
| 587 | return configuration.keyboard != Configuration.KEYBOARD_NOKEYS; | ||
| 588 | } | ||
| 589 | |||
| 584 | public String | 590 | public String |
| 585 | nameKeysym (int keysym) | 591 | nameKeysym (int keysym) |
| 586 | { | 592 | { |
| @@ -905,48 +911,6 @@ public final class EmacsService extends Service | |||
| 905 | 911 | ||
| 906 | /* Content provider functions. */ | 912 | /* Content provider functions. */ |
| 907 | 913 | ||
| 908 | /* Return a ContentResolver capable of accessing as many files as | ||
| 909 | possible, namely the content resolver of the last selected | ||
| 910 | activity if available: only they posses the rights to access drag | ||
| 911 | and drop files. */ | ||
| 912 | |||
| 913 | public ContentResolver | ||
| 914 | getUsefulContentResolver () | ||
| 915 | { | ||
| 916 | EmacsActivity activity; | ||
| 917 | |||
| 918 | if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) | ||
| 919 | /* Since the system predates drag and drop, return this resolver | ||
| 920 | to avoid any unforeseen difficulties. */ | ||
| 921 | return resolver; | ||
| 922 | |||
| 923 | activity = EmacsActivity.lastFocusedActivity; | ||
| 924 | if (activity == null) | ||
| 925 | return resolver; | ||
| 926 | |||
| 927 | return activity.getContentResolver (); | ||
| 928 | } | ||
| 929 | |||
| 930 | /* Return a context whose ContentResolver is granted access to most | ||
| 931 | files, as in `getUsefulContentResolver'. */ | ||
| 932 | |||
| 933 | public Context | ||
| 934 | getContentResolverContext () | ||
| 935 | { | ||
| 936 | EmacsActivity activity; | ||
| 937 | |||
| 938 | if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) | ||
| 939 | /* Since the system predates drag and drop, return this resolver | ||
| 940 | to avoid any unforeseen difficulties. */ | ||
| 941 | return this; | ||
| 942 | |||
| 943 | activity = EmacsActivity.lastFocusedActivity; | ||
| 944 | if (activity == null) | ||
| 945 | return this; | ||
| 946 | |||
| 947 | return activity; | ||
| 948 | } | ||
| 949 | |||
| 950 | /* Open a content URI described by the bytes BYTES, a non-terminated | 914 | /* Open a content URI described by the bytes BYTES, a non-terminated |
| 951 | string; make it writable if WRITABLE, and readable if READABLE. | 915 | string; make it writable if WRITABLE, and readable if READABLE. |
| 952 | Truncate the file if TRUNCATE. | 916 | Truncate the file if TRUNCATE. |
| @@ -960,9 +924,6 @@ public final class EmacsService extends Service | |||
| 960 | String name, mode; | 924 | String name, mode; |
| 961 | ParcelFileDescriptor fd; | 925 | ParcelFileDescriptor fd; |
| 962 | int i; | 926 | int i; |
| 963 | ContentResolver resolver; | ||
| 964 | |||
| 965 | resolver = getUsefulContentResolver (); | ||
| 966 | 927 | ||
| 967 | /* Figure out the file access mode. */ | 928 | /* Figure out the file access mode. */ |
| 968 | 929 | ||
| @@ -1024,12 +985,8 @@ public final class EmacsService extends Service | |||
| 1024 | ParcelFileDescriptor fd; | 985 | ParcelFileDescriptor fd; |
| 1025 | Uri uri; | 986 | Uri uri; |
| 1026 | int rc, flags; | 987 | int rc, flags; |
| 1027 | Context context; | ||
| 1028 | ContentResolver resolver; | ||
| 1029 | ParcelFileDescriptor descriptor; | 988 | ParcelFileDescriptor descriptor; |
| 1030 | 989 | ||
| 1031 | context = getContentResolverContext (); | ||
| 1032 | |||
| 1033 | uri = Uri.parse (name); | 990 | uri = Uri.parse (name); |
| 1034 | flags = 0; | 991 | flags = 0; |
| 1035 | 992 | ||
| @@ -1039,7 +996,7 @@ public final class EmacsService extends Service | |||
| 1039 | if (writable) | 996 | if (writable) |
| 1040 | flags |= Intent.FLAG_GRANT_WRITE_URI_PERMISSION; | 997 | flags |= Intent.FLAG_GRANT_WRITE_URI_PERMISSION; |
| 1041 | 998 | ||
| 1042 | rc = context.checkCallingUriPermission (uri, flags); | 999 | rc = checkCallingUriPermission (uri, flags); |
| 1043 | 1000 | ||
| 1044 | if (rc == PackageManager.PERMISSION_GRANTED) | 1001 | if (rc == PackageManager.PERMISSION_GRANTED) |
| 1045 | return true; | 1002 | return true; |
| @@ -1053,7 +1010,6 @@ public final class EmacsService extends Service | |||
| 1053 | 1010 | ||
| 1054 | try | 1011 | try |
| 1055 | { | 1012 | { |
| 1056 | resolver = context.getContentResolver (); | ||
| 1057 | descriptor = resolver.openFileDescriptor (uri, "r"); | 1013 | descriptor = resolver.openFileDescriptor (uri, "r"); |
| 1058 | return true; | 1014 | return true; |
| 1059 | } | 1015 | } |
diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 304304a328b..6e8bdaf7401 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java | |||
| @@ -27,6 +27,8 @@ import java.util.HashMap; | |||
| 27 | import java.util.LinkedHashMap; | 27 | import java.util.LinkedHashMap; |
| 28 | import java.util.Map; | 28 | import java.util.Map; |
| 29 | 29 | ||
| 30 | import android.app.Activity; | ||
| 31 | |||
| 30 | import android.content.ClipData; | 32 | import android.content.ClipData; |
| 31 | import android.content.ClipDescription; | 33 | import android.content.ClipDescription; |
| 32 | import android.content.Context; | 34 | import android.content.Context; |
| @@ -240,7 +242,7 @@ public final class EmacsWindow extends EmacsHandleObject | |||
| 240 | } | 242 | } |
| 241 | } | 243 | } |
| 242 | 244 | ||
| 243 | EmacsActivity.invalidateFocus (); | 245 | EmacsActivity.invalidateFocus (4); |
| 244 | 246 | ||
| 245 | if (!children.isEmpty ()) | 247 | if (!children.isEmpty ()) |
| 246 | throw new IllegalStateException ("Trying to destroy window with " | 248 | throw new IllegalStateException ("Trying to destroy window with " |
| @@ -362,6 +364,9 @@ public final class EmacsWindow extends EmacsHandleObject | |||
| 362 | requestViewLayout (); | 364 | requestViewLayout (); |
| 363 | } | 365 | } |
| 364 | 366 | ||
| 367 | /* Return WM layout parameters for an override redirect window with | ||
| 368 | the geometry provided here. */ | ||
| 369 | |||
| 365 | private WindowManager.LayoutParams | 370 | private WindowManager.LayoutParams |
| 366 | getWindowLayoutParams () | 371 | getWindowLayoutParams () |
| 367 | { | 372 | { |
| @@ -384,15 +389,15 @@ public final class EmacsWindow extends EmacsHandleObject | |||
| 384 | return params; | 389 | return params; |
| 385 | } | 390 | } |
| 386 | 391 | ||
| 387 | private Context | 392 | private Activity |
| 388 | findSuitableActivityContext () | 393 | findSuitableActivityContext () |
| 389 | { | 394 | { |
| 390 | /* Find a recently focused activity. */ | 395 | /* Find a recently focused activity. */ |
| 391 | if (!EmacsActivity.focusedActivities.isEmpty ()) | 396 | if (!EmacsActivity.focusedActivities.isEmpty ()) |
| 392 | return EmacsActivity.focusedActivities.get (0); | 397 | return EmacsActivity.focusedActivities.get (0); |
| 393 | 398 | ||
| 394 | /* Return the service context, which probably won't work. */ | 399 | /* Resort to the last activity to be focused. */ |
| 395 | return EmacsService.SERVICE; | 400 | return EmacsActivity.lastFocusedActivity; |
| 396 | } | 401 | } |
| 397 | 402 | ||
| 398 | public synchronized void | 403 | public synchronized void |
| @@ -416,7 +421,7 @@ public final class EmacsWindow extends EmacsHandleObject | |||
| 416 | { | 421 | { |
| 417 | EmacsWindowAttachmentManager manager; | 422 | EmacsWindowAttachmentManager manager; |
| 418 | WindowManager windowManager; | 423 | WindowManager windowManager; |
| 419 | Context ctx; | 424 | Activity ctx; |
| 420 | Object tem; | 425 | Object tem; |
| 421 | WindowManager.LayoutParams params; | 426 | WindowManager.LayoutParams params; |
| 422 | 427 | ||
| @@ -447,11 +452,23 @@ public final class EmacsWindow extends EmacsHandleObject | |||
| 447 | activity using the system window manager. */ | 452 | activity using the system window manager. */ |
| 448 | 453 | ||
| 449 | ctx = findSuitableActivityContext (); | 454 | ctx = findSuitableActivityContext (); |
| 455 | |||
| 456 | if (ctx == null) | ||
| 457 | { | ||
| 458 | Log.w (TAG, "failed to attach override-redirect window" | ||
| 459 | + " for want of activity"); | ||
| 460 | return; | ||
| 461 | } | ||
| 462 | |||
| 450 | tem = ctx.getSystemService (Context.WINDOW_SERVICE); | 463 | tem = ctx.getSystemService (Context.WINDOW_SERVICE); |
| 451 | windowManager = (WindowManager) tem; | 464 | windowManager = (WindowManager) tem; |
| 452 | 465 | ||
| 453 | /* Calculate layout parameters. */ | 466 | /* Calculate layout parameters and propagate the |
| 467 | activity's token into it. */ | ||
| 468 | |||
| 454 | params = getWindowLayoutParams (); | 469 | params = getWindowLayoutParams (); |
| 470 | params.token = (ctx.findViewById (android.R.id.content) | ||
| 471 | .getWindowToken ()); | ||
| 455 | view.setLayoutParams (params); | 472 | view.setLayoutParams (params); |
| 456 | 473 | ||
| 457 | /* Attach the view. */ | 474 | /* Attach the view. */ |
| @@ -644,7 +661,7 @@ public final class EmacsWindow extends EmacsHandleObject | |||
| 644 | public void | 661 | public void |
| 645 | onKeyDown (int keyCode, KeyEvent event) | 662 | onKeyDown (int keyCode, KeyEvent event) |
| 646 | { | 663 | { |
| 647 | int state, state_1, num_lock_flag; | 664 | int state, state_1, extra_ignored; |
| 648 | long serial; | 665 | long serial; |
| 649 | String characters; | 666 | String characters; |
| 650 | 667 | ||
| @@ -665,23 +682,37 @@ public final class EmacsWindow extends EmacsHandleObject | |||
| 665 | 682 | ||
| 666 | state = eventModifiers (event); | 683 | state = eventModifiers (event); |
| 667 | 684 | ||
| 668 | /* Num Lock and Scroll Lock aren't supported by systems older than | 685 | /* Num Lock, Scroll Lock and Meta aren't supported by systems older |
| 669 | Android 3.0. */ | 686 | than Android 3.0. */ |
| 670 | 687 | ||
| 671 | if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB) | 688 | if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB) |
| 672 | num_lock_flag = (KeyEvent.META_NUM_LOCK_ON | 689 | extra_ignored = (KeyEvent.META_NUM_LOCK_ON |
| 673 | | KeyEvent.META_SCROLL_LOCK_ON); | 690 | | KeyEvent.META_SCROLL_LOCK_ON |
| 691 | | KeyEvent.META_META_MASK); | ||
| 674 | else | 692 | else |
| 675 | num_lock_flag = 0; | 693 | extra_ignored = 0; |
| 676 | 694 | ||
| 677 | /* Ignore meta-state understood by Emacs for now, or key presses | 695 | /* Ignore meta-state understood by Emacs for now, or key presses |
| 678 | such as Ctrl+C and Meta+C will not be recognized as an ASCII | 696 | such as Ctrl+C and Meta+C will not be recognized as ASCII key |
| 679 | key press event. */ | 697 | press events. */ |
| 680 | 698 | ||
| 681 | state_1 | 699 | state_1 |
| 682 | = state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK | 700 | = state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK |
| 683 | | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK | 701 | | KeyEvent.META_SYM_ON | extra_ignored); |
| 684 | | num_lock_flag); | 702 | |
| 703 | /* There's no distinction between Right Alt and Alt Gr on Android, | ||
| 704 | so restore META_ALT_RIGHT_ON if set in state to enable composing | ||
| 705 | characters. (bug#69321) */ | ||
| 706 | |||
| 707 | if ((state & KeyEvent.META_ALT_RIGHT_ON) != 0) | ||
| 708 | { | ||
| 709 | state_1 |= KeyEvent.META_ALT_ON | KeyEvent.META_ALT_RIGHT_ON; | ||
| 710 | |||
| 711 | /* If Alt is also not depressed, remove its bit from the mask | ||
| 712 | reported to Emacs. */ | ||
| 713 | if ((state & KeyEvent.META_ALT_LEFT_ON) == 0) | ||
| 714 | state &= ~KeyEvent.META_ALT_MASK; | ||
| 715 | } | ||
| 685 | 716 | ||
| 686 | synchronized (eventStrings) | 717 | synchronized (eventStrings) |
| 687 | { | 718 | { |
| @@ -702,29 +733,43 @@ public final class EmacsWindow extends EmacsHandleObject | |||
| 702 | public void | 733 | public void |
| 703 | onKeyUp (int keyCode, KeyEvent event) | 734 | onKeyUp (int keyCode, KeyEvent event) |
| 704 | { | 735 | { |
| 705 | int state, state_1, unicode_char, num_lock_flag; | 736 | int state, state_1, unicode_char, extra_ignored; |
| 706 | long time; | 737 | long time; |
| 707 | 738 | ||
| 708 | /* Compute the event's modifier mask. */ | 739 | /* Compute the event's modifier mask. */ |
| 709 | state = eventModifiers (event); | 740 | state = eventModifiers (event); |
| 710 | 741 | ||
| 711 | /* Num Lock and Scroll Lock aren't supported by systems older than | 742 | /* Num Lock, Scroll Lock and Meta aren't supported by systems older |
| 712 | Android 3.0. */ | 743 | than Android 3.0. */ |
| 713 | 744 | ||
| 714 | if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB) | 745 | if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB) |
| 715 | num_lock_flag = (KeyEvent.META_NUM_LOCK_ON | 746 | extra_ignored = (KeyEvent.META_NUM_LOCK_ON |
| 716 | | KeyEvent.META_SCROLL_LOCK_ON); | 747 | | KeyEvent.META_SCROLL_LOCK_ON |
| 748 | | KeyEvent.META_META_MASK); | ||
| 717 | else | 749 | else |
| 718 | num_lock_flag = 0; | 750 | extra_ignored = 0; |
| 719 | 751 | ||
| 720 | /* Ignore meta-state understood by Emacs for now, or key presses | 752 | /* Ignore meta-state understood by Emacs for now, or key presses |
| 721 | such as Ctrl+C and Meta+C will not be recognized as an ASCII | 753 | such as Ctrl+C and Meta+C will not be recognized as ASCII key |
| 722 | key press event. */ | 754 | press events. */ |
| 723 | 755 | ||
| 724 | state_1 | 756 | state_1 |
| 725 | = state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK | 757 | = state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK |
| 726 | | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK | 758 | | KeyEvent.META_SYM_ON | extra_ignored); |
| 727 | | num_lock_flag); | 759 | |
| 760 | /* There's no distinction between Right Alt and Alt Gr on Android, | ||
| 761 | so restore META_ALT_RIGHT_ON if set in state to enable composing | ||
| 762 | characters. */ | ||
| 763 | |||
| 764 | if ((state & KeyEvent.META_ALT_RIGHT_ON) != 0) | ||
| 765 | { | ||
| 766 | state_1 |= KeyEvent.META_ALT_ON | KeyEvent.META_ALT_RIGHT_ON; | ||
| 767 | |||
| 768 | /* If Alt is also not depressed, remove its bit from the mask | ||
| 769 | reported to Emacs. */ | ||
| 770 | if ((state & KeyEvent.META_ALT_LEFT_ON) == 0) | ||
| 771 | state &= ~KeyEvent.META_ALT_MASK; | ||
| 772 | } | ||
| 728 | 773 | ||
| 729 | unicode_char = getEventUnicodeChar (event, state_1); | 774 | unicode_char = getEventUnicodeChar (event, state_1); |
| 730 | 775 | ||
| @@ -760,7 +805,7 @@ public final class EmacsWindow extends EmacsHandleObject | |||
| 760 | public void | 805 | public void |
| 761 | onFocusChanged (boolean gainFocus) | 806 | onFocusChanged (boolean gainFocus) |
| 762 | { | 807 | { |
| 763 | EmacsActivity.invalidateFocus (); | 808 | EmacsActivity.invalidateFocus (gainFocus ? 6 : 5); |
| 764 | } | 809 | } |
| 765 | 810 | ||
| 766 | /* Notice that the activity has been detached or destroyed. | 811 | /* Notice that the activity has been detached or destroyed. |
| @@ -1746,7 +1791,7 @@ public final class EmacsWindow extends EmacsHandleObject | |||
| 1746 | 1791 | ||
| 1747 | /* Attempt to acquire permissions for this URI; | 1792 | /* Attempt to acquire permissions for this URI; |
| 1748 | failing which, insert it as text instead. */ | 1793 | failing which, insert it as text instead. */ |
| 1749 | 1794 | ||
| 1750 | if (uri != null | 1795 | if (uri != null |
| 1751 | && uri.getScheme () != null | 1796 | && uri.getScheme () != null |
| 1752 | && uri.getScheme ().equals ("content") | 1797 | && uri.getScheme ().equals ("content") |
diff --git a/leim/Makefile.in b/leim/Makefile.in index f7a23178919..bc1eeb5e634 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in | |||
| @@ -101,11 +101,11 @@ ${leimdir}/quail ${leimdir}/ja-dic: | |||
| 101 | ## All of TIT_GB and TIT_BIG5. | 101 | ## All of TIT_GB and TIT_BIG5. |
| 102 | ${leimdir}/quail/%.el: ${srcdir}/CXTERM-DIC/%.tit | 102 | ${leimdir}/quail/%.el: ${srcdir}/CXTERM-DIC/%.tit |
| 103 | $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv \ | 103 | $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv \ |
| 104 | -f batch-titdic-convert -dir ${leimdir}/quail $< | 104 | -f batch-tit-dic-convert -dir ${leimdir}/quail $< |
| 105 | 105 | ||
| 106 | 106 | ||
| 107 | misc_convert = $(AM_V_GEN)${RUN_EMACS} \ | 107 | misc_convert = $(AM_V_GEN)${RUN_EMACS} \ |
| 108 | -l titdic-cnv -f batch-miscdic-convert -dir ${leimdir}/quail | 108 | -l titdic-cnv -f batch-tit-miscdic-convert -dir ${leimdir}/quail |
| 109 | 109 | ||
| 110 | ## CTLau.el, CTLau-b5.el. | 110 | ## CTLau.el, CTLau-b5.el. |
| 111 | ${leimdir}/quail/CT%.el: ${srcdir}/MISC-DIC/CT%.html | 111 | ${leimdir}/quail/CT%.el: ${srcdir}/MISC-DIC/CT%.html |
| @@ -148,7 +148,7 @@ ${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L small-ja-dic-option | |||
| 148 | -f batch-skkdic-convert -dir "$(leimdir)/ja-dic" $(JA_DIC_NO_REDUCTION_OPTION) "$<" | 148 | -f batch-skkdic-convert -dir "$(leimdir)/ja-dic" $(JA_DIC_NO_REDUCTION_OPTION) "$<" |
| 149 | 149 | ||
| 150 | ${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map | 150 | ${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map |
| 151 | $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f pinyin-convert $< $@ | 151 | $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f tit-pinyin-convert $< $@ |
| 152 | 152 | ||
| 153 | 153 | ||
| 154 | .PHONY: bootstrap-clean distclean maintainer-clean gen-clean | 154 | .PHONY: bootstrap-clean distclean maintainer-clean gen-clean |
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 7c059640862..3cdf1620781 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in | |||
| @@ -319,7 +319,7 @@ maybe-blessmail: $(BLESSMAIL_TARGET) | |||
| 319 | ## up if chown or chgrp fails, as the package responsible for | 319 | ## up if chown or chgrp fails, as the package responsible for |
| 320 | ## installing Emacs can fix this problem later. | 320 | ## installing Emacs can fix this problem later. |
| 321 | $(DESTDIR)${archlibdir}: all | 321 | $(DESTDIR)${archlibdir}: all |
| 322 | $(info $ ) | 322 | $(info $.) |
| 323 | $(info Installing utilities run internally by Emacs.) | 323 | $(info Installing utilities run internally by Emacs.) |
| 324 | umask 022 && ${MKDIR_P} "$(DESTDIR)${archlibdir}" | 324 | umask 022 && ${MKDIR_P} "$(DESTDIR)${archlibdir}" |
| 325 | exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && pwd -P` && \ | 325 | exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && pwd -P` && \ |
| @@ -361,7 +361,7 @@ $(DESTDIR)${archlibdir}: all | |||
| 361 | .PHONY: bootstrap-clean check tags | 361 | .PHONY: bootstrap-clean check tags |
| 362 | 362 | ||
| 363 | install: $(DESTDIR)${archlibdir} | 363 | install: $(DESTDIR)${archlibdir} |
| 364 | $(info $ ) | 364 | $(info $.) |
| 365 | $(info Installing utilities for users to run.) | 365 | $(info Installing utilities for users to run.) |
| 366 | umask 022 && ${MKDIR_P} "$(DESTDIR)${bindir}" | 366 | umask 022 && ${MKDIR_P} "$(DESTDIR)${bindir}" |
| 367 | for file in ${INSTALLABLES} ; do \ | 367 | for file in ${INSTALLABLES} ; do \ |
diff --git a/lib/cdefs.h b/lib/cdefs.h index 87ddce319dc..d38382ad9d8 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h | |||
| @@ -42,8 +42,8 @@ | |||
| 42 | #if (defined __has_attribute \ | 42 | #if (defined __has_attribute \ |
| 43 | && (!defined __clang_minor__ \ | 43 | && (!defined __clang_minor__ \ |
| 44 | || (defined __apple_build_version__ \ | 44 | || (defined __apple_build_version__ \ |
| 45 | ? 6000000 <= __apple_build_version__ \ | 45 | ? 7000000 <= __apple_build_version__ \ |
| 46 | : 3 < __clang_major__ + (5 <= __clang_minor__)))) | 46 | : 5 <= __clang_major__))) |
| 47 | # define __glibc_has_attribute(attr) __has_attribute (attr) | 47 | # define __glibc_has_attribute(attr) __has_attribute (attr) |
| 48 | #else | 48 | #else |
| 49 | # define __glibc_has_attribute(attr) 0 | 49 | # define __glibc_has_attribute(attr) 0 |
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index fcf2b186038..711ddcf1260 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in | |||
| @@ -47,6 +47,7 @@ | |||
| 47 | # --avoid=iswdigit \ | 47 | # --avoid=iswdigit \ |
| 48 | # --avoid=iswxdigit \ | 48 | # --avoid=iswxdigit \ |
| 49 | # --avoid=langinfo \ | 49 | # --avoid=langinfo \ |
| 50 | # --avoid=localename-unsafe-limited \ | ||
| 50 | # --avoid=lock \ | 51 | # --avoid=lock \ |
| 51 | # --avoid=mbrtowc \ | 52 | # --avoid=mbrtowc \ |
| 52 | # --avoid=mbsinit \ | 53 | # --avoid=mbsinit \ |
| @@ -1185,6 +1186,7 @@ REPLACE_MB_CUR_MAX = @REPLACE_MB_CUR_MAX@ | |||
| 1185 | REPLACE_MEMCHR = @REPLACE_MEMCHR@ | 1186 | REPLACE_MEMCHR = @REPLACE_MEMCHR@ |
| 1186 | REPLACE_MEMMEM = @REPLACE_MEMMEM@ | 1187 | REPLACE_MEMMEM = @REPLACE_MEMMEM@ |
| 1187 | REPLACE_MEMPCPY = @REPLACE_MEMPCPY@ | 1188 | REPLACE_MEMPCPY = @REPLACE_MEMPCPY@ |
| 1189 | REPLACE_MEMSET_EXPLICIT = @REPLACE_MEMSET_EXPLICIT@ | ||
| 1188 | REPLACE_MKDIR = @REPLACE_MKDIR@ | 1190 | REPLACE_MKDIR = @REPLACE_MKDIR@ |
| 1189 | REPLACE_MKFIFO = @REPLACE_MKFIFO@ | 1191 | REPLACE_MKFIFO = @REPLACE_MKFIFO@ |
| 1190 | REPLACE_MKFIFOAT = @REPLACE_MKFIFOAT@ | 1192 | REPLACE_MKFIFOAT = @REPLACE_MKFIFOAT@ |
| @@ -1271,6 +1273,7 @@ REPLACE_SYMLINKAT = @REPLACE_SYMLINKAT@ | |||
| 1271 | REPLACE_TIME = @REPLACE_TIME@ | 1273 | REPLACE_TIME = @REPLACE_TIME@ |
| 1272 | REPLACE_TIMEGM = @REPLACE_TIMEGM@ | 1274 | REPLACE_TIMEGM = @REPLACE_TIMEGM@ |
| 1273 | REPLACE_TIMESPEC_GET = @REPLACE_TIMESPEC_GET@ | 1275 | REPLACE_TIMESPEC_GET = @REPLACE_TIMESPEC_GET@ |
| 1276 | REPLACE_TIMESPEC_GETRES = @REPLACE_TIMESPEC_GETRES@ | ||
| 1274 | REPLACE_TMPFILE = @REPLACE_TMPFILE@ | 1277 | REPLACE_TMPFILE = @REPLACE_TMPFILE@ |
| 1275 | REPLACE_TRUNCATE = @REPLACE_TRUNCATE@ | 1278 | REPLACE_TRUNCATE = @REPLACE_TRUNCATE@ |
| 1276 | REPLACE_TTYNAME_R = @REPLACE_TTYNAME_R@ | 1279 | REPLACE_TTYNAME_R = @REPLACE_TTYNAME_R@ |
| @@ -2743,7 +2746,9 @@ ifeq (,$(OMIT_GNULIB_MODULE_nstrftime)) | |||
| 2743 | 2746 | ||
| 2744 | libgnu_a_SOURCES += nstrftime.c | 2747 | libgnu_a_SOURCES += nstrftime.c |
| 2745 | 2748 | ||
| 2746 | EXTRA_DIST += strftime.h | 2749 | EXTRA_DIST += strftime.c strftime.h |
| 2750 | |||
| 2751 | EXTRA_libgnu_a_SOURCES += strftime.c | ||
| 2747 | 2752 | ||
| 2748 | endif | 2753 | endif |
| 2749 | ## end gnulib module nstrftime | 2754 | ## end gnulib module nstrftime |
| @@ -3560,6 +3565,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H | |||
| 3560 | -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ | 3565 | -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ |
| 3561 | -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \ | 3566 | -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \ |
| 3562 | -e 's|@''REPLACE_MEMPCPY''@|$(REPLACE_MEMPCPY)|g' \ | 3567 | -e 's|@''REPLACE_MEMPCPY''@|$(REPLACE_MEMPCPY)|g' \ |
| 3568 | -e 's|@''REPLACE_MEMSET_EXPLICIT''@|$(REPLACE_MEMSET_EXPLICIT)|g' \ | ||
| 3563 | -e 's|@''REPLACE_FREE''@|$(REPLACE_FREE)|g' \ | 3569 | -e 's|@''REPLACE_FREE''@|$(REPLACE_FREE)|g' \ |
| 3564 | -e 's|@''REPLACE_STPCPY''@|$(REPLACE_STPCPY)|g' \ | 3570 | -e 's|@''REPLACE_STPCPY''@|$(REPLACE_STPCPY)|g' \ |
| 3565 | -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \ | 3571 | -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \ |
| @@ -3892,6 +3898,7 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $( | |||
| 3892 | -e 's|@''REPLACE_TIME''@|$(REPLACE_TIME)|g' \ | 3898 | -e 's|@''REPLACE_TIME''@|$(REPLACE_TIME)|g' \ |
| 3893 | -e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ | 3899 | -e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ |
| 3894 | -e 's|@''REPLACE_TIMESPEC_GET''@|$(REPLACE_TIMESPEC_GET)|g' \ | 3900 | -e 's|@''REPLACE_TIMESPEC_GET''@|$(REPLACE_TIMESPEC_GET)|g' \ |
| 3901 | -e 's|@''REPLACE_TIMESPEC_GETRES''@|$(REPLACE_TIMESPEC_GETRES)|g' \ | ||
| 3895 | -e 's|@''REPLACE_TZSET''@|$(REPLACE_TZSET)|g' \ | 3902 | -e 's|@''REPLACE_TZSET''@|$(REPLACE_TZSET)|g' \ |
| 3896 | -e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \ | 3903 | -e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \ |
| 3897 | -e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ | 3904 | -e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ |
diff --git a/lib/limits.in.h b/lib/limits.in.h index 236fc58e525..c65eb4c1cfe 100644 --- a/lib/limits.in.h +++ b/lib/limits.in.h | |||
| @@ -130,7 +130,7 @@ | |||
| 130 | # define BOOL_WIDTH 1 | 130 | # define BOOL_WIDTH 1 |
| 131 | # define BOOL_MAX 1 | 131 | # define BOOL_MAX 1 |
| 132 | # elif ! defined BOOL_MAX | 132 | # elif ! defined BOOL_MAX |
| 133 | # define BOOL_MAX ((((1U << (BOOL_WIDTH - 1)) - 1) << 1) + 1) | 133 | # define BOOL_MAX 1 |
| 134 | # endif | 134 | # endif |
| 135 | #endif | 135 | #endif |
| 136 | 136 | ||
diff --git a/lib/nstrftime.c b/lib/nstrftime.c index 69e4164dc0c..88490064297 100644 --- a/lib/nstrftime.c +++ b/lib/nstrftime.c | |||
| @@ -1,5 +1,6 @@ | |||
| 1 | /* Copyright (C) 1991-2024 Free Software Foundation, Inc. | 1 | /* Generate time strings. |
| 2 | This file is part of the GNU C Library. | 2 | |
| 3 | Copyright (C) 2024 Free Software Foundation, Inc. | ||
| 3 | 4 | ||
| 4 | This file is free software: you can redistribute it and/or modify | 5 | This file is free software: you can redistribute it and/or modify |
| 5 | it under the terms of the GNU Lesser General Public License as | 6 | it under the terms of the GNU Lesser General Public License as |
| @@ -14,1497 +15,5 @@ | |||
| 14 | You should have received a copy of the GNU Lesser General Public License | 15 | You should have received a copy of the GNU Lesser General Public License |
| 15 | along with this program. If not, see <https://www.gnu.org/licenses/>. */ | 16 | along with this program. If not, see <https://www.gnu.org/licenses/>. */ |
| 16 | 17 | ||
| 17 | #ifdef _LIBC | 18 | #define my_strftime nstrftime |
| 18 | # define USE_IN_EXTENDED_LOCALE_MODEL 1 | 19 | #include "strftime.c" |
| 19 | # define HAVE_STRUCT_ERA_ENTRY 1 | ||
| 20 | # define HAVE_TM_GMTOFF 1 | ||
| 21 | # define HAVE_STRUCT_TM_TM_ZONE 1 | ||
| 22 | # define HAVE_TZNAME 1 | ||
| 23 | # include "../locale/localeinfo.h" | ||
| 24 | #else | ||
| 25 | # include <libc-config.h> | ||
| 26 | # if FPRINTFTIME | ||
| 27 | # include "fprintftime.h" | ||
| 28 | # else | ||
| 29 | # include "strftime.h" | ||
| 30 | # endif | ||
| 31 | # include "time-internal.h" | ||
| 32 | #endif | ||
| 33 | |||
| 34 | #include <ctype.h> | ||
| 35 | #include <errno.h> | ||
| 36 | #include <time.h> | ||
| 37 | |||
| 38 | #if HAVE_TZNAME && !HAVE_DECL_TZNAME | ||
| 39 | extern char *tzname[]; | ||
| 40 | #endif | ||
| 41 | |||
| 42 | /* Do multibyte processing if multibyte encodings are supported, unless | ||
| 43 | multibyte sequences are safe in formats. Multibyte sequences are | ||
| 44 | safe if they cannot contain byte sequences that look like format | ||
| 45 | conversion specifications. The multibyte encodings used by the | ||
| 46 | C library on the various platforms (UTF-8, GB2312, GBK, CP936, | ||
| 47 | GB18030, EUC-TW, BIG5, BIG5-HKSCS, CP950, EUC-JP, EUC-KR, CP949, | ||
| 48 | SHIFT_JIS, CP932, JOHAB) are safe for formats, because the byte '%' | ||
| 49 | cannot occur in a multibyte character except in the first byte. | ||
| 50 | |||
| 51 | The DEC-HANYU encoding used on OSF/1 is not safe for formats, but | ||
| 52 | this encoding has never been seen in real-life use, so we ignore | ||
| 53 | it. */ | ||
| 54 | #if !(defined __osf__ && 0) | ||
| 55 | # define MULTIBYTE_IS_FORMAT_SAFE 1 | ||
| 56 | #endif | ||
| 57 | #define DO_MULTIBYTE (! MULTIBYTE_IS_FORMAT_SAFE) | ||
| 58 | |||
| 59 | #if DO_MULTIBYTE | ||
| 60 | # include <wchar.h> | ||
| 61 | static const mbstate_t mbstate_zero; | ||
| 62 | #endif | ||
| 63 | |||
| 64 | #include <limits.h> | ||
| 65 | #include <stdckdint.h> | ||
| 66 | #include <stddef.h> | ||
| 67 | #include <stdlib.h> | ||
| 68 | #include <string.h> | ||
| 69 | |||
| 70 | #include "attribute.h" | ||
| 71 | #include <intprops.h> | ||
| 72 | |||
| 73 | #ifdef COMPILE_WIDE | ||
| 74 | # include <endian.h> | ||
| 75 | # define CHAR_T wchar_t | ||
| 76 | # define UCHAR_T unsigned int | ||
| 77 | # define L_(Str) L##Str | ||
| 78 | # define NLW(Sym) _NL_W##Sym | ||
| 79 | |||
| 80 | # define MEMCPY(d, s, n) __wmemcpy (d, s, n) | ||
| 81 | # define STRLEN(s) __wcslen (s) | ||
| 82 | |||
| 83 | #else | ||
| 84 | # define CHAR_T char | ||
| 85 | # define UCHAR_T unsigned char | ||
| 86 | # define L_(Str) Str | ||
| 87 | # define NLW(Sym) Sym | ||
| 88 | # define ABALTMON_1 _NL_ABALTMON_1 | ||
| 89 | |||
| 90 | # define MEMCPY(d, s, n) memcpy (d, s, n) | ||
| 91 | # define STRLEN(s) strlen (s) | ||
| 92 | |||
| 93 | #endif | ||
| 94 | |||
| 95 | /* Shift A right by B bits portably, by dividing A by 2**B and | ||
| 96 | truncating towards minus infinity. A and B should be free of side | ||
| 97 | effects, and B should be in the range 0 <= B <= INT_BITS - 2, where | ||
| 98 | INT_BITS is the number of useful bits in an int. GNU code can | ||
| 99 | assume that INT_BITS is at least 32. | ||
| 100 | |||
| 101 | ISO C99 says that A >> B is implementation-defined if A < 0. Some | ||
| 102 | implementations (e.g., UNICOS 9.0 on a Cray Y-MP EL) don't shift | ||
| 103 | right in the usual way when A < 0, so SHR falls back on division if | ||
| 104 | ordinary A >> B doesn't seem to be the usual signed shift. */ | ||
| 105 | #define SHR(a, b) \ | ||
| 106 | (-1 >> 1 == -1 \ | ||
| 107 | ? (a) >> (b) \ | ||
| 108 | : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0)) | ||
| 109 | |||
| 110 | #define TM_YEAR_BASE 1900 | ||
| 111 | |||
| 112 | #ifndef __isleap | ||
| 113 | /* Nonzero if YEAR is a leap year (every 4 years, | ||
| 114 | except every 100th isn't, and every 400th is). */ | ||
| 115 | # define __isleap(year) \ | ||
| 116 | ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0)) | ||
| 117 | #endif | ||
| 118 | |||
| 119 | |||
| 120 | #ifdef _LIBC | ||
| 121 | # define mktime_z(tz, tm) mktime (tm) | ||
| 122 | # define tzname __tzname | ||
| 123 | # define tzset __tzset | ||
| 124 | #endif | ||
| 125 | |||
| 126 | #ifndef FPRINTFTIME | ||
| 127 | # define FPRINTFTIME 0 | ||
| 128 | #endif | ||
| 129 | |||
| 130 | #if FPRINTFTIME | ||
| 131 | # define STREAM_OR_CHAR_T FILE | ||
| 132 | # define STRFTIME_ARG(x) /* empty */ | ||
| 133 | #else | ||
| 134 | # define STREAM_OR_CHAR_T CHAR_T | ||
| 135 | # define STRFTIME_ARG(x) x, | ||
| 136 | #endif | ||
| 137 | |||
| 138 | #if FPRINTFTIME | ||
| 139 | # define memset_byte(P, Len, Byte) \ | ||
| 140 | do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0) | ||
| 141 | # define memset_space(P, Len) memset_byte (P, Len, ' ') | ||
| 142 | # define memset_zero(P, Len) memset_byte (P, Len, '0') | ||
| 143 | #elif defined COMPILE_WIDE | ||
| 144 | # define memset_space(P, Len) (wmemset (P, L' ', Len), (P) += (Len)) | ||
| 145 | # define memset_zero(P, Len) (wmemset (P, L'0', Len), (P) += (Len)) | ||
| 146 | #else | ||
| 147 | # define memset_space(P, Len) (memset (P, ' ', Len), (P) += (Len)) | ||
| 148 | # define memset_zero(P, Len) (memset (P, '0', Len), (P) += (Len)) | ||
| 149 | #endif | ||
| 150 | |||
| 151 | #if FPRINTFTIME | ||
| 152 | # define advance(P, N) | ||
| 153 | #else | ||
| 154 | # define advance(P, N) ((P) += (N)) | ||
| 155 | #endif | ||
| 156 | |||
| 157 | #define add(n, f) width_add (width, n, f) | ||
| 158 | #define width_add(width, n, f) \ | ||
| 159 | do \ | ||
| 160 | { \ | ||
| 161 | size_t _n = (n); \ | ||
| 162 | size_t _w = pad == L_('-') || width < 0 ? 0 : width; \ | ||
| 163 | size_t _incr = _n < _w ? _w : _n; \ | ||
| 164 | if (_incr >= maxsize - i) \ | ||
| 165 | { \ | ||
| 166 | errno = ERANGE; \ | ||
| 167 | return 0; \ | ||
| 168 | } \ | ||
| 169 | if (p) \ | ||
| 170 | { \ | ||
| 171 | if (_n < _w) \ | ||
| 172 | { \ | ||
| 173 | size_t _delta = _w - _n; \ | ||
| 174 | if (pad == L_('0') || pad == L_('+')) \ | ||
| 175 | memset_zero (p, _delta); \ | ||
| 176 | else \ | ||
| 177 | memset_space (p, _delta); \ | ||
| 178 | } \ | ||
| 179 | f; \ | ||
| 180 | advance (p, _n); \ | ||
| 181 | } \ | ||
| 182 | i += _incr; \ | ||
| 183 | } while (0) | ||
| 184 | |||
| 185 | #define add1(c) width_add1 (width, c) | ||
| 186 | #if FPRINTFTIME | ||
| 187 | # define width_add1(width, c) width_add (width, 1, fputc (c, p)) | ||
| 188 | #else | ||
| 189 | # define width_add1(width, c) width_add (width, 1, *p = c) | ||
| 190 | #endif | ||
| 191 | |||
| 192 | #define cpy(n, s) width_cpy (width, n, s) | ||
| 193 | #if FPRINTFTIME | ||
| 194 | # define width_cpy(width, n, s) \ | ||
| 195 | width_add (width, n, \ | ||
| 196 | do \ | ||
| 197 | { \ | ||
| 198 | if (to_lowcase) \ | ||
| 199 | fwrite_lowcase (p, (s), _n); \ | ||
| 200 | else if (to_uppcase) \ | ||
| 201 | fwrite_uppcase (p, (s), _n); \ | ||
| 202 | else \ | ||
| 203 | { \ | ||
| 204 | /* Ignore the value of fwrite. The caller can determine whether \ | ||
| 205 | an error occurred by inspecting ferror (P). All known fwrite \ | ||
| 206 | implementations set the stream's error indicator when they \ | ||
| 207 | fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \ | ||
| 208 | not require this. */ \ | ||
| 209 | fwrite (s, _n, 1, p); \ | ||
| 210 | } \ | ||
| 211 | } \ | ||
| 212 | while (0) \ | ||
| 213 | ) | ||
| 214 | #else | ||
| 215 | # define width_cpy(width, n, s) \ | ||
| 216 | width_add (width, n, \ | ||
| 217 | if (to_lowcase) \ | ||
| 218 | memcpy_lowcase (p, (s), _n LOCALE_ARG); \ | ||
| 219 | else if (to_uppcase) \ | ||
| 220 | memcpy_uppcase (p, (s), _n LOCALE_ARG); \ | ||
| 221 | else \ | ||
| 222 | MEMCPY ((void *) p, (void const *) (s), _n)) | ||
| 223 | #endif | ||
| 224 | |||
| 225 | #ifdef COMPILE_WIDE | ||
| 226 | # ifndef USE_IN_EXTENDED_LOCALE_MODEL | ||
| 227 | # undef __mbsrtowcs_l | ||
| 228 | # define __mbsrtowcs_l(d, s, l, st, loc) __mbsrtowcs (d, s, l, st) | ||
| 229 | # endif | ||
| 230 | #endif | ||
| 231 | |||
| 232 | |||
| 233 | #if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL | ||
| 234 | /* We use this code also for the extended locale handling where the | ||
| 235 | function gets as an additional argument the locale which has to be | ||
| 236 | used. To access the values we have to redefine the _NL_CURRENT | ||
| 237 | macro. */ | ||
| 238 | # define strftime __strftime_l | ||
| 239 | # define wcsftime __wcsftime_l | ||
| 240 | # undef _NL_CURRENT | ||
| 241 | # define _NL_CURRENT(category, item) \ | ||
| 242 | (current->values[_NL_ITEM_INDEX (item)].string) | ||
| 243 | # define LOCALE_PARAM , locale_t loc | ||
| 244 | # define LOCALE_ARG , loc | ||
| 245 | # define HELPER_LOCALE_ARG , current | ||
| 246 | #else | ||
| 247 | # define LOCALE_PARAM | ||
| 248 | # define LOCALE_ARG | ||
| 249 | # ifdef _LIBC | ||
| 250 | # define HELPER_LOCALE_ARG , _NL_CURRENT_DATA (LC_TIME) | ||
| 251 | # else | ||
| 252 | # define HELPER_LOCALE_ARG | ||
| 253 | # endif | ||
| 254 | #endif | ||
| 255 | |||
| 256 | #ifdef COMPILE_WIDE | ||
| 257 | # ifdef USE_IN_EXTENDED_LOCALE_MODEL | ||
| 258 | # define TOUPPER(Ch, L) __towupper_l (Ch, L) | ||
| 259 | # define TOLOWER(Ch, L) __towlower_l (Ch, L) | ||
| 260 | # else | ||
| 261 | # define TOUPPER(Ch, L) towupper (Ch) | ||
| 262 | # define TOLOWER(Ch, L) towlower (Ch) | ||
| 263 | # endif | ||
| 264 | #else | ||
| 265 | # ifdef USE_IN_EXTENDED_LOCALE_MODEL | ||
| 266 | # define TOUPPER(Ch, L) __toupper_l (Ch, L) | ||
| 267 | # define TOLOWER(Ch, L) __tolower_l (Ch, L) | ||
| 268 | # else | ||
| 269 | # define TOUPPER(Ch, L) toupper (Ch) | ||
| 270 | # define TOLOWER(Ch, L) tolower (Ch) | ||
| 271 | # endif | ||
| 272 | #endif | ||
| 273 | /* We don't use 'isdigit' here since the locale dependent | ||
| 274 | interpretation is not what we want here. We only need to accept | ||
| 275 | the arabic digits in the ASCII range. One day there is perhaps a | ||
| 276 | more reliable way to accept other sets of digits. */ | ||
| 277 | #define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9) | ||
| 278 | |||
| 279 | /* Avoid false GCC warning "'memset' specified size 18446744073709551615 exceeds | ||
| 280 | maximum object size 9223372036854775807", caused by insufficient data flow | ||
| 281 | analysis and value propagation of the 'width_add' expansion when GCC is not | ||
| 282 | optimizing. Cf. <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88443>. */ | ||
| 283 | #if __GNUC__ >= 7 && !__OPTIMIZE__ | ||
| 284 | # pragma GCC diagnostic ignored "-Wstringop-overflow" | ||
| 285 | #endif | ||
| 286 | |||
| 287 | #if FPRINTFTIME | ||
| 288 | static void | ||
| 289 | fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len) | ||
| 290 | { | ||
| 291 | while (len-- > 0) | ||
| 292 | { | ||
| 293 | fputc (TOLOWER ((UCHAR_T) *src, loc), fp); | ||
| 294 | ++src; | ||
| 295 | } | ||
| 296 | } | ||
| 297 | |||
| 298 | static void | ||
| 299 | fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len) | ||
| 300 | { | ||
| 301 | while (len-- > 0) | ||
| 302 | { | ||
| 303 | fputc (TOUPPER ((UCHAR_T) *src, loc), fp); | ||
| 304 | ++src; | ||
| 305 | } | ||
| 306 | } | ||
| 307 | #else | ||
| 308 | static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, | ||
| 309 | size_t len LOCALE_PARAM); | ||
| 310 | |||
| 311 | static CHAR_T * | ||
| 312 | memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) | ||
| 313 | { | ||
| 314 | while (len-- > 0) | ||
| 315 | dest[len] = TOLOWER ((UCHAR_T) src[len], loc); | ||
| 316 | return dest; | ||
| 317 | } | ||
| 318 | |||
| 319 | static CHAR_T *memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, | ||
| 320 | size_t len LOCALE_PARAM); | ||
| 321 | |||
| 322 | static CHAR_T * | ||
| 323 | memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) | ||
| 324 | { | ||
| 325 | while (len-- > 0) | ||
| 326 | dest[len] = TOUPPER ((UCHAR_T) src[len], loc); | ||
| 327 | return dest; | ||
| 328 | } | ||
| 329 | #endif | ||
| 330 | |||
| 331 | |||
| 332 | #if ! HAVE_TM_GMTOFF | ||
| 333 | /* Yield the difference between *A and *B, | ||
| 334 | measured in seconds, ignoring leap seconds. */ | ||
| 335 | # define tm_diff ftime_tm_diff | ||
| 336 | static int tm_diff (const struct tm *, const struct tm *); | ||
| 337 | static int | ||
| 338 | tm_diff (const struct tm *a, const struct tm *b) | ||
| 339 | { | ||
| 340 | /* Compute intervening leap days correctly even if year is negative. | ||
| 341 | Take care to avoid int overflow in leap day calculations, | ||
| 342 | but it's OK to assume that A and B are close to each other. */ | ||
| 343 | int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3); | ||
| 344 | int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3); | ||
| 345 | int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0); | ||
| 346 | int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0); | ||
| 347 | int a400 = SHR (a100, 2); | ||
| 348 | int b400 = SHR (b100, 2); | ||
| 349 | int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); | ||
| 350 | int years = a->tm_year - b->tm_year; | ||
| 351 | int days = (365 * years + intervening_leap_days | ||
| 352 | + (a->tm_yday - b->tm_yday)); | ||
| 353 | return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) | ||
| 354 | + (a->tm_min - b->tm_min)) | ||
| 355 | + (a->tm_sec - b->tm_sec)); | ||
| 356 | } | ||
| 357 | #endif /* ! HAVE_TM_GMTOFF */ | ||
| 358 | |||
| 359 | |||
| 360 | |||
| 361 | /* The number of days from the first day of the first ISO week of this | ||
| 362 | year to the year day YDAY with week day WDAY. ISO weeks start on | ||
| 363 | Monday; the first ISO week has the year's first Thursday. YDAY may | ||
| 364 | be as small as YDAY_MINIMUM. */ | ||
| 365 | #define ISO_WEEK_START_WDAY 1 /* Monday */ | ||
| 366 | #define ISO_WEEK1_WDAY 4 /* Thursday */ | ||
| 367 | #define YDAY_MINIMUM (-366) | ||
| 368 | static int iso_week_days (int, int); | ||
| 369 | static __inline int | ||
| 370 | iso_week_days (int yday, int wday) | ||
| 371 | { | ||
| 372 | /* Add enough to the first operand of % to make it nonnegative. */ | ||
| 373 | int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7; | ||
| 374 | return (yday | ||
| 375 | - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7 | ||
| 376 | + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY); | ||
| 377 | } | ||
| 378 | |||
| 379 | |||
| 380 | /* When compiling this file, GNU applications can #define my_strftime | ||
| 381 | to a symbol (typically nstrftime) to get an extended strftime with | ||
| 382 | extra arguments TZ and NS. */ | ||
| 383 | |||
| 384 | #if FPRINTFTIME | ||
| 385 | # undef my_strftime | ||
| 386 | # define my_strftime fprintftime | ||
| 387 | #endif | ||
| 388 | |||
| 389 | #ifdef my_strftime | ||
| 390 | # define extra_args , tz, ns | ||
| 391 | # define extra_args_spec , timezone_t tz, int ns | ||
| 392 | #else | ||
| 393 | # if defined COMPILE_WIDE | ||
| 394 | # define my_strftime wcsftime | ||
| 395 | # define nl_get_alt_digit _nl_get_walt_digit | ||
| 396 | # else | ||
| 397 | # define my_strftime strftime | ||
| 398 | # define nl_get_alt_digit _nl_get_alt_digit | ||
| 399 | # endif | ||
| 400 | # define extra_args | ||
| 401 | # define extra_args_spec | ||
| 402 | /* We don't have this information in general. */ | ||
| 403 | # define tz 1 | ||
| 404 | # define ns 0 | ||
| 405 | #endif | ||
| 406 | |||
| 407 | static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t) | ||
| 408 | const CHAR_T *, const struct tm *, | ||
| 409 | bool, int, int, bool * | ||
| 410 | extra_args_spec LOCALE_PARAM); | ||
| 411 | |||
| 412 | /* Write information from TP into S according to the format | ||
| 413 | string FORMAT, writing no more that MAXSIZE characters | ||
| 414 | (including the terminating '\0') and returning number of | ||
| 415 | characters written. If S is NULL, nothing will be written | ||
| 416 | anywhere, so to determine how many characters would be | ||
| 417 | written, use NULL for S and (size_t) -1 for MAXSIZE. */ | ||
| 418 | size_t | ||
| 419 | my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) | ||
| 420 | const CHAR_T *format, | ||
| 421 | const struct tm *tp extra_args_spec LOCALE_PARAM) | ||
| 422 | { | ||
| 423 | bool tzset_called = false; | ||
| 424 | return __strftime_internal (s, STRFTIME_ARG (maxsize) format, tp, false, | ||
| 425 | 0, -1, &tzset_called extra_args LOCALE_ARG); | ||
| 426 | } | ||
| 427 | libc_hidden_def (my_strftime) | ||
| 428 | |||
| 429 | /* Just like my_strftime, above, but with more parameters. | ||
| 430 | UPCASE indicates that the result should be converted to upper case. | ||
| 431 | YR_SPEC and WIDTH specify the padding and width for the year. | ||
| 432 | *TZSET_CALLED indicates whether tzset has been called here. */ | ||
| 433 | static size_t | ||
| 434 | __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) | ||
| 435 | const CHAR_T *format, | ||
| 436 | const struct tm *tp, bool upcase, | ||
| 437 | int yr_spec, int width, bool *tzset_called | ||
| 438 | extra_args_spec LOCALE_PARAM) | ||
| 439 | { | ||
| 440 | #if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL | ||
| 441 | struct __locale_data *const current = loc->__locales[LC_TIME]; | ||
| 442 | #endif | ||
| 443 | #if FPRINTFTIME | ||
| 444 | size_t maxsize = (size_t) -1; | ||
| 445 | #endif | ||
| 446 | |||
| 447 | int saved_errno = errno; | ||
| 448 | int hour12 = tp->tm_hour; | ||
| 449 | #ifdef _NL_CURRENT | ||
| 450 | /* We cannot make the following values variables since we must delay | ||
| 451 | the evaluation of these values until really needed since some | ||
| 452 | expressions might not be valid in every situation. The 'struct tm' | ||
| 453 | might be generated by a strptime() call that initialized | ||
| 454 | only a few elements. Dereference the pointers only if the format | ||
| 455 | requires this. Then it is ok to fail if the pointers are invalid. */ | ||
| 456 | # define a_wkday \ | ||
| 457 | ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ | ||
| 458 | ? "?" : _NL_CURRENT (LC_TIME, NLW(ABDAY_1) + tp->tm_wday))) | ||
| 459 | # define f_wkday \ | ||
| 460 | ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ | ||
| 461 | ? "?" : _NL_CURRENT (LC_TIME, NLW(DAY_1) + tp->tm_wday))) | ||
| 462 | # define a_month \ | ||
| 463 | ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ | ||
| 464 | ? "?" : _NL_CURRENT (LC_TIME, NLW(ABMON_1) + tp->tm_mon))) | ||
| 465 | # define f_month \ | ||
| 466 | ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ | ||
| 467 | ? "?" : _NL_CURRENT (LC_TIME, NLW(MON_1) + tp->tm_mon))) | ||
| 468 | # define a_altmonth \ | ||
| 469 | ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ | ||
| 470 | ? "?" : _NL_CURRENT (LC_TIME, NLW(ABALTMON_1) + tp->tm_mon))) | ||
| 471 | # define f_altmonth \ | ||
| 472 | ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ | ||
| 473 | ? "?" : _NL_CURRENT (LC_TIME, NLW(ALTMON_1) + tp->tm_mon))) | ||
| 474 | # define ampm \ | ||
| 475 | ((const CHAR_T *) _NL_CURRENT (LC_TIME, tp->tm_hour > 11 \ | ||
| 476 | ? NLW(PM_STR) : NLW(AM_STR))) | ||
| 477 | |||
| 478 | # define aw_len STRLEN (a_wkday) | ||
| 479 | # define am_len STRLEN (a_month) | ||
| 480 | # define aam_len STRLEN (a_altmonth) | ||
| 481 | # define ap_len STRLEN (ampm) | ||
| 482 | #endif | ||
| 483 | #if HAVE_TZNAME | ||
| 484 | char **tzname_vec = tzname; | ||
| 485 | #endif | ||
| 486 | const char *zone; | ||
| 487 | size_t i = 0; | ||
| 488 | STREAM_OR_CHAR_T *p = s; | ||
| 489 | const CHAR_T *f; | ||
| 490 | #if DO_MULTIBYTE && !defined COMPILE_WIDE | ||
| 491 | const char *format_end = NULL; | ||
| 492 | #endif | ||
| 493 | |||
| 494 | zone = NULL; | ||
| 495 | #if HAVE_STRUCT_TM_TM_ZONE | ||
| 496 | /* The POSIX test suite assumes that setting | ||
| 497 | the environment variable TZ to a new value before calling strftime() | ||
| 498 | will influence the result (the %Z format) even if the information in | ||
| 499 | TP is computed with a totally different time zone. | ||
| 500 | This is bogus: though POSIX allows bad behavior like this, | ||
| 501 | POSIX does not require it. Do the right thing instead. */ | ||
| 502 | zone = (const char *) tp->tm_zone; | ||
| 503 | #endif | ||
| 504 | #if HAVE_TZNAME | ||
| 505 | if (!tz) | ||
| 506 | { | ||
| 507 | if (! (zone && *zone)) | ||
| 508 | zone = "GMT"; | ||
| 509 | } | ||
| 510 | else | ||
| 511 | { | ||
| 512 | # if !HAVE_STRUCT_TM_TM_ZONE | ||
| 513 | /* Infer the zone name from *TZ instead of from TZNAME. */ | ||
| 514 | tzname_vec = tz->tzname_copy; | ||
| 515 | # endif | ||
| 516 | } | ||
| 517 | /* The tzset() call might have changed the value. */ | ||
| 518 | if (!(zone && *zone) && tp->tm_isdst >= 0) | ||
| 519 | { | ||
| 520 | /* POSIX.1 requires that local time zone information be used as | ||
| 521 | though strftime called tzset. */ | ||
| 522 | # ifndef my_strftime | ||
| 523 | if (!*tzset_called) | ||
| 524 | { | ||
| 525 | tzset (); | ||
| 526 | *tzset_called = true; | ||
| 527 | } | ||
| 528 | # endif | ||
| 529 | zone = tzname_vec[tp->tm_isdst != 0]; | ||
| 530 | } | ||
| 531 | #endif | ||
| 532 | if (! zone) | ||
| 533 | zone = ""; | ||
| 534 | |||
| 535 | if (hour12 > 12) | ||
| 536 | hour12 -= 12; | ||
| 537 | else | ||
| 538 | if (hour12 == 0) | ||
| 539 | hour12 = 12; | ||
| 540 | |||
| 541 | for (f = format; *f != '\0'; width = -1, f++) | ||
| 542 | { | ||
| 543 | int pad = 0; /* Padding for number ('_', '-', '+', '0', or 0). */ | ||
| 544 | int modifier; /* Field modifier ('E', 'O', or 0). */ | ||
| 545 | int digits = 0; /* Max digits for numeric format. */ | ||
| 546 | int number_value; /* Numeric value to be printed. */ | ||
| 547 | unsigned int u_number_value; /* (unsigned int) number_value. */ | ||
| 548 | bool negative_number; /* The number is negative. */ | ||
| 549 | bool always_output_a_sign; /* +/- should always be output. */ | ||
| 550 | int tz_colon_mask; /* Bitmask of where ':' should appear. */ | ||
| 551 | const CHAR_T *subfmt; | ||
| 552 | CHAR_T *bufp; | ||
| 553 | CHAR_T buf[1 | ||
| 554 | + 2 /* for the two colons in a %::z or %:::z time zone */ | ||
| 555 | + (sizeof (int) < sizeof (time_t) | ||
| 556 | ? INT_STRLEN_BOUND (time_t) | ||
| 557 | : INT_STRLEN_BOUND (int))]; | ||
| 558 | bool to_lowcase = false; | ||
| 559 | bool to_uppcase = upcase; | ||
| 560 | size_t colons; | ||
| 561 | bool change_case = false; | ||
| 562 | int format_char; | ||
| 563 | int subwidth; | ||
| 564 | |||
| 565 | #if DO_MULTIBYTE && !defined COMPILE_WIDE | ||
| 566 | switch (*f) | ||
| 567 | { | ||
| 568 | case L_('%'): | ||
| 569 | break; | ||
| 570 | |||
| 571 | case L_('\b'): case L_('\t'): case L_('\n'): | ||
| 572 | case L_('\v'): case L_('\f'): case L_('\r'): | ||
| 573 | case L_(' '): case L_('!'): case L_('"'): case L_('#'): case L_('&'): | ||
| 574 | case L_('\''): case L_('('): case L_(')'): case L_('*'): case L_('+'): | ||
| 575 | case L_(','): case L_('-'): case L_('.'): case L_('/'): case L_('0'): | ||
| 576 | case L_('1'): case L_('2'): case L_('3'): case L_('4'): case L_('5'): | ||
| 577 | case L_('6'): case L_('7'): case L_('8'): case L_('9'): case L_(':'): | ||
| 578 | case L_(';'): case L_('<'): case L_('='): case L_('>'): case L_('?'): | ||
| 579 | case L_('A'): case L_('B'): case L_('C'): case L_('D'): case L_('E'): | ||
| 580 | case L_('F'): case L_('G'): case L_('H'): case L_('I'): case L_('J'): | ||
| 581 | case L_('K'): case L_('L'): case L_('M'): case L_('N'): case L_('O'): | ||
| 582 | case L_('P'): case L_('Q'): case L_('R'): case L_('S'): case L_('T'): | ||
| 583 | case L_('U'): case L_('V'): case L_('W'): case L_('X'): case L_('Y'): | ||
| 584 | case L_('Z'): case L_('['): case L_('\\'): case L_(']'): case L_('^'): | ||
| 585 | case L_('_'): case L_('a'): case L_('b'): case L_('c'): case L_('d'): | ||
| 586 | case L_('e'): case L_('f'): case L_('g'): case L_('h'): case L_('i'): | ||
| 587 | case L_('j'): case L_('k'): case L_('l'): case L_('m'): case L_('n'): | ||
| 588 | case L_('o'): case L_('p'): case L_('q'): case L_('r'): case L_('s'): | ||
| 589 | case L_('t'): case L_('u'): case L_('v'): case L_('w'): case L_('x'): | ||
| 590 | case L_('y'): case L_('z'): case L_('{'): case L_('|'): case L_('}'): | ||
| 591 | case L_('~'): | ||
| 592 | /* The C Standard requires these 98 characters (plus '%') to | ||
| 593 | be in the basic execution character set. None of these | ||
| 594 | characters can start a multibyte sequence, so they need | ||
| 595 | not be analyzed further. */ | ||
| 596 | add1 (*f); | ||
| 597 | continue; | ||
| 598 | |||
| 599 | default: | ||
| 600 | /* Copy this multibyte sequence until we reach its end, find | ||
| 601 | an error, or come back to the initial shift state. */ | ||
| 602 | { | ||
| 603 | mbstate_t mbstate = mbstate_zero; | ||
| 604 | size_t len = 0; | ||
| 605 | size_t fsize; | ||
| 606 | |||
| 607 | if (! format_end) | ||
| 608 | format_end = f + strlen (f) + 1; | ||
| 609 | fsize = format_end - f; | ||
| 610 | |||
| 611 | do | ||
| 612 | { | ||
| 613 | size_t bytes = mbrlen (f + len, fsize - len, &mbstate); | ||
| 614 | |||
| 615 | if (bytes == 0) | ||
| 616 | break; | ||
| 617 | |||
| 618 | if (bytes == (size_t) -2) | ||
| 619 | { | ||
| 620 | len += strlen (f + len); | ||
| 621 | break; | ||
| 622 | } | ||
| 623 | |||
| 624 | if (bytes == (size_t) -1) | ||
| 625 | { | ||
| 626 | len++; | ||
| 627 | break; | ||
| 628 | } | ||
| 629 | |||
| 630 | len += bytes; | ||
| 631 | } | ||
| 632 | while (! mbsinit (&mbstate)); | ||
| 633 | |||
| 634 | cpy (len, f); | ||
| 635 | f += len - 1; | ||
| 636 | continue; | ||
| 637 | } | ||
| 638 | } | ||
| 639 | |||
| 640 | #else /* ! DO_MULTIBYTE */ | ||
| 641 | |||
| 642 | /* Either multibyte encodings are not supported, they are | ||
| 643 | safe for formats, so any non-'%' byte can be copied through, | ||
| 644 | or this is the wide character version. */ | ||
| 645 | if (*f != L_('%')) | ||
| 646 | { | ||
| 647 | add1 (*f); | ||
| 648 | continue; | ||
| 649 | } | ||
| 650 | |||
| 651 | #endif /* ! DO_MULTIBYTE */ | ||
| 652 | |||
| 653 | char const *percent = f; | ||
| 654 | |||
| 655 | /* Check for flags that can modify a format. */ | ||
| 656 | while (1) | ||
| 657 | { | ||
| 658 | switch (*++f) | ||
| 659 | { | ||
| 660 | /* This influences the number formats. */ | ||
| 661 | case L_('_'): | ||
| 662 | case L_('-'): | ||
| 663 | case L_('+'): | ||
| 664 | case L_('0'): | ||
| 665 | pad = *f; | ||
| 666 | continue; | ||
| 667 | |||
| 668 | /* This changes textual output. */ | ||
| 669 | case L_('^'): | ||
| 670 | to_uppcase = true; | ||
| 671 | continue; | ||
| 672 | case L_('#'): | ||
| 673 | change_case = true; | ||
| 674 | continue; | ||
| 675 | |||
| 676 | default: | ||
| 677 | break; | ||
| 678 | } | ||
| 679 | break; | ||
| 680 | } | ||
| 681 | |||
| 682 | if (ISDIGIT (*f)) | ||
| 683 | { | ||
| 684 | width = 0; | ||
| 685 | do | ||
| 686 | { | ||
| 687 | if (ckd_mul (&width, width, 10) | ||
| 688 | || ckd_add (&width, width, *f - L_('0'))) | ||
| 689 | width = INT_MAX; | ||
| 690 | ++f; | ||
| 691 | } | ||
| 692 | while (ISDIGIT (*f)); | ||
| 693 | } | ||
| 694 | |||
| 695 | /* Check for modifiers. */ | ||
| 696 | switch (*f) | ||
| 697 | { | ||
| 698 | case L_('E'): | ||
| 699 | case L_('O'): | ||
| 700 | modifier = *f++; | ||
| 701 | break; | ||
| 702 | |||
| 703 | default: | ||
| 704 | modifier = 0; | ||
| 705 | break; | ||
| 706 | } | ||
| 707 | |||
| 708 | /* Now do the specified format. */ | ||
| 709 | format_char = *f; | ||
| 710 | switch (format_char) | ||
| 711 | { | ||
| 712 | #define DO_NUMBER(d, v) \ | ||
| 713 | do \ | ||
| 714 | { \ | ||
| 715 | digits = d; \ | ||
| 716 | number_value = v; \ | ||
| 717 | goto do_number; \ | ||
| 718 | } \ | ||
| 719 | while (0) | ||
| 720 | #define DO_SIGNED_NUMBER(d, negative, v) \ | ||
| 721 | DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_signed_number) | ||
| 722 | #define DO_YEARISH(d, negative, v) \ | ||
| 723 | DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_yearish) | ||
| 724 | #define DO_MAYBE_SIGNED_NUMBER(d, negative, v, label) \ | ||
| 725 | do \ | ||
| 726 | { \ | ||
| 727 | digits = d; \ | ||
| 728 | negative_number = negative; \ | ||
| 729 | u_number_value = v; \ | ||
| 730 | goto label; \ | ||
| 731 | } \ | ||
| 732 | while (0) | ||
| 733 | |||
| 734 | /* The mask is not what you might think. | ||
| 735 | When the ordinal i'th bit is set, insert a colon | ||
| 736 | before the i'th digit of the time zone representation. */ | ||
| 737 | #define DO_TZ_OFFSET(d, mask, v) \ | ||
| 738 | do \ | ||
| 739 | { \ | ||
| 740 | digits = d; \ | ||
| 741 | tz_colon_mask = mask; \ | ||
| 742 | u_number_value = v; \ | ||
| 743 | goto do_tz_offset; \ | ||
| 744 | } \ | ||
| 745 | while (0) | ||
| 746 | #define DO_NUMBER_SPACEPAD(d, v) \ | ||
| 747 | do \ | ||
| 748 | { \ | ||
| 749 | digits = d; \ | ||
| 750 | number_value = v; \ | ||
| 751 | goto do_number_spacepad; \ | ||
| 752 | } \ | ||
| 753 | while (0) | ||
| 754 | |||
| 755 | case L_('%'): | ||
| 756 | if (f - 1 != percent) | ||
| 757 | goto bad_percent; | ||
| 758 | add1 (*f); | ||
| 759 | break; | ||
| 760 | |||
| 761 | case L_('a'): | ||
| 762 | if (modifier != 0) | ||
| 763 | goto bad_format; | ||
| 764 | if (change_case) | ||
| 765 | { | ||
| 766 | to_uppcase = true; | ||
| 767 | to_lowcase = false; | ||
| 768 | } | ||
| 769 | #ifdef _NL_CURRENT | ||
| 770 | cpy (aw_len, a_wkday); | ||
| 771 | break; | ||
| 772 | #else | ||
| 773 | goto underlying_strftime; | ||
| 774 | #endif | ||
| 775 | |||
| 776 | case 'A': | ||
| 777 | if (modifier != 0) | ||
| 778 | goto bad_format; | ||
| 779 | if (change_case) | ||
| 780 | { | ||
| 781 | to_uppcase = true; | ||
| 782 | to_lowcase = false; | ||
| 783 | } | ||
| 784 | #ifdef _NL_CURRENT | ||
| 785 | cpy (STRLEN (f_wkday), f_wkday); | ||
| 786 | break; | ||
| 787 | #else | ||
| 788 | goto underlying_strftime; | ||
| 789 | #endif | ||
| 790 | |||
| 791 | case L_('b'): | ||
| 792 | case L_('h'): | ||
| 793 | if (change_case) | ||
| 794 | { | ||
| 795 | to_uppcase = true; | ||
| 796 | to_lowcase = false; | ||
| 797 | } | ||
| 798 | if (modifier == L_('E')) | ||
| 799 | goto bad_format; | ||
| 800 | #ifdef _NL_CURRENT | ||
| 801 | if (modifier == L_('O')) | ||
| 802 | cpy (aam_len, a_altmonth); | ||
| 803 | else | ||
| 804 | cpy (am_len, a_month); | ||
| 805 | break; | ||
| 806 | #else | ||
| 807 | goto underlying_strftime; | ||
| 808 | #endif | ||
| 809 | |||
| 810 | case L_('B'): | ||
| 811 | if (modifier == L_('E')) | ||
| 812 | goto bad_format; | ||
| 813 | if (change_case) | ||
| 814 | { | ||
| 815 | to_uppcase = true; | ||
| 816 | to_lowcase = false; | ||
| 817 | } | ||
| 818 | #ifdef _NL_CURRENT | ||
| 819 | if (modifier == L_('O')) | ||
| 820 | cpy (STRLEN (f_altmonth), f_altmonth); | ||
| 821 | else | ||
| 822 | cpy (STRLEN (f_month), f_month); | ||
| 823 | break; | ||
| 824 | #else | ||
| 825 | goto underlying_strftime; | ||
| 826 | #endif | ||
| 827 | |||
| 828 | case L_('c'): | ||
| 829 | if (modifier == L_('O')) | ||
| 830 | goto bad_format; | ||
| 831 | #ifdef _NL_CURRENT | ||
| 832 | if (! (modifier == L_('E') | ||
| 833 | && (*(subfmt = | ||
| 834 | (const CHAR_T *) _NL_CURRENT (LC_TIME, | ||
| 835 | NLW(ERA_D_T_FMT))) | ||
| 836 | != '\0'))) | ||
| 837 | subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT)); | ||
| 838 | #else | ||
| 839 | goto underlying_strftime; | ||
| 840 | #endif | ||
| 841 | |||
| 842 | subformat: | ||
| 843 | subwidth = -1; | ||
| 844 | subformat_width: | ||
| 845 | { | ||
| 846 | size_t len = __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1) | ||
| 847 | subfmt, tp, to_uppcase, | ||
| 848 | pad, subwidth, tzset_called | ||
| 849 | extra_args LOCALE_ARG); | ||
| 850 | add (len, __strftime_internal (p, | ||
| 851 | STRFTIME_ARG (maxsize - i) | ||
| 852 | subfmt, tp, to_uppcase, | ||
| 853 | pad, subwidth, tzset_called | ||
| 854 | extra_args LOCALE_ARG)); | ||
| 855 | } | ||
| 856 | break; | ||
| 857 | |||
| 858 | #if !(defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY) | ||
| 859 | underlying_strftime: | ||
| 860 | { | ||
| 861 | /* The relevant information is available only via the | ||
| 862 | underlying strftime implementation, so use that. */ | ||
| 863 | char ufmt[5]; | ||
| 864 | char *u = ufmt; | ||
| 865 | char ubuf[1024]; /* enough for any single format in practice */ | ||
| 866 | size_t len; | ||
| 867 | /* Make sure we're calling the actual underlying strftime. | ||
| 868 | In some cases, config.h contains something like | ||
| 869 | "#define strftime rpl_strftime". */ | ||
| 870 | # ifdef strftime | ||
| 871 | # undef strftime | ||
| 872 | size_t strftime (); | ||
| 873 | # endif | ||
| 874 | |||
| 875 | /* The space helps distinguish strftime failure from empty | ||
| 876 | output. */ | ||
| 877 | *u++ = ' '; | ||
| 878 | *u++ = '%'; | ||
| 879 | if (modifier != 0) | ||
| 880 | *u++ = modifier; | ||
| 881 | *u++ = format_char; | ||
| 882 | *u = '\0'; | ||
| 883 | len = strftime (ubuf, sizeof ubuf, ufmt, tp); | ||
| 884 | if (len != 0) | ||
| 885 | cpy (len - 1, ubuf + 1); | ||
| 886 | } | ||
| 887 | break; | ||
| 888 | #endif | ||
| 889 | |||
| 890 | case L_('C'): | ||
| 891 | if (modifier == L_('E')) | ||
| 892 | { | ||
| 893 | #if HAVE_STRUCT_ERA_ENTRY | ||
| 894 | struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); | ||
| 895 | if (era) | ||
| 896 | { | ||
| 897 | # ifdef COMPILE_WIDE | ||
| 898 | size_t len = __wcslen (era->era_wname); | ||
| 899 | cpy (len, era->era_wname); | ||
| 900 | # else | ||
| 901 | size_t len = strlen (era->era_name); | ||
| 902 | cpy (len, era->era_name); | ||
| 903 | # endif | ||
| 904 | break; | ||
| 905 | } | ||
| 906 | #else | ||
| 907 | goto underlying_strftime; | ||
| 908 | #endif | ||
| 909 | } | ||
| 910 | |||
| 911 | { | ||
| 912 | bool negative_year = tp->tm_year < - TM_YEAR_BASE; | ||
| 913 | bool zero_thru_1899 = !negative_year & (tp->tm_year < 0); | ||
| 914 | int century = ((tp->tm_year - 99 * zero_thru_1899) / 100 | ||
| 915 | + TM_YEAR_BASE / 100); | ||
| 916 | DO_YEARISH (2, negative_year, century); | ||
| 917 | } | ||
| 918 | |||
| 919 | case L_('x'): | ||
| 920 | if (modifier == L_('O')) | ||
| 921 | goto bad_format; | ||
| 922 | #ifdef _NL_CURRENT | ||
| 923 | if (! (modifier == L_('E') | ||
| 924 | && (*(subfmt = | ||
| 925 | (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_D_FMT))) | ||
| 926 | != L_('\0')))) | ||
| 927 | subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT)); | ||
| 928 | goto subformat; | ||
| 929 | #else | ||
| 930 | goto underlying_strftime; | ||
| 931 | #endif | ||
| 932 | case L_('D'): | ||
| 933 | if (modifier != 0) | ||
| 934 | goto bad_format; | ||
| 935 | subfmt = L_("%m/%d/%y"); | ||
| 936 | goto subformat; | ||
| 937 | |||
| 938 | case L_('d'): | ||
| 939 | if (modifier == L_('E')) | ||
| 940 | goto bad_format; | ||
| 941 | |||
| 942 | DO_NUMBER (2, tp->tm_mday); | ||
| 943 | |||
| 944 | case L_('e'): | ||
| 945 | if (modifier == L_('E')) | ||
| 946 | goto bad_format; | ||
| 947 | |||
| 948 | DO_NUMBER_SPACEPAD (2, tp->tm_mday); | ||
| 949 | |||
| 950 | /* All numeric formats set DIGITS and NUMBER_VALUE (or U_NUMBER_VALUE) | ||
| 951 | and then jump to one of these labels. */ | ||
| 952 | |||
| 953 | do_tz_offset: | ||
| 954 | always_output_a_sign = true; | ||
| 955 | goto do_number_body; | ||
| 956 | |||
| 957 | do_yearish: | ||
| 958 | if (pad == 0) | ||
| 959 | pad = yr_spec; | ||
| 960 | always_output_a_sign | ||
| 961 | = (pad == L_('+') | ||
| 962 | && ((digits == 2 ? 99 : 9999) < u_number_value | ||
| 963 | || digits < width)); | ||
| 964 | goto do_maybe_signed_number; | ||
| 965 | |||
| 966 | do_number_spacepad: | ||
| 967 | if (pad == 0) | ||
| 968 | pad = L_('_'); | ||
| 969 | |||
| 970 | do_number: | ||
| 971 | /* Format NUMBER_VALUE according to the MODIFIER flag. */ | ||
| 972 | negative_number = number_value < 0; | ||
| 973 | u_number_value = number_value; | ||
| 974 | |||
| 975 | do_signed_number: | ||
| 976 | always_output_a_sign = false; | ||
| 977 | |||
| 978 | do_maybe_signed_number: | ||
| 979 | tz_colon_mask = 0; | ||
| 980 | |||
| 981 | do_number_body: | ||
| 982 | /* Format U_NUMBER_VALUE according to the MODIFIER flag. | ||
| 983 | NEGATIVE_NUMBER is nonzero if the original number was | ||
| 984 | negative; in this case it was converted directly to | ||
| 985 | unsigned int (i.e., modulo (UINT_MAX + 1)) without | ||
| 986 | negating it. */ | ||
| 987 | if (modifier == L_('O') && !negative_number) | ||
| 988 | { | ||
| 989 | #ifdef _NL_CURRENT | ||
| 990 | /* Get the locale specific alternate representation of | ||
| 991 | the number. If none exist NULL is returned. */ | ||
| 992 | const CHAR_T *cp = nl_get_alt_digit (u_number_value | ||
| 993 | HELPER_LOCALE_ARG); | ||
| 994 | |||
| 995 | if (cp != NULL) | ||
| 996 | { | ||
| 997 | size_t digitlen = STRLEN (cp); | ||
| 998 | if (digitlen != 0) | ||
| 999 | { | ||
| 1000 | cpy (digitlen, cp); | ||
| 1001 | break; | ||
| 1002 | } | ||
| 1003 | } | ||
| 1004 | #else | ||
| 1005 | goto underlying_strftime; | ||
| 1006 | #endif | ||
| 1007 | } | ||
| 1008 | |||
| 1009 | bufp = buf + sizeof (buf) / sizeof (buf[0]); | ||
| 1010 | |||
| 1011 | if (negative_number) | ||
| 1012 | u_number_value = - u_number_value; | ||
| 1013 | |||
| 1014 | do | ||
| 1015 | { | ||
| 1016 | if (tz_colon_mask & 1) | ||
| 1017 | *--bufp = ':'; | ||
| 1018 | tz_colon_mask >>= 1; | ||
| 1019 | *--bufp = u_number_value % 10 + L_('0'); | ||
| 1020 | u_number_value /= 10; | ||
| 1021 | } | ||
| 1022 | while (u_number_value != 0 || tz_colon_mask != 0); | ||
| 1023 | |||
| 1024 | do_number_sign_and_padding: | ||
| 1025 | if (pad == 0) | ||
| 1026 | pad = L_('0'); | ||
| 1027 | if (width < 0) | ||
| 1028 | width = digits; | ||
| 1029 | |||
| 1030 | { | ||
| 1031 | CHAR_T sign_char = (negative_number ? L_('-') | ||
| 1032 | : always_output_a_sign ? L_('+') | ||
| 1033 | : 0); | ||
| 1034 | int numlen = buf + sizeof buf / sizeof buf[0] - bufp; | ||
| 1035 | int shortage = width - !!sign_char - numlen; | ||
| 1036 | int padding = pad == L_('-') || shortage <= 0 ? 0 : shortage; | ||
| 1037 | |||
| 1038 | if (sign_char) | ||
| 1039 | { | ||
| 1040 | if (pad == L_('_')) | ||
| 1041 | { | ||
| 1042 | if (p) | ||
| 1043 | memset_space (p, padding); | ||
| 1044 | i += padding; | ||
| 1045 | width -= padding; | ||
| 1046 | } | ||
| 1047 | width_add1 (0, sign_char); | ||
| 1048 | width--; | ||
| 1049 | } | ||
| 1050 | |||
| 1051 | cpy (numlen, bufp); | ||
| 1052 | } | ||
| 1053 | break; | ||
| 1054 | |||
| 1055 | case L_('F'): | ||
| 1056 | if (modifier != 0) | ||
| 1057 | goto bad_format; | ||
| 1058 | if (pad == 0 && width < 0) | ||
| 1059 | { | ||
| 1060 | pad = L_('+'); | ||
| 1061 | subwidth = 4; | ||
| 1062 | } | ||
| 1063 | else | ||
| 1064 | { | ||
| 1065 | subwidth = width - 6; | ||
| 1066 | if (subwidth < 0) | ||
| 1067 | subwidth = 0; | ||
| 1068 | } | ||
| 1069 | subfmt = L_("%Y-%m-%d"); | ||
| 1070 | goto subformat_width; | ||
| 1071 | |||
| 1072 | case L_('H'): | ||
| 1073 | if (modifier == L_('E')) | ||
| 1074 | goto bad_format; | ||
| 1075 | |||
| 1076 | DO_NUMBER (2, tp->tm_hour); | ||
| 1077 | |||
| 1078 | case L_('I'): | ||
| 1079 | if (modifier == L_('E')) | ||
| 1080 | goto bad_format; | ||
| 1081 | |||
| 1082 | DO_NUMBER (2, hour12); | ||
| 1083 | |||
| 1084 | case L_('k'): /* GNU extension. */ | ||
| 1085 | if (modifier == L_('E')) | ||
| 1086 | goto bad_format; | ||
| 1087 | |||
| 1088 | DO_NUMBER_SPACEPAD (2, tp->tm_hour); | ||
| 1089 | |||
| 1090 | case L_('l'): /* GNU extension. */ | ||
| 1091 | if (modifier == L_('E')) | ||
| 1092 | goto bad_format; | ||
| 1093 | |||
| 1094 | DO_NUMBER_SPACEPAD (2, hour12); | ||
| 1095 | |||
| 1096 | case L_('j'): | ||
| 1097 | if (modifier == L_('E')) | ||
| 1098 | goto bad_format; | ||
| 1099 | |||
| 1100 | DO_SIGNED_NUMBER (3, tp->tm_yday < -1, tp->tm_yday + 1U); | ||
| 1101 | |||
| 1102 | case L_('M'): | ||
| 1103 | if (modifier == L_('E')) | ||
| 1104 | goto bad_format; | ||
| 1105 | |||
| 1106 | DO_NUMBER (2, tp->tm_min); | ||
| 1107 | |||
| 1108 | case L_('m'): | ||
| 1109 | if (modifier == L_('E')) | ||
| 1110 | goto bad_format; | ||
| 1111 | |||
| 1112 | DO_SIGNED_NUMBER (2, tp->tm_mon < -1, tp->tm_mon + 1U); | ||
| 1113 | |||
| 1114 | #ifndef _LIBC | ||
| 1115 | case L_('N'): /* GNU extension. */ | ||
| 1116 | if (modifier == L_('E')) | ||
| 1117 | goto bad_format; | ||
| 1118 | { | ||
| 1119 | int n = ns, ns_digits = 9; | ||
| 1120 | if (width <= 0) | ||
| 1121 | width = ns_digits; | ||
| 1122 | int ndigs = ns_digits; | ||
| 1123 | while (width < ndigs || (1 < ndigs && n % 10 == 0)) | ||
| 1124 | ndigs--, n /= 10; | ||
| 1125 | for (int j = ndigs; 0 < j; j--) | ||
| 1126 | buf[j - 1] = n % 10 + L_('0'), n /= 10; | ||
| 1127 | if (!pad) | ||
| 1128 | pad = L_('0'); | ||
| 1129 | width_cpy (0, ndigs, buf); | ||
| 1130 | width_add (width - ndigs, 0, (void) 0); | ||
| 1131 | } | ||
| 1132 | break; | ||
| 1133 | #endif | ||
| 1134 | |||
| 1135 | case L_('n'): | ||
| 1136 | add1 (L_('\n')); | ||
| 1137 | break; | ||
| 1138 | |||
| 1139 | case L_('P'): | ||
| 1140 | to_lowcase = true; | ||
| 1141 | #ifndef _NL_CURRENT | ||
| 1142 | format_char = L_('p'); | ||
| 1143 | #endif | ||
| 1144 | FALLTHROUGH; | ||
| 1145 | case L_('p'): | ||
| 1146 | if (change_case) | ||
| 1147 | { | ||
| 1148 | to_uppcase = false; | ||
| 1149 | to_lowcase = true; | ||
| 1150 | } | ||
| 1151 | #ifdef _NL_CURRENT | ||
| 1152 | cpy (ap_len, ampm); | ||
| 1153 | break; | ||
| 1154 | #else | ||
| 1155 | goto underlying_strftime; | ||
| 1156 | #endif | ||
| 1157 | |||
| 1158 | case L_('q'): /* GNU extension. */ | ||
| 1159 | DO_SIGNED_NUMBER (1, false, ((tp->tm_mon * 11) >> 5) + 1); | ||
| 1160 | |||
| 1161 | case L_('R'): | ||
| 1162 | subfmt = L_("%H:%M"); | ||
| 1163 | goto subformat; | ||
| 1164 | |||
| 1165 | case L_('r'): | ||
| 1166 | #ifdef _NL_CURRENT | ||
| 1167 | if (*(subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, | ||
| 1168 | NLW(T_FMT_AMPM))) | ||
| 1169 | == L_('\0')) | ||
| 1170 | subfmt = L_("%I:%M:%S %p"); | ||
| 1171 | goto subformat; | ||
| 1172 | #else | ||
| 1173 | goto underlying_strftime; | ||
| 1174 | #endif | ||
| 1175 | |||
| 1176 | case L_('S'): | ||
| 1177 | if (modifier == L_('E')) | ||
| 1178 | goto bad_format; | ||
| 1179 | |||
| 1180 | DO_NUMBER (2, tp->tm_sec); | ||
| 1181 | |||
| 1182 | case L_('s'): /* GNU extension. */ | ||
| 1183 | { | ||
| 1184 | struct tm ltm; | ||
| 1185 | time_t t; | ||
| 1186 | |||
| 1187 | ltm = *tp; | ||
| 1188 | ltm.tm_yday = -1; | ||
| 1189 | t = mktime_z (tz, <m); | ||
| 1190 | if (ltm.tm_yday < 0) | ||
| 1191 | { | ||
| 1192 | errno = EOVERFLOW; | ||
| 1193 | return 0; | ||
| 1194 | } | ||
| 1195 | |||
| 1196 | /* Generate string value for T using time_t arithmetic; | ||
| 1197 | this works even if sizeof (long) < sizeof (time_t). */ | ||
| 1198 | |||
| 1199 | bufp = buf + sizeof (buf) / sizeof (buf[0]); | ||
| 1200 | negative_number = t < 0; | ||
| 1201 | |||
| 1202 | do | ||
| 1203 | { | ||
| 1204 | int d = t % 10; | ||
| 1205 | t /= 10; | ||
| 1206 | *--bufp = (negative_number ? -d : d) + L_('0'); | ||
| 1207 | } | ||
| 1208 | while (t != 0); | ||
| 1209 | |||
| 1210 | digits = 1; | ||
| 1211 | always_output_a_sign = false; | ||
| 1212 | goto do_number_sign_and_padding; | ||
| 1213 | } | ||
| 1214 | |||
| 1215 | case L_('X'): | ||
| 1216 | if (modifier == L_('O')) | ||
| 1217 | goto bad_format; | ||
| 1218 | #ifdef _NL_CURRENT | ||
| 1219 | if (! (modifier == L_('E') | ||
| 1220 | && (*(subfmt = | ||
| 1221 | (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_T_FMT))) | ||
| 1222 | != L_('\0')))) | ||
| 1223 | subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT)); | ||
| 1224 | goto subformat; | ||
| 1225 | #else | ||
| 1226 | goto underlying_strftime; | ||
| 1227 | #endif | ||
| 1228 | case L_('T'): | ||
| 1229 | subfmt = L_("%H:%M:%S"); | ||
| 1230 | goto subformat; | ||
| 1231 | |||
| 1232 | case L_('t'): | ||
| 1233 | add1 (L_('\t')); | ||
| 1234 | break; | ||
| 1235 | |||
| 1236 | case L_('u'): | ||
| 1237 | DO_NUMBER (1, (tp->tm_wday - 1 + 7) % 7 + 1); | ||
| 1238 | |||
| 1239 | case L_('U'): | ||
| 1240 | if (modifier == L_('E')) | ||
| 1241 | goto bad_format; | ||
| 1242 | |||
| 1243 | DO_NUMBER (2, (tp->tm_yday - tp->tm_wday + 7) / 7); | ||
| 1244 | |||
| 1245 | case L_('V'): | ||
| 1246 | case L_('g'): | ||
| 1247 | case L_('G'): | ||
| 1248 | if (modifier == L_('E')) | ||
| 1249 | goto bad_format; | ||
| 1250 | { | ||
| 1251 | /* YEAR is a leap year if and only if (tp->tm_year + TM_YEAR_BASE) | ||
| 1252 | is a leap year, except that YEAR and YEAR - 1 both work | ||
| 1253 | correctly even when (tp->tm_year + TM_YEAR_BASE) would | ||
| 1254 | overflow. */ | ||
| 1255 | int year = (tp->tm_year | ||
| 1256 | + (tp->tm_year < 0 | ||
| 1257 | ? TM_YEAR_BASE % 400 | ||
| 1258 | : TM_YEAR_BASE % 400 - 400)); | ||
| 1259 | int year_adjust = 0; | ||
| 1260 | int days = iso_week_days (tp->tm_yday, tp->tm_wday); | ||
| 1261 | |||
| 1262 | if (days < 0) | ||
| 1263 | { | ||
| 1264 | /* This ISO week belongs to the previous year. */ | ||
| 1265 | year_adjust = -1; | ||
| 1266 | days = iso_week_days (tp->tm_yday + (365 + __isleap (year - 1)), | ||
| 1267 | tp->tm_wday); | ||
| 1268 | } | ||
| 1269 | else | ||
| 1270 | { | ||
| 1271 | int d = iso_week_days (tp->tm_yday - (365 + __isleap (year)), | ||
| 1272 | tp->tm_wday); | ||
| 1273 | if (0 <= d) | ||
| 1274 | { | ||
| 1275 | /* This ISO week belongs to the next year. */ | ||
| 1276 | year_adjust = 1; | ||
| 1277 | days = d; | ||
| 1278 | } | ||
| 1279 | } | ||
| 1280 | |||
| 1281 | switch (*f) | ||
| 1282 | { | ||
| 1283 | case L_('g'): | ||
| 1284 | { | ||
| 1285 | int yy = (tp->tm_year % 100 + year_adjust) % 100; | ||
| 1286 | DO_YEARISH (2, false, | ||
| 1287 | (0 <= yy | ||
| 1288 | ? yy | ||
| 1289 | : tp->tm_year < -TM_YEAR_BASE - year_adjust | ||
| 1290 | ? -yy | ||
| 1291 | : yy + 100)); | ||
| 1292 | } | ||
| 1293 | |||
| 1294 | case L_('G'): | ||
| 1295 | DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE - year_adjust, | ||
| 1296 | (tp->tm_year + (unsigned int) TM_YEAR_BASE | ||
| 1297 | + year_adjust)); | ||
| 1298 | |||
| 1299 | default: | ||
| 1300 | DO_NUMBER (2, days / 7 + 1); | ||
| 1301 | } | ||
| 1302 | } | ||
| 1303 | |||
| 1304 | case L_('W'): | ||
| 1305 | if (modifier == L_('E')) | ||
| 1306 | goto bad_format; | ||
| 1307 | |||
| 1308 | DO_NUMBER (2, (tp->tm_yday - (tp->tm_wday - 1 + 7) % 7 + 7) / 7); | ||
| 1309 | |||
| 1310 | case L_('w'): | ||
| 1311 | if (modifier == L_('E')) | ||
| 1312 | goto bad_format; | ||
| 1313 | |||
| 1314 | DO_NUMBER (1, tp->tm_wday); | ||
| 1315 | |||
| 1316 | case L_('Y'): | ||
| 1317 | if (modifier == L_('E')) | ||
| 1318 | { | ||
| 1319 | #if HAVE_STRUCT_ERA_ENTRY | ||
| 1320 | struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); | ||
| 1321 | if (era) | ||
| 1322 | { | ||
| 1323 | # ifdef COMPILE_WIDE | ||
| 1324 | subfmt = era->era_wformat; | ||
| 1325 | # else | ||
| 1326 | subfmt = era->era_format; | ||
| 1327 | # endif | ||
| 1328 | if (pad == 0) | ||
| 1329 | pad = yr_spec; | ||
| 1330 | goto subformat; | ||
| 1331 | } | ||
| 1332 | #else | ||
| 1333 | goto underlying_strftime; | ||
| 1334 | #endif | ||
| 1335 | } | ||
| 1336 | if (modifier == L_('O')) | ||
| 1337 | goto bad_format; | ||
| 1338 | |||
| 1339 | DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE, | ||
| 1340 | tp->tm_year + (unsigned int) TM_YEAR_BASE); | ||
| 1341 | |||
| 1342 | case L_('y'): | ||
| 1343 | if (modifier == L_('E')) | ||
| 1344 | { | ||
| 1345 | #if HAVE_STRUCT_ERA_ENTRY | ||
| 1346 | struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); | ||
| 1347 | if (era) | ||
| 1348 | { | ||
| 1349 | int delta = tp->tm_year - era->start_date[0]; | ||
| 1350 | if (pad == 0) | ||
| 1351 | pad = yr_spec; | ||
| 1352 | DO_NUMBER (2, (era->offset | ||
| 1353 | + delta * era->absolute_direction)); | ||
| 1354 | } | ||
| 1355 | #else | ||
| 1356 | goto underlying_strftime; | ||
| 1357 | #endif | ||
| 1358 | } | ||
| 1359 | |||
| 1360 | { | ||
| 1361 | int yy = tp->tm_year % 100; | ||
| 1362 | if (yy < 0) | ||
| 1363 | yy = tp->tm_year < - TM_YEAR_BASE ? -yy : yy + 100; | ||
| 1364 | DO_YEARISH (2, false, yy); | ||
| 1365 | } | ||
| 1366 | |||
| 1367 | case L_('Z'): | ||
| 1368 | if (change_case) | ||
| 1369 | { | ||
| 1370 | to_uppcase = false; | ||
| 1371 | to_lowcase = true; | ||
| 1372 | } | ||
| 1373 | |||
| 1374 | #ifdef COMPILE_WIDE | ||
| 1375 | { | ||
| 1376 | /* The zone string is always given in multibyte form. We have | ||
| 1377 | to convert it to wide character. */ | ||
| 1378 | size_t w = pad == L_('-') || width < 0 ? 0 : width; | ||
| 1379 | char const *z = zone; | ||
| 1380 | mbstate_t st = {0}; | ||
| 1381 | size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc); | ||
| 1382 | if (len == (size_t) -1) | ||
| 1383 | return 0; | ||
| 1384 | size_t incr = len < w ? w : len; | ||
| 1385 | if (incr >= maxsize - i) | ||
| 1386 | { | ||
| 1387 | errno = ERANGE; | ||
| 1388 | return 0; | ||
| 1389 | } | ||
| 1390 | if (p) | ||
| 1391 | { | ||
| 1392 | if (len < w) | ||
| 1393 | { | ||
| 1394 | size_t delta = w - len; | ||
| 1395 | __wmemmove (p + delta, p, len); | ||
| 1396 | wchar_t wc = pad == L_('0') || pad == L_('+') ? L'0' : L' '; | ||
| 1397 | wmemset (p, wc, delta); | ||
| 1398 | } | ||
| 1399 | p += incr; | ||
| 1400 | } | ||
| 1401 | i += incr; | ||
| 1402 | } | ||
| 1403 | #else | ||
| 1404 | cpy (strlen (zone), zone); | ||
| 1405 | #endif | ||
| 1406 | break; | ||
| 1407 | |||
| 1408 | case L_(':'): | ||
| 1409 | /* :, ::, and ::: are valid only just before 'z'. | ||
| 1410 | :::: etc. are rejected later. */ | ||
| 1411 | for (colons = 1; f[colons] == L_(':'); colons++) | ||
| 1412 | continue; | ||
| 1413 | if (f[colons] != L_('z')) | ||
| 1414 | goto bad_format; | ||
| 1415 | f += colons; | ||
| 1416 | goto do_z_conversion; | ||
| 1417 | |||
| 1418 | case L_('z'): | ||
| 1419 | colons = 0; | ||
| 1420 | |||
| 1421 | do_z_conversion: | ||
| 1422 | if (tp->tm_isdst < 0) | ||
| 1423 | break; | ||
| 1424 | |||
| 1425 | { | ||
| 1426 | int diff; | ||
| 1427 | int hour_diff; | ||
| 1428 | int min_diff; | ||
| 1429 | int sec_diff; | ||
| 1430 | #if HAVE_TM_GMTOFF | ||
| 1431 | diff = tp->tm_gmtoff; | ||
| 1432 | #else | ||
| 1433 | if (!tz) | ||
| 1434 | diff = 0; | ||
| 1435 | else | ||
| 1436 | { | ||
| 1437 | struct tm gtm; | ||
| 1438 | struct tm ltm; | ||
| 1439 | time_t lt; | ||
| 1440 | |||
| 1441 | /* POSIX.1 requires that local time zone information be used as | ||
| 1442 | though strftime called tzset. */ | ||
| 1443 | # ifndef my_strftime | ||
| 1444 | if (!*tzset_called) | ||
| 1445 | { | ||
| 1446 | tzset (); | ||
| 1447 | *tzset_called = true; | ||
| 1448 | } | ||
| 1449 | # endif | ||
| 1450 | |||
| 1451 | ltm = *tp; | ||
| 1452 | ltm.tm_wday = -1; | ||
| 1453 | lt = mktime_z (tz, <m); | ||
| 1454 | if (ltm.tm_wday < 0 || ! localtime_rz (0, <, >m)) | ||
| 1455 | break; | ||
| 1456 | diff = tm_diff (<m, >m); | ||
| 1457 | } | ||
| 1458 | #endif | ||
| 1459 | |||
| 1460 | negative_number = diff < 0 || (diff == 0 && *zone == '-'); | ||
| 1461 | hour_diff = diff / 60 / 60; | ||
| 1462 | min_diff = diff / 60 % 60; | ||
| 1463 | sec_diff = diff % 60; | ||
| 1464 | |||
| 1465 | switch (colons) | ||
| 1466 | { | ||
| 1467 | case 0: /* +hhmm */ | ||
| 1468 | DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff); | ||
| 1469 | |||
| 1470 | case 1: tz_hh_mm: /* +hh:mm */ | ||
| 1471 | DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff); | ||
| 1472 | |||
| 1473 | case 2: tz_hh_mm_ss: /* +hh:mm:ss */ | ||
| 1474 | DO_TZ_OFFSET (9, 024, | ||
| 1475 | hour_diff * 10000 + min_diff * 100 + sec_diff); | ||
| 1476 | |||
| 1477 | case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ | ||
| 1478 | if (sec_diff != 0) | ||
| 1479 | goto tz_hh_mm_ss; | ||
| 1480 | if (min_diff != 0) | ||
| 1481 | goto tz_hh_mm; | ||
| 1482 | DO_TZ_OFFSET (3, 0, hour_diff); | ||
| 1483 | |||
| 1484 | default: | ||
| 1485 | goto bad_format; | ||
| 1486 | } | ||
| 1487 | } | ||
| 1488 | |||
| 1489 | case L_('\0'): /* GNU extension: % at end of format. */ | ||
| 1490 | bad_percent: | ||
| 1491 | --f; | ||
| 1492 | FALLTHROUGH; | ||
| 1493 | default: | ||
| 1494 | /* Unknown format; output the format, including the '%', | ||
| 1495 | since this is most likely the right thing to do if a | ||
| 1496 | multibyte string has been misparsed. */ | ||
| 1497 | bad_format: | ||
| 1498 | cpy (f - percent + 1, percent); | ||
| 1499 | break; | ||
| 1500 | } | ||
| 1501 | } | ||
| 1502 | |||
| 1503 | #if ! FPRINTFTIME | ||
| 1504 | if (p && maxsize != 0) | ||
| 1505 | *p = L_('\0'); | ||
| 1506 | #endif | ||
| 1507 | |||
| 1508 | errno = saved_errno; | ||
| 1509 | return i; | ||
| 1510 | } | ||
diff --git a/lib/strftime.c b/lib/strftime.c new file mode 100644 index 00000000000..128176cad40 --- /dev/null +++ b/lib/strftime.c | |||
| @@ -0,0 +1,2051 @@ | |||
| 1 | /* Copyright (C) 1991-2024 Free Software Foundation, Inc. | ||
| 2 | This file is part of the GNU C Library. | ||
| 3 | |||
| 4 | This file is free software: you can redistribute it and/or modify | ||
| 5 | it under the terms of the GNU Lesser General Public License as | ||
| 6 | published by the Free Software Foundation, either version 3 of the | ||
| 7 | License, or (at your option) any later version. | ||
| 8 | |||
| 9 | This file is distributed in the hope that it will be useful, | ||
| 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 12 | GNU Lesser General Public License for more details. | ||
| 13 | |||
| 14 | You should have received a copy of the GNU Lesser General Public License | ||
| 15 | along with this program. If not, see <https://www.gnu.org/licenses/>. */ | ||
| 16 | |||
| 17 | #ifndef FPRINTFTIME | ||
| 18 | # define FPRINTFTIME 0 | ||
| 19 | #endif | ||
| 20 | |||
| 21 | #ifndef USE_C_LOCALE | ||
| 22 | # define USE_C_LOCALE 0 | ||
| 23 | #endif | ||
| 24 | |||
| 25 | #ifdef _LIBC | ||
| 26 | # define USE_IN_EXTENDED_LOCALE_MODEL 1 | ||
| 27 | # define HAVE_STRUCT_ERA_ENTRY 1 | ||
| 28 | # define HAVE_TM_GMTOFF 1 | ||
| 29 | # define HAVE_STRUCT_TM_TM_ZONE 1 | ||
| 30 | # define HAVE_TZNAME 1 | ||
| 31 | # include "../locale/localeinfo.h" | ||
| 32 | #else | ||
| 33 | # include <libc-config.h> | ||
| 34 | # if FPRINTFTIME | ||
| 35 | # include "fprintftime.h" | ||
| 36 | # else | ||
| 37 | # include "strftime.h" | ||
| 38 | # endif | ||
| 39 | # include "time-internal.h" | ||
| 40 | #endif | ||
| 41 | |||
| 42 | /* Whether to require GNU behavior for AM and PM indicators, even on | ||
| 43 | other platforms. This matters only in non-C locales. | ||
| 44 | The default is to require it; you can override this via | ||
| 45 | AC_DEFINE([REQUIRE_GNUISH_STRFTIME_AM_PM], 1) and if you do that | ||
| 46 | you may be able to omit Gnulib's localename module and its dependencies. */ | ||
| 47 | #ifndef REQUIRE_GNUISH_STRFTIME_AM_PM | ||
| 48 | # define REQUIRE_GNUISH_STRFTIME_AM_PM true | ||
| 49 | #endif | ||
| 50 | #if USE_C_LOCALE | ||
| 51 | # undef REQUIRE_GNUISH_STRFTIME_AM_PM | ||
| 52 | # define REQUIRE_GNUISH_STRFTIME_AM_PM false | ||
| 53 | #endif | ||
| 54 | |||
| 55 | #if USE_C_LOCALE | ||
| 56 | # include "c-ctype.h" | ||
| 57 | #else | ||
| 58 | # include <ctype.h> | ||
| 59 | #endif | ||
| 60 | #include <errno.h> | ||
| 61 | #include <time.h> | ||
| 62 | |||
| 63 | #if HAVE_TZNAME && !HAVE_DECL_TZNAME | ||
| 64 | extern char *tzname[]; | ||
| 65 | #endif | ||
| 66 | |||
| 67 | /* Do multibyte processing if multibyte encodings are supported, unless | ||
| 68 | multibyte sequences are safe in formats. Multibyte sequences are | ||
| 69 | safe if they cannot contain byte sequences that look like format | ||
| 70 | conversion specifications. The multibyte encodings used by the | ||
| 71 | C library on the various platforms (UTF-8, GB2312, GBK, CP936, | ||
| 72 | GB18030, EUC-TW, BIG5, BIG5-HKSCS, CP950, EUC-JP, EUC-KR, CP949, | ||
| 73 | SHIFT_JIS, CP932, JOHAB) are safe for formats, because the byte '%' | ||
| 74 | cannot occur in a multibyte character except in the first byte. | ||
| 75 | |||
| 76 | The DEC-HANYU encoding used on OSF/1 is not safe for formats, but | ||
| 77 | this encoding has never been seen in real-life use, so we ignore | ||
| 78 | it. */ | ||
| 79 | #if !(defined __osf__ && 0) | ||
| 80 | # define MULTIBYTE_IS_FORMAT_SAFE 1 | ||
| 81 | #endif | ||
| 82 | #define DO_MULTIBYTE (! MULTIBYTE_IS_FORMAT_SAFE) | ||
| 83 | |||
| 84 | #if DO_MULTIBYTE | ||
| 85 | # include <wchar.h> | ||
| 86 | static const mbstate_t mbstate_zero; | ||
| 87 | #endif | ||
| 88 | |||
| 89 | #include <limits.h> | ||
| 90 | #include <stdckdint.h> | ||
| 91 | #include <stddef.h> | ||
| 92 | #include <stdlib.h> | ||
| 93 | #include <string.h> | ||
| 94 | |||
| 95 | #if USE_C_LOCALE && HAVE_STRFTIME_L | ||
| 96 | # include <locale.h> | ||
| 97 | #endif | ||
| 98 | |||
| 99 | #if (defined __NetBSD__ || defined __sun) && REQUIRE_GNUISH_STRFTIME_AM_PM | ||
| 100 | # include <locale.h> | ||
| 101 | # include "localename.h" | ||
| 102 | #endif | ||
| 103 | |||
| 104 | #include "attribute.h" | ||
| 105 | #include <intprops.h> | ||
| 106 | |||
| 107 | #ifdef COMPILE_WIDE | ||
| 108 | # include <endian.h> | ||
| 109 | # define CHAR_T wchar_t | ||
| 110 | # define UCHAR_T unsigned int | ||
| 111 | # define L_(Str) L##Str | ||
| 112 | # define NLW(Sym) _NL_W##Sym | ||
| 113 | |||
| 114 | # define MEMCPY(d, s, n) __wmemcpy (d, s, n) | ||
| 115 | # define STRLEN(s) __wcslen (s) | ||
| 116 | |||
| 117 | #else | ||
| 118 | # define CHAR_T char | ||
| 119 | # define UCHAR_T unsigned char | ||
| 120 | # define L_(Str) Str | ||
| 121 | # define NLW(Sym) Sym | ||
| 122 | # define ABALTMON_1 _NL_ABALTMON_1 | ||
| 123 | |||
| 124 | # define MEMCPY(d, s, n) memcpy (d, s, n) | ||
| 125 | # define STRLEN(s) strlen (s) | ||
| 126 | |||
| 127 | #endif | ||
| 128 | |||
| 129 | /* Shift A right by B bits portably, by dividing A by 2**B and | ||
| 130 | truncating towards minus infinity. A and B should be free of side | ||
| 131 | effects, and B should be in the range 0 <= B <= INT_BITS - 2, where | ||
| 132 | INT_BITS is the number of useful bits in an int. GNU code can | ||
| 133 | assume that INT_BITS is at least 32. | ||
| 134 | |||
| 135 | ISO C99 says that A >> B is implementation-defined if A < 0. Some | ||
| 136 | implementations (e.g., UNICOS 9.0 on a Cray Y-MP EL) don't shift | ||
| 137 | right in the usual way when A < 0, so SHR falls back on division if | ||
| 138 | ordinary A >> B doesn't seem to be the usual signed shift. */ | ||
| 139 | #define SHR(a, b) \ | ||
| 140 | (-1 >> 1 == -1 \ | ||
| 141 | ? (a) >> (b) \ | ||
| 142 | : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0)) | ||
| 143 | |||
| 144 | #define TM_YEAR_BASE 1900 | ||
| 145 | |||
| 146 | #ifndef __isleap | ||
| 147 | /* Nonzero if YEAR is a leap year (every 4 years, | ||
| 148 | except every 100th isn't, and every 400th is). */ | ||
| 149 | # define __isleap(year) \ | ||
| 150 | ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0)) | ||
| 151 | #endif | ||
| 152 | |||
| 153 | |||
| 154 | #ifdef _LIBC | ||
| 155 | # define mktime_z(tz, tm) mktime (tm) | ||
| 156 | # define tzname __tzname | ||
| 157 | # define tzset __tzset | ||
| 158 | |||
| 159 | # define time_t __time64_t | ||
| 160 | # define __gmtime_r(t, tp) __gmtime64_r (t, tp) | ||
| 161 | # define mktime(tp) __mktime64 (tp) | ||
| 162 | #endif | ||
| 163 | |||
| 164 | #if FPRINTFTIME | ||
| 165 | # define STREAM_OR_CHAR_T FILE | ||
| 166 | # define STRFTIME_ARG(x) /* empty */ | ||
| 167 | #else | ||
| 168 | # define STREAM_OR_CHAR_T CHAR_T | ||
| 169 | # define STRFTIME_ARG(x) x, | ||
| 170 | #endif | ||
| 171 | |||
| 172 | #if FPRINTFTIME | ||
| 173 | # define memset_byte(P, Len, Byte) \ | ||
| 174 | do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0) | ||
| 175 | # define memset_space(P, Len) memset_byte (P, Len, ' ') | ||
| 176 | # define memset_zero(P, Len) memset_byte (P, Len, '0') | ||
| 177 | #elif defined COMPILE_WIDE | ||
| 178 | # define memset_space(P, Len) (wmemset (P, L' ', Len), (P) += (Len)) | ||
| 179 | # define memset_zero(P, Len) (wmemset (P, L'0', Len), (P) += (Len)) | ||
| 180 | #else | ||
| 181 | # define memset_space(P, Len) (memset (P, ' ', Len), (P) += (Len)) | ||
| 182 | # define memset_zero(P, Len) (memset (P, '0', Len), (P) += (Len)) | ||
| 183 | #endif | ||
| 184 | |||
| 185 | #if FPRINTFTIME | ||
| 186 | # define advance(P, N) | ||
| 187 | #else | ||
| 188 | # define advance(P, N) ((P) += (N)) | ||
| 189 | #endif | ||
| 190 | |||
| 191 | #define add(n, f) width_add (width, n, f) | ||
| 192 | #define width_add(width, n, f) \ | ||
| 193 | do \ | ||
| 194 | { \ | ||
| 195 | size_t _n = (n); \ | ||
| 196 | size_t _w = pad == L_('-') || width < 0 ? 0 : width; \ | ||
| 197 | size_t _incr = _n < _w ? _w : _n; \ | ||
| 198 | if (_incr >= maxsize - i) \ | ||
| 199 | { \ | ||
| 200 | errno = ERANGE; \ | ||
| 201 | return 0; \ | ||
| 202 | } \ | ||
| 203 | if (p) \ | ||
| 204 | { \ | ||
| 205 | if (_n < _w) \ | ||
| 206 | { \ | ||
| 207 | size_t _delta = _w - _n; \ | ||
| 208 | if (pad == L_('0') || pad == L_('+')) \ | ||
| 209 | memset_zero (p, _delta); \ | ||
| 210 | else \ | ||
| 211 | memset_space (p, _delta); \ | ||
| 212 | } \ | ||
| 213 | f; \ | ||
| 214 | advance (p, _n); \ | ||
| 215 | } \ | ||
| 216 | i += _incr; \ | ||
| 217 | } while (0) | ||
| 218 | |||
| 219 | #define add1(c) width_add1 (width, c) | ||
| 220 | #if FPRINTFTIME | ||
| 221 | # define width_add1(width, c) width_add (width, 1, fputc (c, p)) | ||
| 222 | #else | ||
| 223 | # define width_add1(width, c) width_add (width, 1, *p = c) | ||
| 224 | #endif | ||
| 225 | |||
| 226 | #define cpy(n, s) width_cpy (width, n, s) | ||
| 227 | #if FPRINTFTIME | ||
| 228 | # define width_cpy(width, n, s) \ | ||
| 229 | width_add (width, n, \ | ||
| 230 | do \ | ||
| 231 | { \ | ||
| 232 | if (to_lowcase) \ | ||
| 233 | fwrite_lowcase (p, (s), _n); \ | ||
| 234 | else if (to_uppcase) \ | ||
| 235 | fwrite_uppcase (p, (s), _n); \ | ||
| 236 | else \ | ||
| 237 | { \ | ||
| 238 | /* Ignore the value of fwrite. The caller can determine whether \ | ||
| 239 | an error occurred by inspecting ferror (P). All known fwrite \ | ||
| 240 | implementations set the stream's error indicator when they \ | ||
| 241 | fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \ | ||
| 242 | not require this. */ \ | ||
| 243 | fwrite (s, _n, 1, p); \ | ||
| 244 | } \ | ||
| 245 | } \ | ||
| 246 | while (0) \ | ||
| 247 | ) | ||
| 248 | #else | ||
| 249 | # define width_cpy(width, n, s) \ | ||
| 250 | width_add (width, n, \ | ||
| 251 | if (to_lowcase) \ | ||
| 252 | memcpy_lowcase (p, (s), _n LOCALE_ARG); \ | ||
| 253 | else if (to_uppcase) \ | ||
| 254 | memcpy_uppcase (p, (s), _n LOCALE_ARG); \ | ||
| 255 | else \ | ||
| 256 | MEMCPY ((void *) p, (void const *) (s), _n)) | ||
| 257 | #endif | ||
| 258 | |||
| 259 | #ifdef COMPILE_WIDE | ||
| 260 | # ifndef USE_IN_EXTENDED_LOCALE_MODEL | ||
| 261 | # undef __mbsrtowcs_l | ||
| 262 | # define __mbsrtowcs_l(d, s, l, st, loc) __mbsrtowcs (d, s, l, st) | ||
| 263 | # endif | ||
| 264 | #endif | ||
| 265 | |||
| 266 | |||
| 267 | #if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL | ||
| 268 | /* We use this code also for the extended locale handling where the | ||
| 269 | function gets as an additional argument the locale which has to be | ||
| 270 | used. To access the values we have to redefine the _NL_CURRENT | ||
| 271 | macro. */ | ||
| 272 | # define strftime __strftime_l | ||
| 273 | # define wcsftime __wcsftime_l | ||
| 274 | # undef _NL_CURRENT | ||
| 275 | # define _NL_CURRENT(category, item) \ | ||
| 276 | (current->values[_NL_ITEM_INDEX (item)].string) | ||
| 277 | # define LOCALE_PARAM , locale_t loc | ||
| 278 | # define LOCALE_ARG , loc | ||
| 279 | # define HELPER_LOCALE_ARG , current | ||
| 280 | #else | ||
| 281 | # define LOCALE_PARAM | ||
| 282 | # define LOCALE_ARG | ||
| 283 | # ifdef _LIBC | ||
| 284 | # define HELPER_LOCALE_ARG , _NL_CURRENT_DATA (LC_TIME) | ||
| 285 | # else | ||
| 286 | # define HELPER_LOCALE_ARG | ||
| 287 | # endif | ||
| 288 | #endif | ||
| 289 | |||
| 290 | #ifdef COMPILE_WIDE | ||
| 291 | # ifdef USE_IN_EXTENDED_LOCALE_MODEL | ||
| 292 | # define TOUPPER(Ch, L) __towupper_l (Ch, L) | ||
| 293 | # define TOLOWER(Ch, L) __towlower_l (Ch, L) | ||
| 294 | # else | ||
| 295 | # define TOUPPER(Ch, L) towupper (Ch) | ||
| 296 | # define TOLOWER(Ch, L) towlower (Ch) | ||
| 297 | # endif | ||
| 298 | #else | ||
| 299 | # ifdef USE_IN_EXTENDED_LOCALE_MODEL | ||
| 300 | # define TOUPPER(Ch, L) __toupper_l (Ch, L) | ||
| 301 | # define TOLOWER(Ch, L) __tolower_l (Ch, L) | ||
| 302 | # else | ||
| 303 | # if USE_C_LOCALE | ||
| 304 | # define TOUPPER(Ch, L) c_toupper (Ch) | ||
| 305 | # define TOLOWER(Ch, L) c_tolower (Ch) | ||
| 306 | # else | ||
| 307 | # define TOUPPER(Ch, L) toupper (Ch) | ||
| 308 | # define TOLOWER(Ch, L) tolower (Ch) | ||
| 309 | # endif | ||
| 310 | # endif | ||
| 311 | #endif | ||
| 312 | /* We don't use 'isdigit' here since the locale dependent | ||
| 313 | interpretation is not what we want here. We only need to accept | ||
| 314 | the arabic digits in the ASCII range. One day there is perhaps a | ||
| 315 | more reliable way to accept other sets of digits. */ | ||
| 316 | #define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9) | ||
| 317 | |||
| 318 | /* Avoid false GCC warning "'memset' specified size 18446744073709551615 exceeds | ||
| 319 | maximum object size 9223372036854775807", caused by insufficient data flow | ||
| 320 | analysis and value propagation of the 'width_add' expansion when GCC is not | ||
| 321 | optimizing. Cf. <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88443>. */ | ||
| 322 | #if __GNUC__ >= 7 && !__OPTIMIZE__ | ||
| 323 | # pragma GCC diagnostic ignored "-Wstringop-overflow" | ||
| 324 | #endif | ||
| 325 | |||
| 326 | #if FPRINTFTIME | ||
| 327 | static void | ||
| 328 | fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len) | ||
| 329 | { | ||
| 330 | while (len-- > 0) | ||
| 331 | { | ||
| 332 | fputc (TOLOWER ((UCHAR_T) *src, loc), fp); | ||
| 333 | ++src; | ||
| 334 | } | ||
| 335 | } | ||
| 336 | |||
| 337 | static void | ||
| 338 | fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len) | ||
| 339 | { | ||
| 340 | while (len-- > 0) | ||
| 341 | { | ||
| 342 | fputc (TOUPPER ((UCHAR_T) *src, loc), fp); | ||
| 343 | ++src; | ||
| 344 | } | ||
| 345 | } | ||
| 346 | #else | ||
| 347 | static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, | ||
| 348 | size_t len LOCALE_PARAM); | ||
| 349 | |||
| 350 | static CHAR_T * | ||
| 351 | memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) | ||
| 352 | { | ||
| 353 | while (len-- > 0) | ||
| 354 | dest[len] = TOLOWER ((UCHAR_T) src[len], loc); | ||
| 355 | return dest; | ||
| 356 | } | ||
| 357 | |||
| 358 | static CHAR_T *memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, | ||
| 359 | size_t len LOCALE_PARAM); | ||
| 360 | |||
| 361 | static CHAR_T * | ||
| 362 | memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) | ||
| 363 | { | ||
| 364 | while (len-- > 0) | ||
| 365 | dest[len] = TOUPPER ((UCHAR_T) src[len], loc); | ||
| 366 | return dest; | ||
| 367 | } | ||
| 368 | #endif | ||
| 369 | |||
| 370 | |||
| 371 | #if USE_C_LOCALE && HAVE_STRFTIME_L | ||
| 372 | |||
| 373 | /* Cache for the C locale object. | ||
| 374 | Marked volatile so that different threads see the same value | ||
| 375 | (avoids locking). */ | ||
| 376 | static volatile locale_t c_locale_cache; | ||
| 377 | |||
| 378 | /* Return the C locale object, or (locale_t) 0 with errno set | ||
| 379 | if it cannot be created. */ | ||
| 380 | static locale_t | ||
| 381 | c_locale (void) | ||
| 382 | { | ||
| 383 | if (!c_locale_cache) | ||
| 384 | c_locale_cache = newlocale (LC_ALL_MASK, "C", (locale_t) 0); | ||
| 385 | return c_locale_cache; | ||
| 386 | } | ||
| 387 | |||
| 388 | #endif | ||
| 389 | |||
| 390 | |||
| 391 | #if (defined __NetBSD__ || defined __sun) && REQUIRE_GNUISH_STRFTIME_AM_PM | ||
| 392 | |||
| 393 | /* Return true if an AM/PM indicator should be removed. */ | ||
| 394 | static bool | ||
| 395 | should_remove_ampm (void) | ||
| 396 | { | ||
| 397 | /* According to glibc's 'am_pm' attribute in the locale database, an AM/PM | ||
| 398 | indicator should be absent in the locales for the following languages: | ||
| 399 | ab an ast az be ber bg br bs ce cs csb cv da de dsb eo et eu fa fi fo fr | ||
| 400 | fur fy ga gl gv hr hsb ht hu hy it ka kk kl ku kv kw ky lb lg li lij ln | ||
| 401 | lt lv mg mhr mi mk mn ms mt nb nds nhn nl nn nr nso oc os pap pl pt ro | ||
| 402 | ru rw sah sc se sgs sk sl sm sr ss st su sv szl tg tk tn ts tt ug uk unm | ||
| 403 | uz ve wae wo xh zu */ | ||
| 404 | const char *loc = gl_locale_name_unsafe (LC_TIME, "LC_TIME"); | ||
| 405 | bool remove_ampm = false; | ||
| 406 | switch (loc[0]) | ||
| 407 | { | ||
| 408 | case 'a': | ||
| 409 | switch (loc[1]) | ||
| 410 | { | ||
| 411 | case 'b': case 'n': case 'z': | ||
| 412 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 413 | remove_ampm = true; | ||
| 414 | break; | ||
| 415 | case 's': | ||
| 416 | if (loc[2] == 't' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 417 | remove_ampm = true; | ||
| 418 | break; | ||
| 419 | default: | ||
| 420 | break; | ||
| 421 | } | ||
| 422 | break; | ||
| 423 | case 'b': | ||
| 424 | switch (loc[1]) | ||
| 425 | { | ||
| 426 | case 'e': | ||
| 427 | if (loc[2] == '\0' || loc[2] == '_' | ||
| 428 | || (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_'))) | ||
| 429 | remove_ampm = true; | ||
| 430 | break; | ||
| 431 | case 'g': case 'r': case 's': | ||
| 432 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 433 | remove_ampm = true; | ||
| 434 | break; | ||
| 435 | default: | ||
| 436 | break; | ||
| 437 | } | ||
| 438 | break; | ||
| 439 | case 'c': | ||
| 440 | switch (loc[1]) | ||
| 441 | { | ||
| 442 | case 'e': case 'v': | ||
| 443 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 444 | remove_ampm = true; | ||
| 445 | break; | ||
| 446 | case 's': | ||
| 447 | if (loc[2] == '\0' || loc[2] == '_' | ||
| 448 | || (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_'))) | ||
| 449 | remove_ampm = true; | ||
| 450 | break; | ||
| 451 | default: | ||
| 452 | break; | ||
| 453 | } | ||
| 454 | break; | ||
| 455 | case 'd': | ||
| 456 | switch (loc[1]) | ||
| 457 | { | ||
| 458 | case 'a': case 'e': | ||
| 459 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 460 | remove_ampm = true; | ||
| 461 | break; | ||
| 462 | case 's': | ||
| 463 | if (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 464 | remove_ampm = true; | ||
| 465 | break; | ||
| 466 | default: | ||
| 467 | break; | ||
| 468 | } | ||
| 469 | break; | ||
| 470 | case 'e': | ||
| 471 | switch (loc[1]) | ||
| 472 | { | ||
| 473 | case 'o': case 't': case 'u': | ||
| 474 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 475 | remove_ampm = true; | ||
| 476 | break; | ||
| 477 | default: | ||
| 478 | break; | ||
| 479 | } | ||
| 480 | break; | ||
| 481 | case 'f': | ||
| 482 | switch (loc[1]) | ||
| 483 | { | ||
| 484 | case 'a': case 'i': case 'o': case 'r': case 'y': | ||
| 485 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 486 | remove_ampm = true; | ||
| 487 | break; | ||
| 488 | case 'u': | ||
| 489 | if (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 490 | remove_ampm = true; | ||
| 491 | break; | ||
| 492 | default: | ||
| 493 | break; | ||
| 494 | } | ||
| 495 | break; | ||
| 496 | case 'g': | ||
| 497 | switch (loc[1]) | ||
| 498 | { | ||
| 499 | case 'a': case 'l': case 'v': | ||
| 500 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 501 | remove_ampm = true; | ||
| 502 | break; | ||
| 503 | default: | ||
| 504 | break; | ||
| 505 | } | ||
| 506 | break; | ||
| 507 | case 'h': | ||
| 508 | switch (loc[1]) | ||
| 509 | { | ||
| 510 | case 'r': case 't': case 'u': case 'y': | ||
| 511 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 512 | remove_ampm = true; | ||
| 513 | break; | ||
| 514 | case 's': | ||
| 515 | if (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 516 | remove_ampm = true; | ||
| 517 | break; | ||
| 518 | default: | ||
| 519 | break; | ||
| 520 | } | ||
| 521 | break; | ||
| 522 | case 'i': | ||
| 523 | switch (loc[1]) | ||
| 524 | { | ||
| 525 | case 't': | ||
| 526 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 527 | remove_ampm = true; | ||
| 528 | break; | ||
| 529 | default: | ||
| 530 | break; | ||
| 531 | } | ||
| 532 | break; | ||
| 533 | case 'k': | ||
| 534 | switch (loc[1]) | ||
| 535 | { | ||
| 536 | case 'a': case 'k': case 'l': case 'u': case 'v': case 'w': case 'y': | ||
| 537 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 538 | remove_ampm = true; | ||
| 539 | break; | ||
| 540 | default: | ||
| 541 | break; | ||
| 542 | } | ||
| 543 | break; | ||
| 544 | case 'l': | ||
| 545 | switch (loc[1]) | ||
| 546 | { | ||
| 547 | case 'b': case 'g': case 'n': case 't': case 'v': | ||
| 548 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 549 | remove_ampm = true; | ||
| 550 | break; | ||
| 551 | case 'i': | ||
| 552 | if (loc[2] == 'j' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 553 | remove_ampm = true; | ||
| 554 | break; | ||
| 555 | default: | ||
| 556 | break; | ||
| 557 | } | ||
| 558 | break; | ||
| 559 | case 'm': | ||
| 560 | switch (loc[1]) | ||
| 561 | { | ||
| 562 | case 'g': case 'i': case 'k': case 'n': case 's': case 't': | ||
| 563 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 564 | remove_ampm = true; | ||
| 565 | break; | ||
| 566 | case 'h': | ||
| 567 | if (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 568 | remove_ampm = true; | ||
| 569 | break; | ||
| 570 | default: | ||
| 571 | break; | ||
| 572 | } | ||
| 573 | break; | ||
| 574 | case 'n': | ||
| 575 | switch (loc[1]) | ||
| 576 | { | ||
| 577 | case 'b': case 'l': case 'n': case 'r': | ||
| 578 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 579 | remove_ampm = true; | ||
| 580 | break; | ||
| 581 | case 'd': | ||
| 582 | if (loc[2] == 's' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 583 | remove_ampm = true; | ||
| 584 | break; | ||
| 585 | case 'h': | ||
| 586 | if (loc[2] == 'n' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 587 | remove_ampm = true; | ||
| 588 | break; | ||
| 589 | case 's': | ||
| 590 | if (loc[2] == 'o' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 591 | remove_ampm = true; | ||
| 592 | break; | ||
| 593 | default: | ||
| 594 | break; | ||
| 595 | } | ||
| 596 | break; | ||
| 597 | case 'o': | ||
| 598 | switch (loc[1]) | ||
| 599 | { | ||
| 600 | case 'c': case 's': | ||
| 601 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 602 | remove_ampm = true; | ||
| 603 | break; | ||
| 604 | default: | ||
| 605 | break; | ||
| 606 | } | ||
| 607 | break; | ||
| 608 | case 'p': | ||
| 609 | switch (loc[1]) | ||
| 610 | { | ||
| 611 | case 'l': case 't': | ||
| 612 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 613 | remove_ampm = true; | ||
| 614 | break; | ||
| 615 | case 'a': | ||
| 616 | if (loc[2] == 'p' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 617 | remove_ampm = true; | ||
| 618 | break; | ||
| 619 | default: | ||
| 620 | break; | ||
| 621 | } | ||
| 622 | break; | ||
| 623 | case 'r': | ||
| 624 | switch (loc[1]) | ||
| 625 | { | ||
| 626 | case 'o': case 'u': case 'w': | ||
| 627 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 628 | remove_ampm = true; | ||
| 629 | break; | ||
| 630 | default: | ||
| 631 | break; | ||
| 632 | } | ||
| 633 | break; | ||
| 634 | case 's': | ||
| 635 | switch (loc[1]) | ||
| 636 | { | ||
| 637 | case 'c': case 'e': case 'k': case 'l': case 'm': case 'r': case 's': | ||
| 638 | case 't': case 'u': case 'v': | ||
| 639 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 640 | remove_ampm = true; | ||
| 641 | break; | ||
| 642 | case 'a': | ||
| 643 | if (loc[2] == 'h' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 644 | remove_ampm = true; | ||
| 645 | break; | ||
| 646 | case 'g': | ||
| 647 | if (loc[2] == 's' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 648 | remove_ampm = true; | ||
| 649 | break; | ||
| 650 | case 'z': | ||
| 651 | if (loc[2] == 'l' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 652 | remove_ampm = true; | ||
| 653 | break; | ||
| 654 | default: | ||
| 655 | break; | ||
| 656 | } | ||
| 657 | break; | ||
| 658 | case 't': | ||
| 659 | switch (loc[1]) | ||
| 660 | { | ||
| 661 | case 'g': case 'k': case 'n': case 's': case 't': | ||
| 662 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 663 | remove_ampm = true; | ||
| 664 | break; | ||
| 665 | default: | ||
| 666 | break; | ||
| 667 | } | ||
| 668 | break; | ||
| 669 | case 'u': | ||
| 670 | switch (loc[1]) | ||
| 671 | { | ||
| 672 | case 'g': case 'k': case 'z': | ||
| 673 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 674 | remove_ampm = true; | ||
| 675 | break; | ||
| 676 | case 'n': | ||
| 677 | if (loc[2] == 'm'&& (loc[3] == '\0' || loc[3] == '_')) | ||
| 678 | remove_ampm = true; | ||
| 679 | break; | ||
| 680 | default: | ||
| 681 | break; | ||
| 682 | } | ||
| 683 | break; | ||
| 684 | case 'v': | ||
| 685 | switch (loc[1]) | ||
| 686 | { | ||
| 687 | case 'e': | ||
| 688 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 689 | remove_ampm = true; | ||
| 690 | break; | ||
| 691 | default: | ||
| 692 | break; | ||
| 693 | } | ||
| 694 | break; | ||
| 695 | case 'w': | ||
| 696 | switch (loc[1]) | ||
| 697 | { | ||
| 698 | case 'a': | ||
| 699 | if (loc[2] == 'e' && (loc[3] == '\0' || loc[3] == '_')) | ||
| 700 | remove_ampm = true; | ||
| 701 | break; | ||
| 702 | case 'o': | ||
| 703 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 704 | remove_ampm = true; | ||
| 705 | break; | ||
| 706 | default: | ||
| 707 | break; | ||
| 708 | } | ||
| 709 | break; | ||
| 710 | case 'x': | ||
| 711 | switch (loc[1]) | ||
| 712 | { | ||
| 713 | case 'h': | ||
| 714 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 715 | remove_ampm = true; | ||
| 716 | break; | ||
| 717 | default: | ||
| 718 | break; | ||
| 719 | } | ||
| 720 | break; | ||
| 721 | case 'z': | ||
| 722 | switch (loc[1]) | ||
| 723 | { | ||
| 724 | case 'u': | ||
| 725 | if (loc[2] == '\0' || loc[2] == '_') | ||
| 726 | remove_ampm = true; | ||
| 727 | break; | ||
| 728 | default: | ||
| 729 | break; | ||
| 730 | } | ||
| 731 | break; | ||
| 732 | default: | ||
| 733 | break; | ||
| 734 | } | ||
| 735 | return remove_ampm; | ||
| 736 | } | ||
| 737 | |||
| 738 | #endif | ||
| 739 | |||
| 740 | |||
| 741 | #if ! HAVE_TM_GMTOFF | ||
| 742 | /* Yield the difference between *A and *B, | ||
| 743 | measured in seconds, ignoring leap seconds. */ | ||
| 744 | # define tm_diff ftime_tm_diff | ||
| 745 | static int tm_diff (const struct tm *, const struct tm *); | ||
| 746 | static int | ||
| 747 | tm_diff (const struct tm *a, const struct tm *b) | ||
| 748 | { | ||
| 749 | /* Compute intervening leap days correctly even if year is negative. | ||
| 750 | Take care to avoid int overflow in leap day calculations, | ||
| 751 | but it's OK to assume that A and B are close to each other. */ | ||
| 752 | int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3); | ||
| 753 | int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3); | ||
| 754 | int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0); | ||
| 755 | int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0); | ||
| 756 | int a400 = SHR (a100, 2); | ||
| 757 | int b400 = SHR (b100, 2); | ||
| 758 | int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); | ||
| 759 | int years = a->tm_year - b->tm_year; | ||
| 760 | int days = (365 * years + intervening_leap_days | ||
| 761 | + (a->tm_yday - b->tm_yday)); | ||
| 762 | return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) | ||
| 763 | + (a->tm_min - b->tm_min)) | ||
| 764 | + (a->tm_sec - b->tm_sec)); | ||
| 765 | } | ||
| 766 | #endif /* ! HAVE_TM_GMTOFF */ | ||
| 767 | |||
| 768 | |||
| 769 | |||
| 770 | /* The number of days from the first day of the first ISO week of this | ||
| 771 | year to the year day YDAY with week day WDAY. ISO weeks start on | ||
| 772 | Monday; the first ISO week has the year's first Thursday. YDAY may | ||
| 773 | be as small as YDAY_MINIMUM. */ | ||
| 774 | #define ISO_WEEK_START_WDAY 1 /* Monday */ | ||
| 775 | #define ISO_WEEK1_WDAY 4 /* Thursday */ | ||
| 776 | #define YDAY_MINIMUM (-366) | ||
| 777 | static int iso_week_days (int, int); | ||
| 778 | static __inline int | ||
| 779 | iso_week_days (int yday, int wday) | ||
| 780 | { | ||
| 781 | /* Add enough to the first operand of % to make it nonnegative. */ | ||
| 782 | int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7; | ||
| 783 | return (yday | ||
| 784 | - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7 | ||
| 785 | + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY); | ||
| 786 | } | ||
| 787 | |||
| 788 | |||
| 789 | #if !defined _NL_CURRENT && (USE_C_LOCALE && !HAVE_STRFTIME_L) | ||
| 790 | static CHAR_T const c_weekday_names[][sizeof "Wednesday"] = | ||
| 791 | { | ||
| 792 | L_("Sunday"), L_("Monday"), L_("Tuesday"), L_("Wednesday"), | ||
| 793 | L_("Thursday"), L_("Friday"), L_("Saturday") | ||
| 794 | }; | ||
| 795 | static CHAR_T const c_month_names[][sizeof "September"] = | ||
| 796 | { | ||
| 797 | L_("January"), L_("February"), L_("March"), L_("April"), L_("May"), | ||
| 798 | L_("June"), L_("July"), L_("August"), L_("September"), L_("October"), | ||
| 799 | L_("November"), L_("December") | ||
| 800 | }; | ||
| 801 | #endif | ||
| 802 | |||
| 803 | |||
| 804 | /* When compiling this file, GNU applications can #define my_strftime | ||
| 805 | to a symbol (typically nstrftime) to get an extended strftime with | ||
| 806 | extra arguments TZ and NS. */ | ||
| 807 | |||
| 808 | #ifdef my_strftime | ||
| 809 | # define extra_args , tz, ns | ||
| 810 | # define extra_args_spec , timezone_t tz, int ns | ||
| 811 | #else | ||
| 812 | # if defined COMPILE_WIDE | ||
| 813 | # define my_strftime wcsftime | ||
| 814 | # define nl_get_alt_digit _nl_get_walt_digit | ||
| 815 | # else | ||
| 816 | # define my_strftime strftime | ||
| 817 | # define nl_get_alt_digit _nl_get_alt_digit | ||
| 818 | # endif | ||
| 819 | # define extra_args | ||
| 820 | # define extra_args_spec | ||
| 821 | /* We don't have this information in general. */ | ||
| 822 | # define tz 1 | ||
| 823 | # define ns 0 | ||
| 824 | #endif | ||
| 825 | |||
| 826 | static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t) | ||
| 827 | const CHAR_T *, const struct tm *, | ||
| 828 | bool, int, int, bool * | ||
| 829 | extra_args_spec LOCALE_PARAM); | ||
| 830 | |||
| 831 | /* Write information from TP into S according to the format | ||
| 832 | string FORMAT, writing no more that MAXSIZE characters | ||
| 833 | (including the terminating '\0') and returning number of | ||
| 834 | characters written. If S is NULL, nothing will be written | ||
| 835 | anywhere, so to determine how many characters would be | ||
| 836 | written, use NULL for S and (size_t) -1 for MAXSIZE. */ | ||
| 837 | size_t | ||
| 838 | my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) | ||
| 839 | const CHAR_T *format, | ||
| 840 | const struct tm *tp extra_args_spec LOCALE_PARAM) | ||
| 841 | { | ||
| 842 | bool tzset_called = false; | ||
| 843 | return __strftime_internal (s, STRFTIME_ARG (maxsize) format, tp, false, | ||
| 844 | 0, -1, &tzset_called extra_args LOCALE_ARG); | ||
| 845 | } | ||
| 846 | libc_hidden_def (my_strftime) | ||
| 847 | |||
| 848 | /* Just like my_strftime, above, but with more parameters. | ||
| 849 | UPCASE indicates that the result should be converted to upper case. | ||
| 850 | YR_SPEC and WIDTH specify the padding and width for the year. | ||
| 851 | *TZSET_CALLED indicates whether tzset has been called here. */ | ||
| 852 | static size_t | ||
| 853 | __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) | ||
| 854 | const CHAR_T *format, | ||
| 855 | const struct tm *tp, bool upcase, | ||
| 856 | int yr_spec, int width, bool *tzset_called | ||
| 857 | extra_args_spec LOCALE_PARAM) | ||
| 858 | { | ||
| 859 | #if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL | ||
| 860 | struct __locale_data *const current = loc->__locales[LC_TIME]; | ||
| 861 | #endif | ||
| 862 | #if FPRINTFTIME | ||
| 863 | size_t maxsize = (size_t) -1; | ||
| 864 | #endif | ||
| 865 | |||
| 866 | int saved_errno = errno; | ||
| 867 | int hour12 = tp->tm_hour; | ||
| 868 | #ifdef _NL_CURRENT | ||
| 869 | /* We cannot make the following values variables since we must delay | ||
| 870 | the evaluation of these values until really needed since some | ||
| 871 | expressions might not be valid in every situation. The 'struct tm' | ||
| 872 | might be generated by a strptime() call that initialized | ||
| 873 | only a few elements. Dereference the pointers only if the format | ||
| 874 | requires this. Then it is ok to fail if the pointers are invalid. */ | ||
| 875 | # define a_wkday \ | ||
| 876 | ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ | ||
| 877 | ? "?" : _NL_CURRENT (LC_TIME, NLW(ABDAY_1) + tp->tm_wday))) | ||
| 878 | # define f_wkday \ | ||
| 879 | ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ | ||
| 880 | ? "?" : _NL_CURRENT (LC_TIME, NLW(DAY_1) + tp->tm_wday))) | ||
| 881 | # define a_month \ | ||
| 882 | ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ | ||
| 883 | ? "?" : _NL_CURRENT (LC_TIME, NLW(ABMON_1) + tp->tm_mon))) | ||
| 884 | # define f_month \ | ||
| 885 | ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ | ||
| 886 | ? "?" : _NL_CURRENT (LC_TIME, NLW(MON_1) + tp->tm_mon))) | ||
| 887 | # define a_altmonth \ | ||
| 888 | ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ | ||
| 889 | ? "?" : _NL_CURRENT (LC_TIME, NLW(ABALTMON_1) + tp->tm_mon))) | ||
| 890 | # define f_altmonth \ | ||
| 891 | ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ | ||
| 892 | ? "?" : _NL_CURRENT (LC_TIME, NLW(ALTMON_1) + tp->tm_mon))) | ||
| 893 | # define ampm \ | ||
| 894 | ((const CHAR_T *) _NL_CURRENT (LC_TIME, tp->tm_hour > 11 \ | ||
| 895 | ? NLW(PM_STR) : NLW(AM_STR))) | ||
| 896 | |||
| 897 | # define aw_len STRLEN (a_wkday) | ||
| 898 | # define am_len STRLEN (a_month) | ||
| 899 | # define aam_len STRLEN (a_altmonth) | ||
| 900 | # define ap_len STRLEN (ampm) | ||
| 901 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 902 | /* The English abbreviated weekday names are just the first 3 characters of the | ||
| 903 | English full weekday names. */ | ||
| 904 | # define a_wkday \ | ||
| 905 | (tp->tm_wday < 0 || tp->tm_wday > 6 ? L_("?") : c_weekday_names[tp->tm_wday]) | ||
| 906 | # define aw_len 3 | ||
| 907 | # define f_wkday \ | ||
| 908 | (tp->tm_wday < 0 || tp->tm_wday > 6 ? L_("?") : c_weekday_names[tp->tm_wday]) | ||
| 909 | /* The English abbreviated month names are just the first 3 characters of the | ||
| 910 | English full month names. */ | ||
| 911 | # define a_month \ | ||
| 912 | (tp->tm_mon < 0 || tp->tm_mon > 11 ? L_("?") : c_month_names[tp->tm_mon]) | ||
| 913 | # define am_len 3 | ||
| 914 | # define f_month \ | ||
| 915 | (tp->tm_mon < 0 || tp->tm_mon > 11 ? L_("?") : c_month_names[tp->tm_mon]) | ||
| 916 | /* The English AM/PM strings happen to have the same length, namely 2. */ | ||
| 917 | # define ampm (L_("AMPM") + 2 * (tp->tm_hour > 11)) | ||
| 918 | # define ap_len 2 | ||
| 919 | #endif | ||
| 920 | #if HAVE_TZNAME | ||
| 921 | char **tzname_vec = tzname; | ||
| 922 | #endif | ||
| 923 | const char *zone; | ||
| 924 | size_t i = 0; | ||
| 925 | STREAM_OR_CHAR_T *p = s; | ||
| 926 | const CHAR_T *f; | ||
| 927 | #if DO_MULTIBYTE && !defined COMPILE_WIDE | ||
| 928 | const char *format_end = NULL; | ||
| 929 | #endif | ||
| 930 | |||
| 931 | zone = NULL; | ||
| 932 | #if HAVE_STRUCT_TM_TM_ZONE | ||
| 933 | /* The POSIX test suite assumes that setting | ||
| 934 | the environment variable TZ to a new value before calling strftime() | ||
| 935 | will influence the result (the %Z format) even if the information in | ||
| 936 | TP is computed with a totally different time zone. | ||
| 937 | This is bogus: though POSIX allows bad behavior like this, | ||
| 938 | POSIX does not require it. Do the right thing instead. */ | ||
| 939 | zone = (const char *) tp->tm_zone; | ||
| 940 | #endif | ||
| 941 | #if HAVE_TZNAME | ||
| 942 | if (!tz) | ||
| 943 | { | ||
| 944 | if (! (zone && *zone)) | ||
| 945 | zone = "GMT"; | ||
| 946 | } | ||
| 947 | else | ||
| 948 | { | ||
| 949 | # if !HAVE_STRUCT_TM_TM_ZONE | ||
| 950 | /* Infer the zone name from *TZ instead of from TZNAME. */ | ||
| 951 | tzname_vec = tz->tzname_copy; | ||
| 952 | # endif | ||
| 953 | } | ||
| 954 | /* The tzset() call might have changed the value. */ | ||
| 955 | if (!(zone && *zone) && tp->tm_isdst >= 0) | ||
| 956 | { | ||
| 957 | /* POSIX.1 requires that local time zone information be used as | ||
| 958 | though strftime called tzset. */ | ||
| 959 | # ifndef my_strftime | ||
| 960 | if (!*tzset_called) | ||
| 961 | { | ||
| 962 | tzset (); | ||
| 963 | *tzset_called = true; | ||
| 964 | } | ||
| 965 | # endif | ||
| 966 | zone = tzname_vec[tp->tm_isdst != 0]; | ||
| 967 | } | ||
| 968 | #endif | ||
| 969 | if (! zone) | ||
| 970 | zone = ""; | ||
| 971 | |||
| 972 | if (hour12 > 12) | ||
| 973 | hour12 -= 12; | ||
| 974 | else | ||
| 975 | if (hour12 == 0) | ||
| 976 | hour12 = 12; | ||
| 977 | |||
| 978 | for (f = format; *f != '\0'; width = -1, f++) | ||
| 979 | { | ||
| 980 | int pad = 0; /* Padding for number ('_', '-', '+', '0', or 0). */ | ||
| 981 | int modifier; /* Field modifier ('E', 'O', or 0). */ | ||
| 982 | int digits = 0; /* Max digits for numeric format. */ | ||
| 983 | int number_value; /* Numeric value to be printed. */ | ||
| 984 | unsigned int u_number_value; /* (unsigned int) number_value. */ | ||
| 985 | bool negative_number; /* The number is negative. */ | ||
| 986 | bool always_output_a_sign; /* +/- should always be output. */ | ||
| 987 | int tz_colon_mask; /* Bitmask of where ':' should appear. */ | ||
| 988 | const CHAR_T *subfmt; | ||
| 989 | CHAR_T *bufp; | ||
| 990 | CHAR_T buf[1 | ||
| 991 | + 2 /* for the two colons in a %::z or %:::z time zone */ | ||
| 992 | + (sizeof (int) < sizeof (time_t) | ||
| 993 | ? INT_STRLEN_BOUND (time_t) | ||
| 994 | : INT_STRLEN_BOUND (int))]; | ||
| 995 | bool to_lowcase = false; | ||
| 996 | bool to_uppcase = upcase; | ||
| 997 | size_t colons; | ||
| 998 | bool change_case = false; | ||
| 999 | int format_char; | ||
| 1000 | int subwidth; | ||
| 1001 | |||
| 1002 | #if DO_MULTIBYTE && !defined COMPILE_WIDE | ||
| 1003 | switch (*f) | ||
| 1004 | { | ||
| 1005 | case L_('%'): | ||
| 1006 | break; | ||
| 1007 | |||
| 1008 | case L_('\b'): case L_('\t'): case L_('\n'): | ||
| 1009 | case L_('\v'): case L_('\f'): case L_('\r'): | ||
| 1010 | case L_(' '): case L_('!'): case L_('"'): case L_('#'): case L_('&'): | ||
| 1011 | case L_('\''): case L_('('): case L_(')'): case L_('*'): case L_('+'): | ||
| 1012 | case L_(','): case L_('-'): case L_('.'): case L_('/'): case L_('0'): | ||
| 1013 | case L_('1'): case L_('2'): case L_('3'): case L_('4'): case L_('5'): | ||
| 1014 | case L_('6'): case L_('7'): case L_('8'): case L_('9'): case L_(':'): | ||
| 1015 | case L_(';'): case L_('<'): case L_('='): case L_('>'): case L_('?'): | ||
| 1016 | case L_('A'): case L_('B'): case L_('C'): case L_('D'): case L_('E'): | ||
| 1017 | case L_('F'): case L_('G'): case L_('H'): case L_('I'): case L_('J'): | ||
| 1018 | case L_('K'): case L_('L'): case L_('M'): case L_('N'): case L_('O'): | ||
| 1019 | case L_('P'): case L_('Q'): case L_('R'): case L_('S'): case L_('T'): | ||
| 1020 | case L_('U'): case L_('V'): case L_('W'): case L_('X'): case L_('Y'): | ||
| 1021 | case L_('Z'): case L_('['): case L_('\\'): case L_(']'): case L_('^'): | ||
| 1022 | case L_('_'): case L_('a'): case L_('b'): case L_('c'): case L_('d'): | ||
| 1023 | case L_('e'): case L_('f'): case L_('g'): case L_('h'): case L_('i'): | ||
| 1024 | case L_('j'): case L_('k'): case L_('l'): case L_('m'): case L_('n'): | ||
| 1025 | case L_('o'): case L_('p'): case L_('q'): case L_('r'): case L_('s'): | ||
| 1026 | case L_('t'): case L_('u'): case L_('v'): case L_('w'): case L_('x'): | ||
| 1027 | case L_('y'): case L_('z'): case L_('{'): case L_('|'): case L_('}'): | ||
| 1028 | case L_('~'): | ||
| 1029 | /* The C Standard requires these 98 characters (plus '%') to | ||
| 1030 | be in the basic execution character set. None of these | ||
| 1031 | characters can start a multibyte sequence, so they need | ||
| 1032 | not be analyzed further. */ | ||
| 1033 | add1 (*f); | ||
| 1034 | continue; | ||
| 1035 | |||
| 1036 | default: | ||
| 1037 | /* Copy this multibyte sequence until we reach its end, find | ||
| 1038 | an error, or come back to the initial shift state. */ | ||
| 1039 | { | ||
| 1040 | mbstate_t mbstate = mbstate_zero; | ||
| 1041 | size_t len = 0; | ||
| 1042 | size_t fsize; | ||
| 1043 | |||
| 1044 | if (! format_end) | ||
| 1045 | format_end = f + strlen (f) + 1; | ||
| 1046 | fsize = format_end - f; | ||
| 1047 | |||
| 1048 | do | ||
| 1049 | { | ||
| 1050 | size_t bytes = mbrlen (f + len, fsize - len, &mbstate); | ||
| 1051 | |||
| 1052 | if (bytes == 0) | ||
| 1053 | break; | ||
| 1054 | |||
| 1055 | if (bytes == (size_t) -2) | ||
| 1056 | { | ||
| 1057 | len += strlen (f + len); | ||
| 1058 | break; | ||
| 1059 | } | ||
| 1060 | |||
| 1061 | if (bytes == (size_t) -1) | ||
| 1062 | { | ||
| 1063 | len++; | ||
| 1064 | break; | ||
| 1065 | } | ||
| 1066 | |||
| 1067 | len += bytes; | ||
| 1068 | } | ||
| 1069 | while (! mbsinit (&mbstate)); | ||
| 1070 | |||
| 1071 | cpy (len, f); | ||
| 1072 | f += len - 1; | ||
| 1073 | continue; | ||
| 1074 | } | ||
| 1075 | } | ||
| 1076 | |||
| 1077 | #else /* ! DO_MULTIBYTE */ | ||
| 1078 | |||
| 1079 | /* Either multibyte encodings are not supported, they are | ||
| 1080 | safe for formats, so any non-'%' byte can be copied through, | ||
| 1081 | or this is the wide character version. */ | ||
| 1082 | if (*f != L_('%')) | ||
| 1083 | { | ||
| 1084 | add1 (*f); | ||
| 1085 | continue; | ||
| 1086 | } | ||
| 1087 | |||
| 1088 | #endif /* ! DO_MULTIBYTE */ | ||
| 1089 | |||
| 1090 | char const *percent = f; | ||
| 1091 | |||
| 1092 | /* Check for flags that can modify a format. */ | ||
| 1093 | while (1) | ||
| 1094 | { | ||
| 1095 | switch (*++f) | ||
| 1096 | { | ||
| 1097 | /* This influences the number formats. */ | ||
| 1098 | case L_('_'): | ||
| 1099 | case L_('-'): | ||
| 1100 | case L_('+'): | ||
| 1101 | case L_('0'): | ||
| 1102 | pad = *f; | ||
| 1103 | continue; | ||
| 1104 | |||
| 1105 | /* This changes textual output. */ | ||
| 1106 | case L_('^'): | ||
| 1107 | to_uppcase = true; | ||
| 1108 | continue; | ||
| 1109 | case L_('#'): | ||
| 1110 | change_case = true; | ||
| 1111 | continue; | ||
| 1112 | |||
| 1113 | default: | ||
| 1114 | break; | ||
| 1115 | } | ||
| 1116 | break; | ||
| 1117 | } | ||
| 1118 | |||
| 1119 | if (ISDIGIT (*f)) | ||
| 1120 | { | ||
| 1121 | width = 0; | ||
| 1122 | do | ||
| 1123 | { | ||
| 1124 | if (ckd_mul (&width, width, 10) | ||
| 1125 | || ckd_add (&width, width, *f - L_('0'))) | ||
| 1126 | width = INT_MAX; | ||
| 1127 | ++f; | ||
| 1128 | } | ||
| 1129 | while (ISDIGIT (*f)); | ||
| 1130 | } | ||
| 1131 | |||
| 1132 | /* Check for modifiers. */ | ||
| 1133 | switch (*f) | ||
| 1134 | { | ||
| 1135 | case L_('E'): | ||
| 1136 | case L_('O'): | ||
| 1137 | modifier = *f++; | ||
| 1138 | break; | ||
| 1139 | |||
| 1140 | default: | ||
| 1141 | modifier = 0; | ||
| 1142 | break; | ||
| 1143 | } | ||
| 1144 | |||
| 1145 | /* Now do the specified format. */ | ||
| 1146 | format_char = *f; | ||
| 1147 | switch (format_char) | ||
| 1148 | { | ||
| 1149 | #define DO_NUMBER(d, v) \ | ||
| 1150 | do \ | ||
| 1151 | { \ | ||
| 1152 | digits = d; \ | ||
| 1153 | number_value = v; \ | ||
| 1154 | goto do_number; \ | ||
| 1155 | } \ | ||
| 1156 | while (0) | ||
| 1157 | #define DO_SIGNED_NUMBER(d, negative, v) \ | ||
| 1158 | DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_signed_number) | ||
| 1159 | #define DO_YEARISH(d, negative, v) \ | ||
| 1160 | DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_yearish) | ||
| 1161 | #define DO_MAYBE_SIGNED_NUMBER(d, negative, v, label) \ | ||
| 1162 | do \ | ||
| 1163 | { \ | ||
| 1164 | digits = d; \ | ||
| 1165 | negative_number = negative; \ | ||
| 1166 | u_number_value = v; \ | ||
| 1167 | goto label; \ | ||
| 1168 | } \ | ||
| 1169 | while (0) | ||
| 1170 | |||
| 1171 | /* The mask is not what you might think. | ||
| 1172 | When the ordinal i'th bit is set, insert a colon | ||
| 1173 | before the i'th digit of the time zone representation. */ | ||
| 1174 | #define DO_TZ_OFFSET(d, mask, v) \ | ||
| 1175 | do \ | ||
| 1176 | { \ | ||
| 1177 | digits = d; \ | ||
| 1178 | tz_colon_mask = mask; \ | ||
| 1179 | u_number_value = v; \ | ||
| 1180 | goto do_tz_offset; \ | ||
| 1181 | } \ | ||
| 1182 | while (0) | ||
| 1183 | #define DO_NUMBER_SPACEPAD(d, v) \ | ||
| 1184 | do \ | ||
| 1185 | { \ | ||
| 1186 | digits = d; \ | ||
| 1187 | number_value = v; \ | ||
| 1188 | goto do_number_spacepad; \ | ||
| 1189 | } \ | ||
| 1190 | while (0) | ||
| 1191 | |||
| 1192 | case L_('%'): | ||
| 1193 | if (f - 1 != percent) | ||
| 1194 | goto bad_percent; | ||
| 1195 | add1 (*f); | ||
| 1196 | break; | ||
| 1197 | |||
| 1198 | case L_('a'): | ||
| 1199 | if (modifier != 0) | ||
| 1200 | goto bad_format; | ||
| 1201 | if (change_case) | ||
| 1202 | { | ||
| 1203 | to_uppcase = true; | ||
| 1204 | to_lowcase = false; | ||
| 1205 | } | ||
| 1206 | #if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L) | ||
| 1207 | cpy (aw_len, a_wkday); | ||
| 1208 | break; | ||
| 1209 | #else | ||
| 1210 | goto underlying_strftime; | ||
| 1211 | #endif | ||
| 1212 | |||
| 1213 | case 'A': | ||
| 1214 | if (modifier != 0) | ||
| 1215 | goto bad_format; | ||
| 1216 | if (change_case) | ||
| 1217 | { | ||
| 1218 | to_uppcase = true; | ||
| 1219 | to_lowcase = false; | ||
| 1220 | } | ||
| 1221 | #if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L) | ||
| 1222 | cpy (STRLEN (f_wkday), f_wkday); | ||
| 1223 | break; | ||
| 1224 | #else | ||
| 1225 | goto underlying_strftime; | ||
| 1226 | #endif | ||
| 1227 | |||
| 1228 | case L_('b'): | ||
| 1229 | case L_('h'): | ||
| 1230 | if (change_case) | ||
| 1231 | { | ||
| 1232 | to_uppcase = true; | ||
| 1233 | to_lowcase = false; | ||
| 1234 | } | ||
| 1235 | if (modifier == L_('E')) | ||
| 1236 | goto bad_format; | ||
| 1237 | #ifdef _NL_CURRENT | ||
| 1238 | if (modifier == L_('O')) | ||
| 1239 | cpy (aam_len, a_altmonth); | ||
| 1240 | else | ||
| 1241 | cpy (am_len, a_month); | ||
| 1242 | break; | ||
| 1243 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 1244 | cpy (am_len, a_month); | ||
| 1245 | break; | ||
| 1246 | #else | ||
| 1247 | goto underlying_strftime; | ||
| 1248 | #endif | ||
| 1249 | |||
| 1250 | case L_('B'): | ||
| 1251 | if (modifier == L_('E')) | ||
| 1252 | goto bad_format; | ||
| 1253 | if (change_case) | ||
| 1254 | { | ||
| 1255 | to_uppcase = true; | ||
| 1256 | to_lowcase = false; | ||
| 1257 | } | ||
| 1258 | #ifdef _NL_CURRENT | ||
| 1259 | if (modifier == L_('O')) | ||
| 1260 | cpy (STRLEN (f_altmonth), f_altmonth); | ||
| 1261 | else | ||
| 1262 | cpy (STRLEN (f_month), f_month); | ||
| 1263 | break; | ||
| 1264 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 1265 | cpy (STRLEN (f_month), f_month); | ||
| 1266 | break; | ||
| 1267 | #else | ||
| 1268 | goto underlying_strftime; | ||
| 1269 | #endif | ||
| 1270 | |||
| 1271 | case L_('c'): | ||
| 1272 | if (modifier == L_('O')) | ||
| 1273 | goto bad_format; | ||
| 1274 | #ifdef _NL_CURRENT | ||
| 1275 | if (! (modifier == L_('E') | ||
| 1276 | && (*(subfmt = | ||
| 1277 | (const CHAR_T *) _NL_CURRENT (LC_TIME, | ||
| 1278 | NLW(ERA_D_T_FMT))) | ||
| 1279 | != '\0'))) | ||
| 1280 | subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT)); | ||
| 1281 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 1282 | subfmt = L_("%a %b %e %H:%M:%S %Y"); | ||
| 1283 | #else | ||
| 1284 | goto underlying_strftime; | ||
| 1285 | #endif | ||
| 1286 | |||
| 1287 | subformat: | ||
| 1288 | subwidth = -1; | ||
| 1289 | subformat_width: | ||
| 1290 | { | ||
| 1291 | size_t len = __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1) | ||
| 1292 | subfmt, tp, to_uppcase, | ||
| 1293 | pad, subwidth, tzset_called | ||
| 1294 | extra_args LOCALE_ARG); | ||
| 1295 | add (len, __strftime_internal (p, | ||
| 1296 | STRFTIME_ARG (maxsize - i) | ||
| 1297 | subfmt, tp, to_uppcase, | ||
| 1298 | pad, subwidth, tzset_called | ||
| 1299 | extra_args LOCALE_ARG)); | ||
| 1300 | } | ||
| 1301 | break; | ||
| 1302 | |||
| 1303 | #if !((defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY) || (USE_C_LOCALE && !HAVE_STRFTIME_L)) | ||
| 1304 | underlying_strftime: | ||
| 1305 | { | ||
| 1306 | /* The relevant information is available only via the | ||
| 1307 | underlying strftime implementation, so use that. */ | ||
| 1308 | char ufmt[5]; | ||
| 1309 | char *u = ufmt; | ||
| 1310 | char ubuf[1024]; /* enough for any single format in practice */ | ||
| 1311 | size_t len; | ||
| 1312 | /* Make sure we're calling the actual underlying strftime. | ||
| 1313 | In some cases, config.h contains something like | ||
| 1314 | "#define strftime rpl_strftime". */ | ||
| 1315 | # ifdef strftime | ||
| 1316 | # undef strftime | ||
| 1317 | size_t strftime (char *, size_t, const char *, struct tm const *); | ||
| 1318 | # endif | ||
| 1319 | |||
| 1320 | /* The space helps distinguish strftime failure from empty | ||
| 1321 | output. */ | ||
| 1322 | *u++ = ' '; | ||
| 1323 | *u++ = '%'; | ||
| 1324 | if (modifier != 0) | ||
| 1325 | *u++ = modifier; | ||
| 1326 | *u++ = format_char; | ||
| 1327 | *u = '\0'; | ||
| 1328 | |||
| 1329 | # if USE_C_LOCALE /* implies HAVE_STRFTIME_L */ | ||
| 1330 | locale_t locale = c_locale (); | ||
| 1331 | if (!locale) | ||
| 1332 | return 0; /* errno is set here */ | ||
| 1333 | len = strftime_l (ubuf, sizeof ubuf, ufmt, tp, locale); | ||
| 1334 | # else | ||
| 1335 | len = strftime (ubuf, sizeof ubuf, ufmt, tp); | ||
| 1336 | # endif | ||
| 1337 | if (len != 0) | ||
| 1338 | { | ||
| 1339 | # if defined __NetBSD__ || defined __sun /* NetBSD, Solaris */ | ||
| 1340 | if (format_char == L_('c')) | ||
| 1341 | { | ||
| 1342 | /* The output of the strftime %c directive consists of the | ||
| 1343 | date, the time, and the time zone. But the time zone is | ||
| 1344 | wrong, since neither TZ nor ZONE was passed as argument. | ||
| 1345 | Therefore, remove the the last space-delimited word. | ||
| 1346 | In order not to accidentally remove a date or a year | ||
| 1347 | (that contains no letter) or an AM/PM indicator (that has | ||
| 1348 | length 2), remove that last word only if it contains a | ||
| 1349 | letter and has length >= 3. */ | ||
| 1350 | char *space; | ||
| 1351 | for (space = ubuf + len - 1; *space != ' '; space--) | ||
| 1352 | ; | ||
| 1353 | if (space > ubuf) | ||
| 1354 | { | ||
| 1355 | /* Found a space. */ | ||
| 1356 | if (strlen (space + 1) >= 3) | ||
| 1357 | { | ||
| 1358 | /* The last word has length >= 3. */ | ||
| 1359 | bool found_letter = false; | ||
| 1360 | const char *p; | ||
| 1361 | for (p = space + 1; *p != '\0'; p++) | ||
| 1362 | if ((*p >= 'A' && *p <= 'Z') | ||
| 1363 | || (*p >= 'a' && *p <= 'z')) | ||
| 1364 | { | ||
| 1365 | found_letter = true; | ||
| 1366 | break; | ||
| 1367 | } | ||
| 1368 | if (found_letter) | ||
| 1369 | { | ||
| 1370 | /* The last word contains a letter. */ | ||
| 1371 | *space = '\0'; | ||
| 1372 | len = space - ubuf; | ||
| 1373 | } | ||
| 1374 | } | ||
| 1375 | } | ||
| 1376 | } | ||
| 1377 | # if REQUIRE_GNUISH_STRFTIME_AM_PM | ||
| 1378 | /* The output of the strftime %p and %r directives contains | ||
| 1379 | an AM/PM indicator even for locales where it is not | ||
| 1380 | suitable, such as French. Remove this indicator. */ | ||
| 1381 | else if (format_char == L_('p')) | ||
| 1382 | { | ||
| 1383 | bool found_ampm = (len > 1); | ||
| 1384 | if (found_ampm && should_remove_ampm ()) | ||
| 1385 | { | ||
| 1386 | ubuf[1] = '\0'; | ||
| 1387 | len = 1; | ||
| 1388 | } | ||
| 1389 | } | ||
| 1390 | else if (format_char == L_('r')) | ||
| 1391 | { | ||
| 1392 | char last_char = ubuf[len - 1]; | ||
| 1393 | bool found_ampm = !(last_char >= '0' && last_char <= '9'); | ||
| 1394 | if (found_ampm && should_remove_ampm ()) | ||
| 1395 | { | ||
| 1396 | char *space; | ||
| 1397 | for (space = ubuf + len - 1; *space != ' '; space--) | ||
| 1398 | ; | ||
| 1399 | if (space > ubuf) | ||
| 1400 | { | ||
| 1401 | *space = '\0'; | ||
| 1402 | len = space - ubuf; | ||
| 1403 | } | ||
| 1404 | } | ||
| 1405 | } | ||
| 1406 | # endif | ||
| 1407 | # endif | ||
| 1408 | cpy (len - 1, ubuf + 1); | ||
| 1409 | } | ||
| 1410 | } | ||
| 1411 | break; | ||
| 1412 | #endif | ||
| 1413 | |||
| 1414 | case L_('C'): | ||
| 1415 | if (modifier == L_('E')) | ||
| 1416 | { | ||
| 1417 | #if HAVE_STRUCT_ERA_ENTRY | ||
| 1418 | struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); | ||
| 1419 | if (era) | ||
| 1420 | { | ||
| 1421 | # ifdef COMPILE_WIDE | ||
| 1422 | size_t len = __wcslen (era->era_wname); | ||
| 1423 | cpy (len, era->era_wname); | ||
| 1424 | # else | ||
| 1425 | size_t len = strlen (era->era_name); | ||
| 1426 | cpy (len, era->era_name); | ||
| 1427 | # endif | ||
| 1428 | break; | ||
| 1429 | } | ||
| 1430 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 1431 | #else | ||
| 1432 | goto underlying_strftime; | ||
| 1433 | #endif | ||
| 1434 | } | ||
| 1435 | |||
| 1436 | { | ||
| 1437 | bool negative_year = tp->tm_year < - TM_YEAR_BASE; | ||
| 1438 | bool zero_thru_1899 = !negative_year & (tp->tm_year < 0); | ||
| 1439 | int century = ((tp->tm_year - 99 * zero_thru_1899) / 100 | ||
| 1440 | + TM_YEAR_BASE / 100); | ||
| 1441 | DO_YEARISH (2, negative_year, century); | ||
| 1442 | } | ||
| 1443 | |||
| 1444 | case L_('x'): | ||
| 1445 | if (modifier == L_('O')) | ||
| 1446 | goto bad_format; | ||
| 1447 | #ifdef _NL_CURRENT | ||
| 1448 | if (! (modifier == L_('E') | ||
| 1449 | && (*(subfmt = | ||
| 1450 | (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_D_FMT))) | ||
| 1451 | != L_('\0')))) | ||
| 1452 | subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT)); | ||
| 1453 | goto subformat; | ||
| 1454 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 1455 | subfmt = L_("%m/%d/%y"); | ||
| 1456 | goto subformat; | ||
| 1457 | #else | ||
| 1458 | goto underlying_strftime; | ||
| 1459 | #endif | ||
| 1460 | case L_('D'): | ||
| 1461 | if (modifier != 0) | ||
| 1462 | goto bad_format; | ||
| 1463 | subfmt = L_("%m/%d/%y"); | ||
| 1464 | goto subformat; | ||
| 1465 | |||
| 1466 | case L_('d'): | ||
| 1467 | if (modifier == L_('E')) | ||
| 1468 | goto bad_format; | ||
| 1469 | |||
| 1470 | DO_NUMBER (2, tp->tm_mday); | ||
| 1471 | |||
| 1472 | case L_('e'): | ||
| 1473 | if (modifier == L_('E')) | ||
| 1474 | goto bad_format; | ||
| 1475 | |||
| 1476 | DO_NUMBER_SPACEPAD (2, tp->tm_mday); | ||
| 1477 | |||
| 1478 | /* All numeric formats set DIGITS and NUMBER_VALUE (or U_NUMBER_VALUE) | ||
| 1479 | and then jump to one of these labels. */ | ||
| 1480 | |||
| 1481 | do_tz_offset: | ||
| 1482 | always_output_a_sign = true; | ||
| 1483 | goto do_number_body; | ||
| 1484 | |||
| 1485 | do_yearish: | ||
| 1486 | if (pad == 0) | ||
| 1487 | pad = yr_spec; | ||
| 1488 | always_output_a_sign | ||
| 1489 | = (pad == L_('+') | ||
| 1490 | && ((digits == 2 ? 99 : 9999) < u_number_value | ||
| 1491 | || digits < width)); | ||
| 1492 | goto do_maybe_signed_number; | ||
| 1493 | |||
| 1494 | do_number_spacepad: | ||
| 1495 | if (pad == 0) | ||
| 1496 | pad = L_('_'); | ||
| 1497 | |||
| 1498 | do_number: | ||
| 1499 | /* Format NUMBER_VALUE according to the MODIFIER flag. */ | ||
| 1500 | negative_number = number_value < 0; | ||
| 1501 | u_number_value = number_value; | ||
| 1502 | |||
| 1503 | do_signed_number: | ||
| 1504 | always_output_a_sign = false; | ||
| 1505 | |||
| 1506 | do_maybe_signed_number: | ||
| 1507 | tz_colon_mask = 0; | ||
| 1508 | |||
| 1509 | do_number_body: | ||
| 1510 | /* Format U_NUMBER_VALUE according to the MODIFIER flag. | ||
| 1511 | NEGATIVE_NUMBER is nonzero if the original number was | ||
| 1512 | negative; in this case it was converted directly to | ||
| 1513 | unsigned int (i.e., modulo (UINT_MAX + 1)) without | ||
| 1514 | negating it. */ | ||
| 1515 | if (modifier == L_('O') && !negative_number) | ||
| 1516 | { | ||
| 1517 | #ifdef _NL_CURRENT | ||
| 1518 | /* Get the locale specific alternate representation of | ||
| 1519 | the number. If none exist NULL is returned. */ | ||
| 1520 | const CHAR_T *cp = nl_get_alt_digit (u_number_value | ||
| 1521 | HELPER_LOCALE_ARG); | ||
| 1522 | |||
| 1523 | if (cp != NULL) | ||
| 1524 | { | ||
| 1525 | size_t digitlen = STRLEN (cp); | ||
| 1526 | if (digitlen != 0) | ||
| 1527 | { | ||
| 1528 | cpy (digitlen, cp); | ||
| 1529 | break; | ||
| 1530 | } | ||
| 1531 | } | ||
| 1532 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 1533 | #else | ||
| 1534 | goto underlying_strftime; | ||
| 1535 | #endif | ||
| 1536 | } | ||
| 1537 | |||
| 1538 | bufp = buf + sizeof (buf) / sizeof (buf[0]); | ||
| 1539 | |||
| 1540 | if (negative_number) | ||
| 1541 | u_number_value = - u_number_value; | ||
| 1542 | |||
| 1543 | do | ||
| 1544 | { | ||
| 1545 | if (tz_colon_mask & 1) | ||
| 1546 | *--bufp = ':'; | ||
| 1547 | tz_colon_mask >>= 1; | ||
| 1548 | *--bufp = u_number_value % 10 + L_('0'); | ||
| 1549 | u_number_value /= 10; | ||
| 1550 | } | ||
| 1551 | while (u_number_value != 0 || tz_colon_mask != 0); | ||
| 1552 | |||
| 1553 | do_number_sign_and_padding: | ||
| 1554 | if (pad == 0) | ||
| 1555 | pad = L_('0'); | ||
| 1556 | if (width < 0) | ||
| 1557 | width = digits; | ||
| 1558 | |||
| 1559 | { | ||
| 1560 | CHAR_T sign_char = (negative_number ? L_('-') | ||
| 1561 | : always_output_a_sign ? L_('+') | ||
| 1562 | : 0); | ||
| 1563 | int numlen = buf + sizeof buf / sizeof buf[0] - bufp; | ||
| 1564 | int shortage = width - !!sign_char - numlen; | ||
| 1565 | int padding = pad == L_('-') || shortage <= 0 ? 0 : shortage; | ||
| 1566 | |||
| 1567 | if (sign_char) | ||
| 1568 | { | ||
| 1569 | if (pad == L_('_')) | ||
| 1570 | { | ||
| 1571 | if (p) | ||
| 1572 | memset_space (p, padding); | ||
| 1573 | i += padding; | ||
| 1574 | width -= padding; | ||
| 1575 | } | ||
| 1576 | width_add1 (0, sign_char); | ||
| 1577 | width--; | ||
| 1578 | } | ||
| 1579 | |||
| 1580 | cpy (numlen, bufp); | ||
| 1581 | } | ||
| 1582 | break; | ||
| 1583 | |||
| 1584 | case L_('F'): | ||
| 1585 | if (modifier != 0) | ||
| 1586 | goto bad_format; | ||
| 1587 | if (pad == 0 && width < 0) | ||
| 1588 | { | ||
| 1589 | pad = L_('+'); | ||
| 1590 | subwidth = 4; | ||
| 1591 | } | ||
| 1592 | else | ||
| 1593 | { | ||
| 1594 | subwidth = width - 6; | ||
| 1595 | if (subwidth < 0) | ||
| 1596 | subwidth = 0; | ||
| 1597 | } | ||
| 1598 | subfmt = L_("%Y-%m-%d"); | ||
| 1599 | goto subformat_width; | ||
| 1600 | |||
| 1601 | case L_('H'): | ||
| 1602 | if (modifier == L_('E')) | ||
| 1603 | goto bad_format; | ||
| 1604 | |||
| 1605 | DO_NUMBER (2, tp->tm_hour); | ||
| 1606 | |||
| 1607 | case L_('I'): | ||
| 1608 | if (modifier == L_('E')) | ||
| 1609 | goto bad_format; | ||
| 1610 | |||
| 1611 | DO_NUMBER (2, hour12); | ||
| 1612 | |||
| 1613 | case L_('k'): /* GNU extension. */ | ||
| 1614 | if (modifier == L_('E')) | ||
| 1615 | goto bad_format; | ||
| 1616 | |||
| 1617 | DO_NUMBER_SPACEPAD (2, tp->tm_hour); | ||
| 1618 | |||
| 1619 | case L_('l'): /* GNU extension. */ | ||
| 1620 | if (modifier == L_('E')) | ||
| 1621 | goto bad_format; | ||
| 1622 | |||
| 1623 | DO_NUMBER_SPACEPAD (2, hour12); | ||
| 1624 | |||
| 1625 | case L_('j'): | ||
| 1626 | if (modifier == L_('E')) | ||
| 1627 | goto bad_format; | ||
| 1628 | |||
| 1629 | DO_SIGNED_NUMBER (3, tp->tm_yday < -1, tp->tm_yday + 1U); | ||
| 1630 | |||
| 1631 | case L_('M'): | ||
| 1632 | if (modifier == L_('E')) | ||
| 1633 | goto bad_format; | ||
| 1634 | |||
| 1635 | DO_NUMBER (2, tp->tm_min); | ||
| 1636 | |||
| 1637 | case L_('m'): | ||
| 1638 | if (modifier == L_('E')) | ||
| 1639 | goto bad_format; | ||
| 1640 | |||
| 1641 | DO_SIGNED_NUMBER (2, tp->tm_mon < -1, tp->tm_mon + 1U); | ||
| 1642 | |||
| 1643 | #ifndef _LIBC | ||
| 1644 | case L_('N'): /* GNU extension. */ | ||
| 1645 | if (modifier == L_('E')) | ||
| 1646 | goto bad_format; | ||
| 1647 | { | ||
| 1648 | int n = ns, ns_digits = 9; | ||
| 1649 | if (width <= 0) | ||
| 1650 | width = ns_digits; | ||
| 1651 | int ndigs = ns_digits; | ||
| 1652 | while (width < ndigs || (1 < ndigs && n % 10 == 0)) | ||
| 1653 | ndigs--, n /= 10; | ||
| 1654 | for (int j = ndigs; 0 < j; j--) | ||
| 1655 | buf[j - 1] = n % 10 + L_('0'), n /= 10; | ||
| 1656 | if (!pad) | ||
| 1657 | pad = L_('0'); | ||
| 1658 | width_cpy (0, ndigs, buf); | ||
| 1659 | width_add (width - ndigs, 0, (void) 0); | ||
| 1660 | } | ||
| 1661 | break; | ||
| 1662 | #endif | ||
| 1663 | |||
| 1664 | case L_('n'): | ||
| 1665 | add1 (L_('\n')); | ||
| 1666 | break; | ||
| 1667 | |||
| 1668 | case L_('P'): | ||
| 1669 | to_lowcase = true; | ||
| 1670 | #ifndef _NL_CURRENT | ||
| 1671 | format_char = L_('p'); | ||
| 1672 | #endif | ||
| 1673 | FALLTHROUGH; | ||
| 1674 | case L_('p'): | ||
| 1675 | if (change_case) | ||
| 1676 | { | ||
| 1677 | to_uppcase = false; | ||
| 1678 | to_lowcase = true; | ||
| 1679 | } | ||
| 1680 | #if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L) | ||
| 1681 | cpy (ap_len, ampm); | ||
| 1682 | break; | ||
| 1683 | #else | ||
| 1684 | goto underlying_strftime; | ||
| 1685 | #endif | ||
| 1686 | |||
| 1687 | case L_('q'): /* GNU extension. */ | ||
| 1688 | DO_SIGNED_NUMBER (1, false, ((tp->tm_mon * 11) >> 5) + 1); | ||
| 1689 | |||
| 1690 | case L_('R'): | ||
| 1691 | subfmt = L_("%H:%M"); | ||
| 1692 | goto subformat; | ||
| 1693 | |||
| 1694 | case L_('r'): | ||
| 1695 | #ifdef _NL_CURRENT | ||
| 1696 | if (*(subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, | ||
| 1697 | NLW(T_FMT_AMPM))) | ||
| 1698 | == L_('\0')) | ||
| 1699 | subfmt = L_("%I:%M:%S %p"); | ||
| 1700 | goto subformat; | ||
| 1701 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 1702 | subfmt = L_("%I:%M:%S %p"); | ||
| 1703 | goto subformat; | ||
| 1704 | #elif (defined __APPLE__ && defined __MACH__) || defined __FreeBSD__ | ||
| 1705 | /* macOS, FreeBSD strftime() may produce empty output for "%r". */ | ||
| 1706 | subfmt = L_("%I:%M:%S %p"); | ||
| 1707 | goto subformat; | ||
| 1708 | #else | ||
| 1709 | goto underlying_strftime; | ||
| 1710 | #endif | ||
| 1711 | |||
| 1712 | case L_('S'): | ||
| 1713 | if (modifier == L_('E')) | ||
| 1714 | goto bad_format; | ||
| 1715 | |||
| 1716 | DO_NUMBER (2, tp->tm_sec); | ||
| 1717 | |||
| 1718 | case L_('s'): /* GNU extension. */ | ||
| 1719 | { | ||
| 1720 | struct tm ltm; | ||
| 1721 | time_t t; | ||
| 1722 | |||
| 1723 | ltm = *tp; | ||
| 1724 | ltm.tm_yday = -1; | ||
| 1725 | t = mktime_z (tz, <m); | ||
| 1726 | if (ltm.tm_yday < 0) | ||
| 1727 | { | ||
| 1728 | errno = EOVERFLOW; | ||
| 1729 | return 0; | ||
| 1730 | } | ||
| 1731 | |||
| 1732 | /* Generate string value for T using time_t arithmetic; | ||
| 1733 | this works even if sizeof (long) < sizeof (time_t). */ | ||
| 1734 | |||
| 1735 | bufp = buf + sizeof (buf) / sizeof (buf[0]); | ||
| 1736 | negative_number = t < 0; | ||
| 1737 | |||
| 1738 | do | ||
| 1739 | { | ||
| 1740 | int d = t % 10; | ||
| 1741 | t /= 10; | ||
| 1742 | *--bufp = (negative_number ? -d : d) + L_('0'); | ||
| 1743 | } | ||
| 1744 | while (t != 0); | ||
| 1745 | |||
| 1746 | digits = 1; | ||
| 1747 | always_output_a_sign = false; | ||
| 1748 | goto do_number_sign_and_padding; | ||
| 1749 | } | ||
| 1750 | |||
| 1751 | case L_('X'): | ||
| 1752 | if (modifier == L_('O')) | ||
| 1753 | goto bad_format; | ||
| 1754 | #ifdef _NL_CURRENT | ||
| 1755 | if (! (modifier == L_('E') | ||
| 1756 | && (*(subfmt = | ||
| 1757 | (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_T_FMT))) | ||
| 1758 | != L_('\0')))) | ||
| 1759 | subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT)); | ||
| 1760 | goto subformat; | ||
| 1761 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 1762 | subfmt = L_("%H:%M:%S"); | ||
| 1763 | goto subformat; | ||
| 1764 | #else | ||
| 1765 | goto underlying_strftime; | ||
| 1766 | #endif | ||
| 1767 | case L_('T'): | ||
| 1768 | subfmt = L_("%H:%M:%S"); | ||
| 1769 | goto subformat; | ||
| 1770 | |||
| 1771 | case L_('t'): | ||
| 1772 | add1 (L_('\t')); | ||
| 1773 | break; | ||
| 1774 | |||
| 1775 | case L_('u'): | ||
| 1776 | DO_NUMBER (1, (tp->tm_wday - 1 + 7) % 7 + 1); | ||
| 1777 | |||
| 1778 | case L_('U'): | ||
| 1779 | if (modifier == L_('E')) | ||
| 1780 | goto bad_format; | ||
| 1781 | |||
| 1782 | DO_NUMBER (2, (tp->tm_yday - tp->tm_wday + 7) / 7); | ||
| 1783 | |||
| 1784 | case L_('V'): | ||
| 1785 | case L_('g'): | ||
| 1786 | case L_('G'): | ||
| 1787 | if (modifier == L_('E')) | ||
| 1788 | goto bad_format; | ||
| 1789 | { | ||
| 1790 | /* YEAR is a leap year if and only if (tp->tm_year + TM_YEAR_BASE) | ||
| 1791 | is a leap year, except that YEAR and YEAR - 1 both work | ||
| 1792 | correctly even when (tp->tm_year + TM_YEAR_BASE) would | ||
| 1793 | overflow. */ | ||
| 1794 | int year = (tp->tm_year | ||
| 1795 | + (tp->tm_year < 0 | ||
| 1796 | ? TM_YEAR_BASE % 400 | ||
| 1797 | : TM_YEAR_BASE % 400 - 400)); | ||
| 1798 | int year_adjust = 0; | ||
| 1799 | int days = iso_week_days (tp->tm_yday, tp->tm_wday); | ||
| 1800 | |||
| 1801 | if (days < 0) | ||
| 1802 | { | ||
| 1803 | /* This ISO week belongs to the previous year. */ | ||
| 1804 | year_adjust = -1; | ||
| 1805 | days = iso_week_days (tp->tm_yday + (365 + __isleap (year - 1)), | ||
| 1806 | tp->tm_wday); | ||
| 1807 | } | ||
| 1808 | else | ||
| 1809 | { | ||
| 1810 | int d = iso_week_days (tp->tm_yday - (365 + __isleap (year)), | ||
| 1811 | tp->tm_wday); | ||
| 1812 | if (0 <= d) | ||
| 1813 | { | ||
| 1814 | /* This ISO week belongs to the next year. */ | ||
| 1815 | year_adjust = 1; | ||
| 1816 | days = d; | ||
| 1817 | } | ||
| 1818 | } | ||
| 1819 | |||
| 1820 | switch (*f) | ||
| 1821 | { | ||
| 1822 | case L_('g'): | ||
| 1823 | { | ||
| 1824 | int yy = (tp->tm_year % 100 + year_adjust) % 100; | ||
| 1825 | DO_YEARISH (2, false, | ||
| 1826 | (0 <= yy | ||
| 1827 | ? yy | ||
| 1828 | : tp->tm_year < -TM_YEAR_BASE - year_adjust | ||
| 1829 | ? -yy | ||
| 1830 | : yy + 100)); | ||
| 1831 | } | ||
| 1832 | |||
| 1833 | case L_('G'): | ||
| 1834 | DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE - year_adjust, | ||
| 1835 | (tp->tm_year + (unsigned int) TM_YEAR_BASE | ||
| 1836 | + year_adjust)); | ||
| 1837 | |||
| 1838 | default: | ||
| 1839 | DO_NUMBER (2, days / 7 + 1); | ||
| 1840 | } | ||
| 1841 | } | ||
| 1842 | |||
| 1843 | case L_('W'): | ||
| 1844 | if (modifier == L_('E')) | ||
| 1845 | goto bad_format; | ||
| 1846 | |||
| 1847 | DO_NUMBER (2, (tp->tm_yday - (tp->tm_wday - 1 + 7) % 7 + 7) / 7); | ||
| 1848 | |||
| 1849 | case L_('w'): | ||
| 1850 | if (modifier == L_('E')) | ||
| 1851 | goto bad_format; | ||
| 1852 | |||
| 1853 | DO_NUMBER (1, tp->tm_wday); | ||
| 1854 | |||
| 1855 | case L_('Y'): | ||
| 1856 | if (modifier == L_('E')) | ||
| 1857 | { | ||
| 1858 | #if HAVE_STRUCT_ERA_ENTRY | ||
| 1859 | struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); | ||
| 1860 | if (era) | ||
| 1861 | { | ||
| 1862 | # ifdef COMPILE_WIDE | ||
| 1863 | subfmt = era->era_wformat; | ||
| 1864 | # else | ||
| 1865 | subfmt = era->era_format; | ||
| 1866 | # endif | ||
| 1867 | if (pad == 0) | ||
| 1868 | pad = yr_spec; | ||
| 1869 | goto subformat; | ||
| 1870 | } | ||
| 1871 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 1872 | #else | ||
| 1873 | goto underlying_strftime; | ||
| 1874 | #endif | ||
| 1875 | } | ||
| 1876 | if (modifier == L_('O')) | ||
| 1877 | goto bad_format; | ||
| 1878 | |||
| 1879 | DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE, | ||
| 1880 | tp->tm_year + (unsigned int) TM_YEAR_BASE); | ||
| 1881 | |||
| 1882 | case L_('y'): | ||
| 1883 | if (modifier == L_('E')) | ||
| 1884 | { | ||
| 1885 | #if HAVE_STRUCT_ERA_ENTRY | ||
| 1886 | struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); | ||
| 1887 | if (era) | ||
| 1888 | { | ||
| 1889 | int delta = tp->tm_year - era->start_date[0]; | ||
| 1890 | if (pad == 0) | ||
| 1891 | pad = yr_spec; | ||
| 1892 | DO_NUMBER (2, (era->offset | ||
| 1893 | + delta * era->absolute_direction)); | ||
| 1894 | } | ||
| 1895 | #elif USE_C_LOCALE && !HAVE_STRFTIME_L | ||
| 1896 | #else | ||
| 1897 | goto underlying_strftime; | ||
| 1898 | #endif | ||
| 1899 | } | ||
| 1900 | |||
| 1901 | { | ||
| 1902 | int yy = tp->tm_year % 100; | ||
| 1903 | if (yy < 0) | ||
| 1904 | yy = tp->tm_year < - TM_YEAR_BASE ? -yy : yy + 100; | ||
| 1905 | DO_YEARISH (2, false, yy); | ||
| 1906 | } | ||
| 1907 | |||
| 1908 | case L_('Z'): | ||
| 1909 | if (change_case) | ||
| 1910 | { | ||
| 1911 | to_uppcase = false; | ||
| 1912 | to_lowcase = true; | ||
| 1913 | } | ||
| 1914 | |||
| 1915 | #ifdef COMPILE_WIDE | ||
| 1916 | { | ||
| 1917 | /* The zone string is always given in multibyte form. We have | ||
| 1918 | to convert it to wide character. */ | ||
| 1919 | size_t w = pad == L_('-') || width < 0 ? 0 : width; | ||
| 1920 | char const *z = zone; | ||
| 1921 | mbstate_t st = {0}; | ||
| 1922 | size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc); | ||
| 1923 | if (len == (size_t) -1) | ||
| 1924 | return 0; | ||
| 1925 | size_t incr = len < w ? w : len; | ||
| 1926 | if (incr >= maxsize - i) | ||
| 1927 | { | ||
| 1928 | errno = ERANGE; | ||
| 1929 | return 0; | ||
| 1930 | } | ||
| 1931 | if (p) | ||
| 1932 | { | ||
| 1933 | if (len < w) | ||
| 1934 | { | ||
| 1935 | size_t delta = w - len; | ||
| 1936 | __wmemmove (p + delta, p, len); | ||
| 1937 | wchar_t wc = pad == L_('0') || pad == L_('+') ? L'0' : L' '; | ||
| 1938 | wmemset (p, wc, delta); | ||
| 1939 | } | ||
| 1940 | p += incr; | ||
| 1941 | } | ||
| 1942 | i += incr; | ||
| 1943 | } | ||
| 1944 | #else | ||
| 1945 | cpy (strlen (zone), zone); | ||
| 1946 | #endif | ||
| 1947 | break; | ||
| 1948 | |||
| 1949 | case L_(':'): | ||
| 1950 | /* :, ::, and ::: are valid only just before 'z'. | ||
| 1951 | :::: etc. are rejected later. */ | ||
| 1952 | for (colons = 1; f[colons] == L_(':'); colons++) | ||
| 1953 | continue; | ||
| 1954 | if (f[colons] != L_('z')) | ||
| 1955 | goto bad_format; | ||
| 1956 | f += colons; | ||
| 1957 | goto do_z_conversion; | ||
| 1958 | |||
| 1959 | case L_('z'): | ||
| 1960 | colons = 0; | ||
| 1961 | |||
| 1962 | do_z_conversion: | ||
| 1963 | if (tp->tm_isdst < 0) | ||
| 1964 | break; | ||
| 1965 | |||
| 1966 | { | ||
| 1967 | int diff; | ||
| 1968 | int hour_diff; | ||
| 1969 | int min_diff; | ||
| 1970 | int sec_diff; | ||
| 1971 | #if HAVE_TM_GMTOFF | ||
| 1972 | diff = tp->tm_gmtoff; | ||
| 1973 | #else | ||
| 1974 | if (!tz) | ||
| 1975 | diff = 0; | ||
| 1976 | else | ||
| 1977 | { | ||
| 1978 | struct tm gtm; | ||
| 1979 | struct tm ltm; | ||
| 1980 | time_t lt; | ||
| 1981 | |||
| 1982 | /* POSIX.1 requires that local time zone information be used as | ||
| 1983 | though strftime called tzset. */ | ||
| 1984 | # ifndef my_strftime | ||
| 1985 | if (!*tzset_called) | ||
| 1986 | { | ||
| 1987 | tzset (); | ||
| 1988 | *tzset_called = true; | ||
| 1989 | } | ||
| 1990 | # endif | ||
| 1991 | |||
| 1992 | ltm = *tp; | ||
| 1993 | ltm.tm_wday = -1; | ||
| 1994 | lt = mktime_z (tz, <m); | ||
| 1995 | if (ltm.tm_wday < 0 || ! localtime_rz (0, <, >m)) | ||
| 1996 | break; | ||
| 1997 | diff = tm_diff (<m, >m); | ||
| 1998 | } | ||
| 1999 | #endif | ||
| 2000 | |||
| 2001 | negative_number = diff < 0 || (diff == 0 && *zone == '-'); | ||
| 2002 | hour_diff = diff / 60 / 60; | ||
| 2003 | min_diff = diff / 60 % 60; | ||
| 2004 | sec_diff = diff % 60; | ||
| 2005 | |||
| 2006 | switch (colons) | ||
| 2007 | { | ||
| 2008 | case 0: /* +hhmm */ | ||
| 2009 | DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff); | ||
| 2010 | |||
| 2011 | case 1: tz_hh_mm: /* +hh:mm */ | ||
| 2012 | DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff); | ||
| 2013 | |||
| 2014 | case 2: tz_hh_mm_ss: /* +hh:mm:ss */ | ||
| 2015 | DO_TZ_OFFSET (9, 024, | ||
| 2016 | hour_diff * 10000 + min_diff * 100 + sec_diff); | ||
| 2017 | |||
| 2018 | case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ | ||
| 2019 | if (sec_diff != 0) | ||
| 2020 | goto tz_hh_mm_ss; | ||
| 2021 | if (min_diff != 0) | ||
| 2022 | goto tz_hh_mm; | ||
| 2023 | DO_TZ_OFFSET (3, 0, hour_diff); | ||
| 2024 | |||
| 2025 | default: | ||
| 2026 | goto bad_format; | ||
| 2027 | } | ||
| 2028 | } | ||
| 2029 | |||
| 2030 | case L_('\0'): /* GNU extension: % at end of format. */ | ||
| 2031 | bad_percent: | ||
| 2032 | --f; | ||
| 2033 | FALLTHROUGH; | ||
| 2034 | default: | ||
| 2035 | /* Unknown format; output the format, including the '%', | ||
| 2036 | since this is most likely the right thing to do if a | ||
| 2037 | multibyte string has been misparsed. */ | ||
| 2038 | bad_format: | ||
| 2039 | cpy (f - percent + 1, percent); | ||
| 2040 | break; | ||
| 2041 | } | ||
| 2042 | } | ||
| 2043 | |||
| 2044 | #if ! FPRINTFTIME | ||
| 2045 | if (p && maxsize != 0) | ||
| 2046 | *p = L_('\0'); | ||
| 2047 | #endif | ||
| 2048 | |||
| 2049 | errno = saved_errno; | ||
| 2050 | return i; | ||
| 2051 | } | ||
diff --git a/lib/strftime.h b/lib/strftime.h index d6efdb848a3..8ce62cdb6d7 100644 --- a/lib/strftime.h +++ b/lib/strftime.h | |||
| @@ -21,17 +21,68 @@ | |||
| 21 | extern "C" { | 21 | extern "C" { |
| 22 | #endif | 22 | #endif |
| 23 | 23 | ||
| 24 | /* Just like strftime, but with two more arguments: | 24 | /* Formats the broken-down time *__TP, with additional __NS nanoseconds, |
| 25 | POSIX requires that strftime use the local timezone information. | 25 | into the buffer __S of size __MAXSIZE, according to the rules of the |
| 26 | Use the timezone __TZ instead. Use __NS as the number of | 26 | LC_TIME category of the current locale. |
| 27 | nanoseconds in the %N directive. | 27 | |
| 28 | 28 | Uses the time zone __TZ. | |
| 29 | On error, set errno and return 0. Otherwise, return the number of | 29 | If *__TP represents local time, __TZ should be set to |
| 30 | bytes generated (not counting the trailing NUL), preserving errno | 30 | tzalloc (getenv ("TZ")). |
| 31 | if the number is 0. This errno behavior is in draft POSIX 202x | 31 | If *__TP represents universal time (a.k.a. GMT), __TZ should be set to |
| 32 | plus some requested changes to POSIX. */ | 32 | (timezone_t) 0. |
| 33 | size_t nstrftime (char *restrict, size_t, char const *, struct tm const *, | 33 | |
| 34 | timezone_t __tz, int __ns); | 34 | The format string __FORMAT, including GNU extensions, is described in |
| 35 | the GNU libc's strftime() documentation: | ||
| 36 | <https://www.gnu.org/software/libc/manual/html_node/Formatting-Calendar-Time.html> | ||
| 37 | Additionally, the following conversion is supported: | ||
| 38 | %N The number of nanoseconds, passed as __NS argument. | ||
| 39 | Here's a summary of the available conversions (= format directives): | ||
| 40 | literal characters %n %t %% | ||
| 41 | date: | ||
| 42 | century %C | ||
| 43 | year %Y %y | ||
| 44 | week-based year %G %g | ||
| 45 | month (in year) %m %B %b %h | ||
| 46 | week in year %U %W %V | ||
| 47 | day in year %j | ||
| 48 | day (in month) %d %e | ||
| 49 | day in week %u %w %A %a | ||
| 50 | year, month, day %x %F %D | ||
| 51 | time: | ||
| 52 | half-day %p %P | ||
| 53 | hour %H %k %I %l | ||
| 54 | minute (in hour) %M | ||
| 55 | hour, minute %R | ||
| 56 | second (in minute) %S | ||
| 57 | hour, minute, second %r %T %X | ||
| 58 | second (since epoch) %s | ||
| 59 | date and time: %c | ||
| 60 | time zone: %z %Z | ||
| 61 | nanosecond %N | ||
| 62 | |||
| 63 | Stores the result, as a string with a trailing NUL character, at the | ||
| 64 | beginning of the array __S[0..__MAXSIZE-1], if it fits, and returns | ||
| 65 | the length of that string, not counting the trailing NUL. In this case, | ||
| 66 | errno is preserved if the return value is 0. | ||
| 67 | If it does not fit, this function sets errno to ERANGE and returns 0. | ||
| 68 | Upon other errors, this function sets errno and returns 0 as well. | ||
| 69 | |||
| 70 | Note: The errno behavior is in draft POSIX 202x plus some requested | ||
| 71 | changes to POSIX. | ||
| 72 | |||
| 73 | This function is like strftime, but with two more arguments: | ||
| 74 | * __TZ instead of the local timezone information, | ||
| 75 | * __NS as the number of nanoseconds in the %N directive. | ||
| 76 | */ | ||
| 77 | size_t nstrftime (char *restrict __s, size_t __maxsize, | ||
| 78 | char const *__format, | ||
| 79 | struct tm const *__tp, timezone_t __tz, int __ns); | ||
| 80 | |||
| 81 | /* Like nstrftime, except that it uses the "C" locale instead of the | ||
| 82 | current locale. */ | ||
| 83 | size_t c_nstrftime (char *restrict __s, size_t __maxsize, | ||
| 84 | char const *__format, | ||
| 85 | struct tm const *__tp, timezone_t __tz, int __ns); | ||
| 35 | 86 | ||
| 36 | #ifdef __cplusplus | 87 | #ifdef __cplusplus |
| 37 | } | 88 | } |
diff --git a/lib/string.in.h b/lib/string.in.h index 01ea3e3913b..44ec2e7ecdb 100644 --- a/lib/string.in.h +++ b/lib/string.in.h | |||
| @@ -414,11 +414,21 @@ _GL_WARN_ON_USE (memrchr, "memrchr is unportable - " | |||
| 414 | /* Overwrite a block of memory. The compiler will not optimize | 414 | /* Overwrite a block of memory. The compiler will not optimize |
| 415 | effects away, even if the block is dead after the call. */ | 415 | effects away, even if the block is dead after the call. */ |
| 416 | #if @GNULIB_MEMSET_EXPLICIT@ | 416 | #if @GNULIB_MEMSET_EXPLICIT@ |
| 417 | # if ! @HAVE_MEMSET_EXPLICIT@ | 417 | # if @REPLACE_MEMSET_EXPLICIT@ |
| 418 | # if !(defined __cplusplus && defined GNULIB_NAMESPACE) | ||
| 419 | # undef memset_explicit | ||
| 420 | # define memset_explicit rpl_memset_explicit | ||
| 421 | # endif | ||
| 422 | _GL_FUNCDECL_RPL (memset_explicit, void *, | ||
| 423 | (void *__dest, int __c, size_t __n) _GL_ARG_NONNULL ((1))); | ||
| 424 | _GL_CXXALIAS_RPL (memset_explicit, void *, (void *__dest, int __c, size_t __n)); | ||
| 425 | # else | ||
| 426 | # if !@HAVE_MEMSET_EXPLICIT@ | ||
| 418 | _GL_FUNCDECL_SYS (memset_explicit, void *, | 427 | _GL_FUNCDECL_SYS (memset_explicit, void *, |
| 419 | (void *__dest, int __c, size_t __n) _GL_ARG_NONNULL ((1))); | 428 | (void *__dest, int __c, size_t __n) _GL_ARG_NONNULL ((1))); |
| 420 | # endif | 429 | # endif |
| 421 | _GL_CXXALIAS_SYS (memset_explicit, void *, (void *__dest, int __c, size_t __n)); | 430 | _GL_CXXALIAS_SYS (memset_explicit, void *, (void *__dest, int __c, size_t __n)); |
| 431 | # endif | ||
| 422 | _GL_CXXALIASWARN (memset_explicit); | 432 | _GL_CXXALIASWARN (memset_explicit); |
| 423 | #elif defined GNULIB_POSIXCHECK | 433 | #elif defined GNULIB_POSIXCHECK |
| 424 | # undef memset_explicit | 434 | # undef memset_explicit |
diff --git a/lib/time.in.h b/lib/time.in.h index 58e103af07c..df99c8abca9 100644 --- a/lib/time.in.h +++ b/lib/time.in.h | |||
| @@ -154,11 +154,21 @@ _GL_WARN_ON_USE (timespec_get, "timespec_get is unportable - " | |||
| 154 | /* Set *TS to the current time resolution, and return BASE. | 154 | /* Set *TS to the current time resolution, and return BASE. |
| 155 | Upon failure, return 0. */ | 155 | Upon failure, return 0. */ |
| 156 | # if @GNULIB_TIMESPEC_GETRES@ | 156 | # if @GNULIB_TIMESPEC_GETRES@ |
| 157 | # if ! @HAVE_TIMESPEC_GETRES@ | 157 | # if @REPLACE_TIMESPEC_GETRES@ |
| 158 | # if !(defined __cplusplus && defined GNULIB_NAMESPACE) | ||
| 159 | # undef timespec_getres | ||
| 160 | # define timespec_getres rpl_timespec_getres | ||
| 161 | # endif | ||
| 162 | _GL_FUNCDECL_RPL (timespec_getres, int, (struct timespec *ts, int base) | ||
| 163 | _GL_ARG_NONNULL ((1))); | ||
| 164 | _GL_CXXALIAS_RPL (timespec_getres, int, (struct timespec *ts, int base)); | ||
| 165 | # else | ||
| 166 | # if !@HAVE_TIMESPEC_GETRES@ | ||
| 158 | _GL_FUNCDECL_SYS (timespec_getres, int, (struct timespec *ts, int base) | 167 | _GL_FUNCDECL_SYS (timespec_getres, int, (struct timespec *ts, int base) |
| 159 | _GL_ARG_NONNULL ((1))); | 168 | _GL_ARG_NONNULL ((1))); |
| 160 | # endif | 169 | # endif |
| 161 | _GL_CXXALIAS_SYS (timespec_getres, int, (struct timespec *ts, int base)); | 170 | _GL_CXXALIAS_SYS (timespec_getres, int, (struct timespec *ts, int base)); |
| 171 | # endif | ||
| 162 | _GL_CXXALIASWARN (timespec_getres); | 172 | _GL_CXXALIASWARN (timespec_getres); |
| 163 | # elif defined GNULIB_POSIXCHECK | 173 | # elif defined GNULIB_POSIXCHECK |
| 164 | # undef timespec_getres | 174 | # undef timespec_getres |
| @@ -428,11 +438,7 @@ _GL_CXXALIAS_SYS (ctime, char *, (time_t const *__tp)); | |||
| 428 | _GL_CXXALIASWARN (ctime); | 438 | _GL_CXXALIASWARN (ctime); |
| 429 | # endif | 439 | # endif |
| 430 | # elif defined GNULIB_POSIXCHECK | 440 | # elif defined GNULIB_POSIXCHECK |
| 431 | # undef ctime | 441 | /* No need to warn about portability, as a more serious warning is below. */ |
| 432 | # if HAVE_RAW_DECL_CTIME | ||
| 433 | _GL_WARN_ON_USE (ctime, "ctime has portability problems - " | ||
| 434 | "use gnulib module ctime for portability"); | ||
| 435 | # endif | ||
| 436 | # endif | 442 | # endif |
| 437 | 443 | ||
| 438 | /* Convert *TP to a date and time string. See | 444 | /* Convert *TP to a date and time string. See |
diff --git a/lib/time_r.c b/lib/time_r.c index 3ef0b36802c..b724f3b38de 100644 --- a/lib/time_r.c +++ b/lib/time_r.c | |||
| @@ -21,6 +21,11 @@ | |||
| 21 | 21 | ||
| 22 | #include <time.h> | 22 | #include <time.h> |
| 23 | 23 | ||
| 24 | /* The replacement functions in this file are only used on native Windows. | ||
| 25 | They are multithread-safe, because the gmtime() and localtime() functions | ||
| 26 | on native Windows — both in the ucrt and in the older MSVCRT — return a | ||
| 27 | pointer to a 'struct tm' in thread-local memory. */ | ||
| 28 | |||
| 24 | static struct tm * | 29 | static struct tm * |
| 25 | copy_tm_result (struct tm *dest, struct tm const *src) | 30 | copy_tm_result (struct tm *dest, struct tm const *src) |
| 26 | { | 31 | { |
diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h index 8f4d40dcbeb..701013a07f4 100644 --- a/lib/warn-on-use.h +++ b/lib/warn-on-use.h | |||
| @@ -32,6 +32,10 @@ | |||
| 32 | _GL_WARN_ON_USE_ATTRIBUTE is for functions with 'static' or 'inline' | 32 | _GL_WARN_ON_USE_ATTRIBUTE is for functions with 'static' or 'inline' |
| 33 | linkage. | 33 | linkage. |
| 34 | 34 | ||
| 35 | _GL_WARN_ON_USE should not be used more than once for a given function | ||
| 36 | in a given compilation unit (because this may generate a warning even | ||
| 37 | if the function is never called). | ||
| 38 | |||
| 35 | However, one of the reasons that a function is a portability trap is | 39 | However, one of the reasons that a function is a portability trap is |
| 36 | if it has the wrong signature. Declaring FUNCTION with a different | 40 | if it has the wrong signature. Declaring FUNCTION with a different |
| 37 | signature in C is a compilation error, so this macro must use the | 41 | signature in C is a compilation error, so this macro must use the |
diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index 0b7bb2cee85..7f30f83e769 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h | |||
| @@ -29,8 +29,7 @@ | |||
| 29 | is SIZE_MAX - 1. */ | 29 | is SIZE_MAX - 1. */ |
| 30 | #define __xalloc_oversized(n, s) \ | 30 | #define __xalloc_oversized(n, s) \ |
| 31 | ((s) != 0 \ | 31 | ((s) != 0 \ |
| 32 | && ((size_t) (PTRDIFF_MAX < SIZE_MAX ? PTRDIFF_MAX : SIZE_MAX - 1) / (s) \ | 32 | && (PTRDIFF_MAX < SIZE_MAX ? PTRDIFF_MAX : SIZE_MAX - 1) / (s) < (n)) |
| 33 | < (n))) | ||
| 34 | 33 | ||
| 35 | /* Return 1 if and only if an array of N objects, each of size S, | 34 | /* Return 1 if and only if an array of N objects, each of size S, |
| 36 | cannot exist reliably because its total size in bytes would exceed | 35 | cannot exist reliably because its total size in bytes would exceed |
diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 2bd9faad69d..188eeb720c0 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el | |||
| @@ -602,8 +602,7 @@ It is nil if the abbrev has already been unexpanded.") | |||
| 602 | "Undefine all abbrevs in abbrev table TABLE, leaving TABLE empty." | 602 | "Undefine all abbrevs in abbrev table TABLE, leaving TABLE empty." |
| 603 | (setq abbrevs-changed t) | 603 | (setq abbrevs-changed t) |
| 604 | (let* ((sym (obarray-get table ""))) | 604 | (let* ((sym (obarray-get table ""))) |
| 605 | (dotimes (i (length table)) | 605 | (obarray-clear table) |
| 606 | (aset table i 0)) | ||
| 607 | ;; Preserve the table's properties. | 606 | ;; Preserve the table's properties. |
| 608 | (cl-assert sym) | 607 | (cl-assert sym) |
| 609 | (let ((newsym (obarray-put table ""))) | 608 | (let ((newsym (obarray-put table ""))) |
| @@ -721,7 +720,7 @@ either a single abbrev table or a list of abbrev tables." | |||
| 721 | ;; to treat the distinction between a single table and a list of tables. | 720 | ;; to treat the distinction between a single table and a list of tables. |
| 722 | (cond | 721 | (cond |
| 723 | ((consp tables) tables) | 722 | ((consp tables) tables) |
| 724 | ((vectorp tables) (list tables)) | 723 | ((obarrayp tables) (list tables)) |
| 725 | (t | 724 | (t |
| 726 | (let ((tables (if (listp local-abbrev-table) | 725 | (let ((tables (if (listp local-abbrev-table) |
| 727 | (append local-abbrev-table | 726 | (append local-abbrev-table |
diff --git a/lisp/allout.el b/lisp/allout.el index a7121efb14a..e3fe8d08841 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -161,9 +161,9 @@ respective `allout-mode' keybinding variables, `allout-command-prefix', | |||
| 161 | (defcustom allout-command-prefix "\C-c " | 161 | (defcustom allout-command-prefix "\C-c " |
| 162 | "Key sequence to be used as prefix for outline mode command key bindings. | 162 | "Key sequence to be used as prefix for outline mode command key bindings. |
| 163 | 163 | ||
| 164 | Default is `\C-c<space>'; just `\C-c' is more short-and-sweet, if you're | 164 | Default is \\`C-c SPC'; just \\`C-c' is more short-and-sweet, if you're |
| 165 | willing to let allout use a bunch of \C-c keybindings." | 165 | willing to let allout use a bunch of \\`C-c' keybindings." |
| 166 | :type 'string | 166 | :type 'key-sequence |
| 167 | :group 'allout-keybindings | 167 | :group 'allout-keybindings |
| 168 | :set #'allout-compose-and-institute-keymap) | 168 | :set #'allout-compose-and-institute-keymap) |
| 169 | ;;;_ = allout-keybindings-binding | 169 | ;;;_ = allout-keybindings-binding |
diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 1f233f9f60f..5f5629d9cfc 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el | |||
| @@ -1985,7 +1985,7 @@ entries for git.gnus.org: | |||
| 1985 | 1985 | ||
| 1986 | 1986 | ||
| 1987 | (defun auth-source--decode-octal-string (string) | 1987 | (defun auth-source--decode-octal-string (string) |
| 1988 | "Convert octal STRING to utf-8 string. E.g: \"a\134b\" to \"a\b\"." | 1988 | "Convert octal STRING to utf-8 string. E.g.: \"a\\134b\" to \"a\\b\"." |
| 1989 | (let ((list (string-to-list string)) | 1989 | (let ((list (string-to-list string)) |
| 1990 | (size (length string))) | 1990 | (size (length string))) |
| 1991 | (decode-coding-string | 1991 | (decode-coding-string |
diff --git a/lisp/bind-key.el b/lisp/bind-key.el index 94a39f795cd..378ad69b2bc 100644 --- a/lisp/bind-key.el +++ b/lisp/bind-key.el | |||
| @@ -155,6 +155,7 @@ add keys to that keymap." | |||
| 155 | (add-to-list 'emulation-mode-map-alists | 155 | (add-to-list 'emulation-mode-map-alists |
| 156 | `((override-global-mode . ,override-global-map))) | 156 | `((override-global-mode . ,override-global-map))) |
| 157 | 157 | ||
| 158 | ;;;###autoload | ||
| 158 | (defvar personal-keybindings nil | 159 | (defvar personal-keybindings nil |
| 159 | "List of bindings performed by `bind-key'. | 160 | "List of bindings performed by `bind-key'. |
| 160 | 161 | ||
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 5796544c534..e13c3b56b4e 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el | |||
| @@ -100,6 +100,10 @@ as it is by default." | |||
| 100 | This is set by the prefix argument to `buffer-menu' and related | 100 | This is set by the prefix argument to `buffer-menu' and related |
| 101 | commands.") | 101 | commands.") |
| 102 | 102 | ||
| 103 | (defvar-local Buffer-menu-show-internal nil | ||
| 104 | "Non-nil if the current Buffer Menu lists internal buffers. | ||
| 105 | Internal buffers are those whose names start with a space.") | ||
| 106 | |||
| 103 | (defvar-local Buffer-menu-filter-predicate nil | 107 | (defvar-local Buffer-menu-filter-predicate nil |
| 104 | "Function to filter out buffers in the buffer list. | 108 | "Function to filter out buffers in the buffer list. |
| 105 | Buffers that don't satisfy the predicate will be skipped. | 109 | Buffers that don't satisfy the predicate will be skipped. |
| @@ -140,6 +144,7 @@ then the buffer will be displayed in the buffer list.") | |||
| 140 | "V" #'Buffer-menu-view | 144 | "V" #'Buffer-menu-view |
| 141 | "O" #'Buffer-menu-view-other-window | 145 | "O" #'Buffer-menu-view-other-window |
| 142 | "T" #'Buffer-menu-toggle-files-only | 146 | "T" #'Buffer-menu-toggle-files-only |
| 147 | "I" #'Buffer-menu-toggle-internal | ||
| 143 | "M-s a C-s" #'Buffer-menu-isearch-buffers | 148 | "M-s a C-s" #'Buffer-menu-isearch-buffers |
| 144 | "M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp | 149 | "M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp |
| 145 | "M-s a C-o" #'Buffer-menu-multi-occur | 150 | "M-s a C-o" #'Buffer-menu-multi-occur |
| @@ -197,6 +202,10 @@ then the buffer will be displayed in the buffer list.") | |||
| 197 | :help "Toggle whether the current buffer-menu displays only file buffers" | 202 | :help "Toggle whether the current buffer-menu displays only file buffers" |
| 198 | :style toggle | 203 | :style toggle |
| 199 | :selected Buffer-menu-files-only] | 204 | :selected Buffer-menu-files-only] |
| 205 | ["Show Internal Buffers" Buffer-menu-toggle-internal | ||
| 206 | :help "Toggle whether the current buffer-menu displays internal buffers" | ||
| 207 | :style toggle | ||
| 208 | :selected Buffer-menu-show-internal] | ||
| 200 | "---" | 209 | "---" |
| 201 | ["Refresh" revert-buffer | 210 | ["Refresh" revert-buffer |
| 202 | :help "Refresh the *Buffer List* buffer contents"] | 211 | :help "Refresh the *Buffer List* buffer contents"] |
| @@ -317,6 +326,11 @@ ARG, show only buffers that are visiting files." | |||
| 317 | (interactive "P") | 326 | (interactive "P") |
| 318 | (display-buffer (list-buffers-noselect arg))) | 327 | (display-buffer (list-buffers-noselect arg))) |
| 319 | 328 | ||
| 329 | (defun Buffer-menu--selection-message () | ||
| 330 | (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") | ||
| 331 | (Buffer-menu-show-internal "Showing all buffers.") | ||
| 332 | (t "Showing all buffers except internal ones.")))) | ||
| 333 | |||
| 320 | (defun Buffer-menu-toggle-files-only (arg) | 334 | (defun Buffer-menu-toggle-files-only (arg) |
| 321 | "Toggle whether the current `buffer-menu' displays only file buffers. | 335 | "Toggle whether the current `buffer-menu' displays only file buffers. |
| 322 | With a positive ARG, display only file buffers. With zero or | 336 | With a positive ARG, display only file buffers. With zero or |
| @@ -325,9 +339,18 @@ negative ARG, display other buffers as well." | |||
| 325 | (setq Buffer-menu-files-only | 339 | (setq Buffer-menu-files-only |
| 326 | (cond ((not arg) (not Buffer-menu-files-only)) | 340 | (cond ((not arg) (not Buffer-menu-files-only)) |
| 327 | ((> (prefix-numeric-value arg) 0) t))) | 341 | ((> (prefix-numeric-value arg) 0) t))) |
| 328 | (message (if Buffer-menu-files-only | 342 | (Buffer-menu--selection-message) |
| 329 | "Showing only file-visiting buffers." | 343 | (revert-buffer)) |
| 330 | "Showing all non-internal buffers.")) | 344 | |
| 345 | (defun Buffer-menu-toggle-internal (arg) | ||
| 346 | "Toggle whether the current `buffer-menu' displays internal buffers. | ||
| 347 | With a positive ARG, don't show internal buffers. With zero or | ||
| 348 | negative ARG, display internal buffers as well." | ||
| 349 | (interactive "P" Buffer-menu-mode) | ||
| 350 | (setq Buffer-menu-show-internal | ||
| 351 | (cond ((not arg) (not Buffer-menu-show-internal)) | ||
| 352 | ((> (prefix-numeric-value arg) 0) t))) | ||
| 353 | (Buffer-menu--selection-message) | ||
| 331 | (revert-buffer)) | 354 | (revert-buffer)) |
| 332 | 355 | ||
| 333 | (define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort | 356 | (define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort |
| @@ -569,13 +592,17 @@ If UNMARK is non-nil, unmark them." | |||
| 569 | (defun Buffer-menu-other-window () | 592 | (defun Buffer-menu-other-window () |
| 570 | "Select this line's buffer in other window, leaving buffer menu visible." | 593 | "Select this line's buffer in other window, leaving buffer menu visible." |
| 571 | (interactive nil Buffer-menu-mode) | 594 | (interactive nil Buffer-menu-mode) |
| 572 | (switch-to-buffer-other-window (Buffer-menu-buffer t))) | 595 | (let ((display-buffer-overriding-action |
| 596 | '(nil (inhibit-same-window . t)))) | ||
| 597 | (switch-to-buffer-other-window (Buffer-menu-buffer t)))) | ||
| 573 | 598 | ||
| 574 | (defun Buffer-menu-switch-other-window () | 599 | (defun Buffer-menu-switch-other-window () |
| 575 | "Make the other window select this line's buffer. | 600 | "Make the other window select this line's buffer. |
| 576 | The current window remains selected." | 601 | The current window remains selected." |
| 577 | (interactive nil Buffer-menu-mode) | 602 | (interactive nil Buffer-menu-mode) |
| 578 | (display-buffer (Buffer-menu-buffer t) t)) | 603 | (let ((display-buffer-overriding-action |
| 604 | '(nil (inhibit-same-window . t)))) | ||
| 605 | (display-buffer (Buffer-menu-buffer t) t))) | ||
| 579 | 606 | ||
| 580 | (defun Buffer-menu-2-window () | 607 | (defun Buffer-menu-2-window () |
| 581 | "Select this line's buffer, with previous buffer in second window." | 608 | "Select this line's buffer, with previous buffer in second window." |
| @@ -667,6 +694,7 @@ See more at `Buffer-menu-filter-predicate'." | |||
| 667 | (marked-buffers (Buffer-menu-marked-buffers)) | 694 | (marked-buffers (Buffer-menu-marked-buffers)) |
| 668 | (buffer-menu-buffer (current-buffer)) | 695 | (buffer-menu-buffer (current-buffer)) |
| 669 | (show-non-file (not Buffer-menu-files-only)) | 696 | (show-non-file (not Buffer-menu-files-only)) |
| 697 | (show-internal Buffer-menu-show-internal) | ||
| 670 | (filter-predicate (and (functionp Buffer-menu-filter-predicate) | 698 | (filter-predicate (and (functionp Buffer-menu-filter-predicate) |
| 671 | Buffer-menu-filter-predicate)) | 699 | Buffer-menu-filter-predicate)) |
| 672 | entries name-width) | 700 | entries name-width) |
| @@ -686,7 +714,8 @@ See more at `Buffer-menu-filter-predicate'." | |||
| 686 | (file buffer-file-name)) | 714 | (file buffer-file-name)) |
| 687 | (when (and (buffer-live-p buffer) | 715 | (when (and (buffer-live-p buffer) |
| 688 | (or buffer-list | 716 | (or buffer-list |
| 689 | (and (or (not (string= (substring name 0 1) " ")) | 717 | (and (or show-internal |
| 718 | (not (string= (substring name 0 1) " ")) | ||
| 690 | file) | 719 | file) |
| 691 | (not (eq buffer buffer-menu-buffer)) | 720 | (not (eq buffer buffer-menu-buffer)) |
| 692 | (or file show-non-file) | 721 | (or file show-non-file) |
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 28f14232704..9f11b9707bd 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; mode-local.el --- Support for mode local facilities -*- lexical-binding:t -*- | 1 | ;;; mode-local.el --- Support for mode local facilities -*- lexical-binding:t -*- |
| 2 | ;; | 2 | ;; |
| 3 | ;; Copyright (C) 2004-2005, 2007-2024 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2004-2024 Free Software Foundation, Inc. |
| 4 | ;; | 4 | ;; |
| 5 | ;; Author: David Ponce <david@dponce.com> | 5 | ;; Author: David Ponce <david@dponce.com> |
| 6 | ;; Created: 27 Apr 2004 | 6 | ;; Created: 27 Apr 2004 |
| @@ -84,7 +84,7 @@ MODES can be a symbol or a list of symbols. | |||
| 84 | FUNCTION does not have arguments." | 84 | FUNCTION does not have arguments." |
| 85 | (setq modes (ensure-list modes)) | 85 | (setq modes (ensure-list modes)) |
| 86 | (mode-local-map-file-buffers | 86 | (mode-local-map-file-buffers |
| 87 | function (lambda () (apply #'derived-mode-p modes)))) | 87 | function (lambda () (derived-mode-p modes)))) |
| 88 | 88 | ||
| 89 | ;;; Hook machinery | 89 | ;;; Hook machinery |
| 90 | ;; | 90 | ;; |
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index a4be5bf67e2..f63d316c1ac 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el | |||
| @@ -153,13 +153,13 @@ The search priority is: | |||
| 153 | "Return the dynamic macro map for the current buffer." | 153 | "Return the dynamic macro map for the current buffer." |
| 154 | (or semantic-lex-spp-dynamic-macro-symbol-obarray | 154 | (or semantic-lex-spp-dynamic-macro-symbol-obarray |
| 155 | (setq semantic-lex-spp-dynamic-macro-symbol-obarray | 155 | (setq semantic-lex-spp-dynamic-macro-symbol-obarray |
| 156 | (make-vector 13 0)))) | 156 | (obarray-make 13)))) |
| 157 | 157 | ||
| 158 | (defsubst semantic-lex-spp-dynamic-map-stack () | 158 | (defsubst semantic-lex-spp-dynamic-map-stack () |
| 159 | "Return the dynamic macro map for the current buffer." | 159 | "Return the dynamic macro map for the current buffer." |
| 160 | (or semantic-lex-spp-dynamic-macro-symbol-obarray-stack | 160 | (or semantic-lex-spp-dynamic-macro-symbol-obarray-stack |
| 161 | (setq semantic-lex-spp-dynamic-macro-symbol-obarray-stack | 161 | (setq semantic-lex-spp-dynamic-macro-symbol-obarray-stack |
| 162 | (make-vector 13 0)))) | 162 | (obarray-make 13)))) |
| 163 | 163 | ||
| 164 | (defun semantic-lex-spp-value-valid-p (value) | 164 | (defun semantic-lex-spp-value-valid-p (value) |
| 165 | "Return non-nil if VALUE is valid." | 165 | "Return non-nil if VALUE is valid." |
| @@ -260,7 +260,7 @@ NAME is the name of the spp macro symbol to define. | |||
| 260 | REPLACEMENT a string that would be substituted in for NAME." | 260 | REPLACEMENT a string that would be substituted in for NAME." |
| 261 | 261 | ||
| 262 | ;; Create the symbol hash table | 262 | ;; Create the symbol hash table |
| 263 | (let ((semantic-lex-spp-macro-symbol-obarray (make-vector 13 0)) | 263 | (let ((semantic-lex-spp-macro-symbol-obarray (obarray-make 13)) |
| 264 | spec) | 264 | spec) |
| 265 | ;; fill it with stuff | 265 | ;; fill it with stuff |
| 266 | (while specs | 266 | (while specs |
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index b32cb96bed9..f3d671ac312 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el | |||
| @@ -259,7 +259,7 @@ If optional argument PROPSPECS is non-nil, then interpret it, and | |||
| 259 | apply those properties. | 259 | apply those properties. |
| 260 | PROPSPECS must be a list of (NAME PROPERTY VALUE) elements." | 260 | PROPSPECS must be a list of (NAME PROPERTY VALUE) elements." |
| 261 | ;; Create the symbol hash table | 261 | ;; Create the symbol hash table |
| 262 | (let ((semantic-flex-keywords-obarray (make-vector 13 0)) | 262 | (let ((semantic-flex-keywords-obarray (obarray-make 13)) |
| 263 | spec) | 263 | spec) |
| 264 | ;; fill it with stuff | 264 | ;; fill it with stuff |
| 265 | (while specs | 265 | (while specs |
| @@ -416,7 +416,7 @@ If optional argument PROPSPECS is non-nil, then interpret it, and | |||
| 416 | apply those properties. | 416 | apply those properties. |
| 417 | PROPSPECS must be a list of (TYPE PROPERTY VALUE)." | 417 | PROPSPECS must be a list of (TYPE PROPERTY VALUE)." |
| 418 | ;; Create the symbol hash table | 418 | ;; Create the symbol hash table |
| 419 | (let* ((semantic-lex-types-obarray (make-vector 13 0)) | 419 | (let* ((semantic-lex-types-obarray (obarray-make 13)) |
| 420 | spec type tokens token alist default) | 420 | spec type tokens token alist default) |
| 421 | ;; fill it with stuff | 421 | ;; fill it with stuff |
| 422 | (while specs | 422 | (while specs |
diff --git a/lisp/comint.el b/lisp/comint.el index 0a9cdb44bef..655ff30469c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el | |||
| @@ -254,7 +254,7 @@ This variable is buffer-local." | |||
| 254 | See also `comint-read-input-ring' and `comint-write-input-ring'. | 254 | See also `comint-read-input-ring' and `comint-write-input-ring'. |
| 255 | `comint-mode' makes this a buffer-local variable. You probably want | 255 | `comint-mode' makes this a buffer-local variable. You probably want |
| 256 | to set this in a mode hook, rather than customize the default value." | 256 | to set this in a mode hook, rather than customize the default value." |
| 257 | :type '(choice (const :tag "nil" nil) | 257 | :type '(choice (const :tag "Disable input history" nil) |
| 258 | file) | 258 | file) |
| 259 | :group 'comint) | 259 | :group 'comint) |
| 260 | 260 | ||
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 6fd60f3c416..e827da43a08 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el | |||
| @@ -302,21 +302,21 @@ point, otherwise hide it." | |||
| 302 | ;; never display a stale preview and that the preview doesn't | 302 | ;; never display a stale preview and that the preview doesn't |
| 303 | ;; flicker, even with slow completion backends. | 303 | ;; flicker, even with slow completion backends. |
| 304 | (let* ((beg (completion-preview--get 'completion-preview-beg)) | 304 | (let* ((beg (completion-preview--get 'completion-preview-beg)) |
| 305 | (end (max (point) (overlay-start completion-preview--overlay))) | ||
| 305 | (cands (completion-preview--get 'completion-preview-cands)) | 306 | (cands (completion-preview--get 'completion-preview-cands)) |
| 306 | (index (completion-preview--get 'completion-preview-index)) | 307 | (index (completion-preview--get 'completion-preview-index)) |
| 307 | (cand (nth index cands)) | 308 | (cand (nth index cands)) |
| 308 | (len (length cand)) | 309 | (after (completion-preview--get 'after-string)) |
| 309 | (end (+ beg len)) | 310 | (face (get-text-property 0 'face after))) |
| 310 | (cur (point)) | 311 | (if (and (<= beg (point) end (1- (+ beg (length cand)))) |
| 311 | (face (get-text-property 0 'face (completion-preview--get 'after-string)))) | 312 | (string-prefix-p (buffer-substring beg end) cand)) |
| 312 | (if (and (< beg cur end) (string-prefix-p (buffer-substring beg cur) cand)) | ||
| 313 | ;; The previous preview is still applicable, update it. | 313 | ;; The previous preview is still applicable, update it. |
| 314 | (overlay-put (completion-preview--make-overlay | 314 | (overlay-put (completion-preview--make-overlay |
| 315 | cur (propertize (substring cand (- cur beg)) | 315 | end (propertize (substring cand (- end beg)) |
| 316 | 'face face | 316 | 'face face |
| 317 | 'mouse-face 'completion-preview-highlight | 317 | 'mouse-face 'completion-preview-highlight |
| 318 | 'keymap completion-preview--mouse-map)) | 318 | 'keymap completion-preview--mouse-map)) |
| 319 | 'completion-preview-end cur) | 319 | 'completion-preview-end end) |
| 320 | ;; The previous preview is no longer applicable, hide it. | 320 | ;; The previous preview is no longer applicable, hide it. |
| 321 | (completion-preview-active-mode -1)))) | 321 | (completion-preview-active-mode -1)))) |
| 322 | ;; Run `completion-at-point-functions' to get a new candidate. | 322 | ;; Run `completion-at-point-functions' to get a new candidate. |
| @@ -366,16 +366,16 @@ prefix argument and defaults to 1." | |||
| 366 | (interactive "p") | 366 | (interactive "p") |
| 367 | (when completion-preview-active-mode | 367 | (when completion-preview-active-mode |
| 368 | (let* ((beg (completion-preview--get 'completion-preview-beg)) | 368 | (let* ((beg (completion-preview--get 'completion-preview-beg)) |
| 369 | (end (completion-preview--get 'completion-preview-end)) | ||
| 369 | (all (completion-preview--get 'completion-preview-cands)) | 370 | (all (completion-preview--get 'completion-preview-cands)) |
| 370 | (cur (completion-preview--get 'completion-preview-index)) | 371 | (cur (completion-preview--get 'completion-preview-index)) |
| 371 | (len (length all)) | 372 | (len (length all)) |
| 372 | (new (mod (+ cur direction) len)) | 373 | (new (mod (+ cur direction) len)) |
| 373 | (str (nth new all)) | 374 | (str (nth new all))) |
| 374 | (pos (point))) | 375 | (while (or (<= (+ beg (length str)) end) |
| 375 | (while (or (<= (+ beg (length str)) pos) | 376 | (not (string-prefix-p (buffer-substring beg end) str))) |
| 376 | (not (string-prefix-p (buffer-substring beg pos) str))) | ||
| 377 | (setq new (mod (+ new direction) len) str (nth new all))) | 377 | (setq new (mod (+ new direction) len) str (nth new all))) |
| 378 | (let ((aft (propertize (substring str (- pos beg)) | 378 | (let ((aft (propertize (substring str (- end beg)) |
| 379 | 'face (if (< 1 len) | 379 | 'face (if (< 1 len) |
| 380 | 'completion-preview | 380 | 'completion-preview |
| 381 | 'completion-preview-exact) | 381 | 'completion-preview-exact) |
diff --git a/lisp/completion.el b/lisp/completion.el index ab7f2a7bc52..6c758e56eab 100644 --- a/lisp/completion.el +++ b/lisp/completion.el | |||
| @@ -875,11 +875,11 @@ This is sensitive to `case-fold-search'." | |||
| 875 | ;; GNU implements obarrays | 875 | ;; GNU implements obarrays |
| 876 | (defconst cmpl-obarray-length 511) | 876 | (defconst cmpl-obarray-length 511) |
| 877 | 877 | ||
| 878 | (defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0) | 878 | (defvar cmpl-prefix-obarray (obarray-make cmpl-obarray-length) |
| 879 | "An obarray used to store the downcased completion prefixes. | 879 | "An obarray used to store the downcased completion prefixes. |
| 880 | Each symbol is bound to a list of completion entries.") | 880 | Each symbol is bound to a list of completion entries.") |
| 881 | 881 | ||
| 882 | (defvar cmpl-obarray (make-vector cmpl-obarray-length 0) | 882 | (defvar cmpl-obarray (obarray-make cmpl-obarray-length) |
| 883 | "An obarray used to store the downcased completions. | 883 | "An obarray used to store the downcased completions. |
| 884 | Each symbol is bound to a single completion entry.") | 884 | Each symbol is bound to a single completion entry.") |
| 885 | 885 | ||
| @@ -962,8 +962,8 @@ Each symbol is bound to a single completion entry.") | |||
| 962 | (defun clear-all-completions () | 962 | (defun clear-all-completions () |
| 963 | "Initialize the completion storage. All existing completions are lost." | 963 | "Initialize the completion storage. All existing completions are lost." |
| 964 | (interactive) | 964 | (interactive) |
| 965 | (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)) | 965 | (setq cmpl-prefix-obarray (obarray-make cmpl-obarray-length)) |
| 966 | (setq cmpl-obarray (make-vector cmpl-obarray-length 0))) | 966 | (setq cmpl-obarray (obarray-make cmpl-obarray-length))) |
| 967 | 967 | ||
| 968 | (defun list-all-completions () | 968 | (defun list-all-completions () |
| 969 | "Return a list of all the known completion entries." | 969 | "Return a list of all the known completion entries." |
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 38b6ec984ab..8fad51dc116 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -1228,6 +1228,41 @@ If OTHER-WINDOW is non-nil, display in another window." | |||
| 1228 | (message "`%s' is an alias for `%s'" symbol basevar)))) | 1228 | (message "`%s' is an alias for `%s'" symbol basevar)))) |
| 1229 | 1229 | ||
| 1230 | ;;;###autoload | 1230 | ;;;###autoload |
| 1231 | (defun customize-toggle-option (symbol) | ||
| 1232 | "Toggle the value of boolean option SYMBOL for this session." | ||
| 1233 | (interactive (let ((prompt "Toggle boolean option: ") opts) | ||
| 1234 | (mapatoms | ||
| 1235 | (lambda (sym) | ||
| 1236 | (when (eq (get sym 'custom-type) 'boolean) | ||
| 1237 | (push sym opts)))) | ||
| 1238 | (list (intern (completing-read prompt opts nil nil nil nil | ||
| 1239 | (symbol-at-point)))))) | ||
| 1240 | (let* ((setter (or (get symbol 'custom-set) #'set-default)) | ||
| 1241 | (getter (or (get symbol 'custom-get) #'symbol-value)) | ||
| 1242 | (value (condition-case nil | ||
| 1243 | (funcall getter symbol) | ||
| 1244 | (void-variable (error "`%s' is not bound" symbol)))) | ||
| 1245 | (type (get symbol 'custom-type))) | ||
| 1246 | (cond | ||
| 1247 | ((eq type 'boolean)) | ||
| 1248 | ((and (null type) | ||
| 1249 | (yes-or-no-p | ||
| 1250 | (format "`%s' doesn't have a type, and has the value %S. \ | ||
| 1251 | Proceed to toggle?" symbol value)))) | ||
| 1252 | ((yes-or-no-p | ||
| 1253 | (format "`%s' is of type %s, and has the value %S. \ | ||
| 1254 | Proceed to toggle?" | ||
| 1255 | symbol type value))) | ||
| 1256 | ((error "Abort toggling of option `%s'" symbol))) | ||
| 1257 | (message "%s user options `%s'." | ||
| 1258 | (if (funcall setter symbol (not value)) | ||
| 1259 | "Enabled" "Disabled") | ||
| 1260 | symbol))) | ||
| 1261 | |||
| 1262 | ;;;###autoload | ||
| 1263 | (defalias 'toggle-option #'customize-toggle-option) | ||
| 1264 | |||
| 1265 | ;;;###autoload | ||
| 1231 | (defalias 'customize-variable-other-window 'customize-option-other-window) | 1266 | (defalias 'customize-variable-other-window 'customize-option-other-window) |
| 1232 | 1267 | ||
| 1233 | ;;;###autoload | 1268 | ;;;###autoload |
diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 0c8b6b0b97c..47afa841f5e 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el | |||
| @@ -32,7 +32,7 @@ | |||
| 32 | (defun custom-declare-face (face spec doc &rest args) | 32 | (defun custom-declare-face (face spec doc &rest args) |
| 33 | "Like `defface', but with FACE evaluated as a normal argument." | 33 | "Like `defface', but with FACE evaluated as a normal argument." |
| 34 | (when (and doc | 34 | (when (and doc |
| 35 | (not (stringp doc))) | 35 | (not (documentation-stringp doc))) |
| 36 | (error "Invalid (or missing) doc string %S" doc)) | 36 | (error "Invalid (or missing) doc string %S" doc)) |
| 37 | (unless (get face 'face-defface-spec) | 37 | (unless (get face 'face-defface-spec) |
| 38 | (face-spec-set face (purecopy spec) 'face-defface-spec) | 38 | (face-spec-set face (purecopy spec) 'face-defface-spec) |
diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 7e0b64e9067..3fe62c8d0da 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el | |||
| @@ -371,6 +371,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of | |||
| 371 | (auto-save-timeout auto-save (choice (const :tag "off" nil) | 371 | (auto-save-timeout auto-save (choice (const :tag "off" nil) |
| 372 | (integer :format "%v"))) | 372 | (integer :format "%v"))) |
| 373 | (echo-keystrokes minibuffer number) | 373 | (echo-keystrokes minibuffer number) |
| 374 | (echo-keystrokes-help minibuffer boolean "30.1") | ||
| 374 | (polling-period keyboard float) | 375 | (polling-period keyboard float) |
| 375 | (double-click-time mouse (restricted-sexp | 376 | (double-click-time mouse (restricted-sexp |
| 376 | :match-alternatives (integerp 'nil 't))) | 377 | :match-alternatives (integerp 'nil 't))) |
diff --git a/lisp/desktop.el b/lisp/desktop.el index e3994ceb83c..3fa09ce6a41 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el | |||
| @@ -163,10 +163,19 @@ Used at desktop read to provide backward compatibility.") | |||
| 163 | (define-minor-mode desktop-save-mode | 163 | (define-minor-mode desktop-save-mode |
| 164 | "Toggle desktop saving (Desktop Save mode). | 164 | "Toggle desktop saving (Desktop Save mode). |
| 165 | 165 | ||
| 166 | When Desktop Save mode is enabled, the state of Emacs is saved from | 166 | When Desktop Save mode is enabled, the state of Emacs is saved from one |
| 167 | one session to another. In particular, Emacs will save the desktop when | 167 | session to another. The saved Emacs \"desktop configuration\" includes the |
| 168 | it exits (this may prompt you; see the option `desktop-save'). The next | 168 | buffers, their file names, major modes, buffer positions, window and frame |
| 169 | time Emacs starts, if this mode is active it will restore the desktop. | 169 | configuration, and some important global variables. |
| 170 | |||
| 171 | To enable this feature for future sessions, customize `desktop-save-mode' | ||
| 172 | to t, or add this line in your init file: | ||
| 173 | |||
| 174 | (desktop-save-mode 1) | ||
| 175 | |||
| 176 | When this mode is enabled, Emacs will save the desktop when it exits | ||
| 177 | (this may prompt you, see the option `desktop-save'). The next time | ||
| 178 | Emacs starts, if this mode is active it will restore the desktop. | ||
| 170 | 179 | ||
| 171 | To manually save the desktop at any time, use the command \\[desktop-save]. | 180 | To manually save the desktop at any time, use the command \\[desktop-save]. |
| 172 | To load it, use \\[desktop-read]. | 181 | To load it, use \\[desktop-read]. |
diff --git a/lisp/dired.el b/lisp/dired.el index cef93ab757c..9e3b888df14 100644 --- a/lisp/dired.el +++ b/lisp/dired.el | |||
| @@ -4321,6 +4321,11 @@ this subdir." | |||
| 4321 | (prefix-numeric-value arg) | 4321 | (prefix-numeric-value arg) |
| 4322 | (lambda () | 4322 | (lambda () |
| 4323 | (when (or (not (looking-at-p dired-re-dot)) | 4323 | (when (or (not (looking-at-p dired-re-dot)) |
| 4324 | ;; Don't skip symlinks to ".", "..", etc. | ||
| 4325 | (save-excursion | ||
| 4326 | (re-search-forward | ||
| 4327 | dired-permission-flags-regexp nil t) | ||
| 4328 | (eq (char-after (match-beginning 1)) ?l)) | ||
| 4324 | (not (equal dired-marker-char dired-del-marker))) | 4329 | (not (equal dired-marker-char dired-del-marker))) |
| 4325 | (delete-char 1) | 4330 | (delete-char 1) |
| 4326 | (insert dired-marker-char)))))))) | 4331 | (insert dired-marker-char)))))))) |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ea9298c6646..c3355eedd75 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -231,17 +231,8 @@ This includes variable references and calls to functions such as `car'." | |||
| 231 | :type 'boolean) | 231 | :type 'boolean) |
| 232 | 232 | ||
| 233 | (defvar byte-compile-dynamic nil | 233 | (defvar byte-compile-dynamic nil |
| 234 | "If non-nil, compile function bodies so they load lazily. | 234 | "Formerly used to compile function bodies so they load lazily. |
| 235 | They are hidden in comments in the compiled file, | 235 | This variable no longer has any effect.") |
| 236 | and each one is brought into core when the | ||
| 237 | function is called. | ||
| 238 | |||
| 239 | To enable this option, make it a file-local variable | ||
| 240 | in the source file you want it to apply to. | ||
| 241 | For example, add -*-byte-compile-dynamic: t;-*- on the first line. | ||
| 242 | |||
| 243 | When this option is true, if you load the compiled file and then move it, | ||
| 244 | the functions you loaded will not be able to run.") | ||
| 245 | (make-obsolete-variable 'byte-compile-dynamic "not worthwhile any more." "27.1") | 236 | (make-obsolete-variable 'byte-compile-dynamic "not worthwhile any more." "27.1") |
| 246 | ;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp) | 237 | ;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp) |
| 247 | 238 | ||
| @@ -294,6 +285,7 @@ The information is logged to `byte-compile-log-buffer'." | |||
| 294 | (defconst byte-compile-warning-types | 285 | (defconst byte-compile-warning-types |
| 295 | '( callargs constants | 286 | '( callargs constants |
| 296 | docstrings docstrings-non-ascii-quotes docstrings-wide | 287 | docstrings docstrings-non-ascii-quotes docstrings-wide |
| 288 | docstrings-control-chars | ||
| 297 | empty-body free-vars ignored-return-value interactive-only | 289 | empty-body free-vars ignored-return-value interactive-only |
| 298 | lexical lexical-dynamic make-local | 290 | lexical lexical-dynamic make-local |
| 299 | mapcar ; obsolete | 291 | mapcar ; obsolete |
| @@ -316,6 +308,8 @@ Elements of the list may be: | |||
| 316 | docstrings that are too wide, containing lines longer than both | 308 | docstrings that are too wide, containing lines longer than both |
| 317 | `byte-compile-docstring-max-column' and `fill-column' characters. | 309 | `byte-compile-docstring-max-column' and `fill-column' characters. |
| 318 | Only enabled when `docstrings' also is. | 310 | Only enabled when `docstrings' also is. |
| 311 | docstrings-control-chars | ||
| 312 | docstrings that contain control characters other than NL and TAB | ||
| 319 | empty-body body argument to a special form or macro is empty. | 313 | empty-body body argument to a special form or macro is empty. |
| 320 | free-vars references to variables not in the current lexical scope. | 314 | free-vars references to variables not in the current lexical scope. |
| 321 | ignored-return-value | 315 | ignored-return-value |
| @@ -354,7 +348,7 @@ A value of `all' really means all." | |||
| 354 | '(docstrings-non-ascii-quotes) | 348 | '(docstrings-non-ascii-quotes) |
| 355 | "List of warning types that are only enabled during Emacs builds. | 349 | "List of warning types that are only enabled during Emacs builds. |
| 356 | This is typically either warning types that are being phased in | 350 | This is typically either warning types that are being phased in |
| 357 | (but shouldn't be enabled for packages yet), or that are only relevant | 351 | \(but shouldn't be enabled for packages yet), or that are only relevant |
| 358 | for the Emacs build itself.") | 352 | for the Emacs build itself.") |
| 359 | 353 | ||
| 360 | (defvar byte-compile--suppressed-warnings nil | 354 | (defvar byte-compile--suppressed-warnings nil |
| @@ -1749,68 +1743,100 @@ Also ignore URLs." | |||
| 1749 | The byte-compiler will emit a warning for documentation strings | 1743 | The byte-compiler will emit a warning for documentation strings |
| 1750 | containing lines wider than this. If `fill-column' has a larger | 1744 | containing lines wider than this. If `fill-column' has a larger |
| 1751 | value, it will override this variable." | 1745 | value, it will override this variable." |
| 1752 | :group 'bytecomp | ||
| 1753 | :type 'natnum | 1746 | :type 'natnum |
| 1754 | :safe #'natnump | 1747 | :safe #'natnump |
| 1755 | :version "28.1") | 1748 | :version "28.1") |
| 1756 | 1749 | ||
| 1757 | (define-obsolete-function-alias 'byte-compile-docstring-length-warn | 1750 | (defun byte-compile--list-with-n (list n elem) |
| 1758 | 'byte-compile-docstring-style-warn "29.1") | 1751 | "Return LIST with its Nth element replaced by ELEM." |
| 1759 | 1752 | (if (eq elem (nth n list)) | |
| 1760 | (defun byte-compile-docstring-style-warn (form) | 1753 | list |
| 1761 | "Warn if there are stylistic problems with the docstring in FORM. | 1754 | (nconc (take n list) |
| 1762 | Warn if documentation string of FORM is too wide. | 1755 | (list elem) |
| 1756 | (nthcdr (1+ n) list)))) | ||
| 1757 | |||
| 1758 | (defun byte-compile--docstring-style-warn (docs kind name) | ||
| 1759 | "Warn if there are stylistic problems in the docstring DOCS. | ||
| 1760 | Warn if documentation string is too wide. | ||
| 1763 | It is too wide if it has any lines longer than the largest of | 1761 | It is too wide if it has any lines longer than the largest of |
| 1764 | `fill-column' and `byte-compile-docstring-max-column'." | 1762 | `fill-column' and `byte-compile-docstring-max-column'." |
| 1765 | (when (byte-compile-warning-enabled-p 'docstrings) | 1763 | (when (byte-compile-warning-enabled-p 'docstrings) |
| 1766 | (let* ((kind nil) (name nil) (docs nil) | 1764 | (let* ((name (if (eq (car-safe name) 'quote) (cadr name) name)) |
| 1767 | (prefix (lambda () | 1765 | (prefix (lambda () |
| 1768 | (format "%s%s" | 1766 | (format "%s%s" |
| 1769 | kind | 1767 | kind |
| 1770 | (if name (format-message " `%s' " name) ""))))) | 1768 | (if name (format-message " `%S' " name) ""))))) |
| 1771 | (pcase (car form) | 1769 | (let ((col (max byte-compile-docstring-max-column fill-column))) |
| 1772 | ((or 'autoload 'custom-declare-variable 'defalias | 1770 | (when (and (byte-compile-warning-enabled-p 'docstrings-wide) |
| 1773 | 'defconst 'define-abbrev-table | 1771 | (byte-compile--wide-docstring-p docs col)) |
| 1774 | 'defvar 'defvaralias | 1772 | (byte-compile-warn-x |
| 1775 | 'custom-declare-face) | 1773 | name |
| 1776 | (setq kind (nth 0 form)) | 1774 | "%sdocstring wider than %s characters" (funcall prefix) col))) |
| 1777 | (setq name (nth 1 form)) | 1775 | |
| 1778 | (when (and (consp name) (eq (car name) 'quote)) | 1776 | (when (byte-compile-warning-enabled-p 'docstrings-control-chars) |
| 1779 | (setq name (cadr name))) | 1777 | (let ((start 0) |
| 1780 | (setq docs (nth 3 form))) | 1778 | (len (length docs))) |
| 1781 | ('lambda | 1779 | (while (and (< start len) |
| 1782 | (setq kind "") ; can't be "function", unfortunately | 1780 | (string-match (rx (intersection (in (0 . 31) 127) |
| 1783 | (setq docs (nth 2 form)))) | 1781 | (not (in "\n\t")))) |
| 1784 | (when (and kind docs (stringp docs)) | 1782 | docs start)) |
| 1785 | (let ((col (max byte-compile-docstring-max-column fill-column))) | 1783 | (let* ((ofs (match-beginning 0)) |
| 1786 | (when (and (byte-compile-warning-enabled-p 'docstrings-wide) | 1784 | (c (aref docs ofs))) |
| 1787 | (byte-compile--wide-docstring-p docs col)) | 1785 | ;; FIXME: it should be possible to use the exact source position |
| 1788 | (byte-compile-warn-x | 1786 | ;; of the control char in most cases, and it would be helpful |
| 1789 | name | 1787 | (byte-compile-warn-x |
| 1790 | "%sdocstring wider than %s characters" (funcall prefix) col))) | 1788 | name |
| 1791 | ;; There's a "naked" ' character before a symbol/list, so it | 1789 | "%sdocstring contains control char #x%02x (position %d)" |
| 1792 | ;; should probably be quoted with \=. | 1790 | (funcall prefix) c ofs) |
| 1793 | (when (string-match-p (rx (| (in " \t") bol) | 1791 | (setq start (1+ ofs)))))) |
| 1794 | (? (in "\"#")) | 1792 | |
| 1795 | "'" | 1793 | ;; There's a "naked" ' character before a symbol/list, so it |
| 1796 | (in "A-Za-z" "(")) | 1794 | ;; should probably be quoted with \=. |
| 1795 | (when (string-match-p (rx (| (in " \t") bol) | ||
| 1796 | (? (in "\"#")) | ||
| 1797 | "'" | ||
| 1798 | (in "A-Za-z" "(")) | ||
| 1799 | docs) | ||
| 1800 | (byte-compile-warn-x | ||
| 1801 | name | ||
| 1802 | (concat "%sdocstring has wrong usage of unescaped single quotes" | ||
| 1803 | " (use \\=%c or different quoting such as %c...%c)") | ||
| 1804 | (funcall prefix) ?' ?` ?')) | ||
| 1805 | ;; There's a "Unicode quote" in the string -- it should probably | ||
| 1806 | ;; be an ASCII one instead. | ||
| 1807 | (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) | ||
| 1808 | (when (string-match-p (rx (| " \"" (in " \t") bol) | ||
| 1809 | (in "‘’")) | ||
| 1797 | docs) | 1810 | docs) |
| 1798 | (byte-compile-warn-x | 1811 | (byte-compile-warn-x |
| 1799 | name | 1812 | name |
| 1800 | (concat "%sdocstring has wrong usage of unescaped single quotes" | 1813 | "%sdocstring uses curved single quotes; use %s instead of ‘...’" |
| 1801 | " (use \\=%c or different quoting such as %c...%c)") | 1814 | (funcall prefix) "`...'")))))) |
| 1802 | (funcall prefix) ?' ?` ?')) | 1815 | |
| 1803 | ;; There's a "Unicode quote" in the string -- it should probably | 1816 | (defvar byte-compile--\#$) ; Special value that will print as `#$'. |
| 1804 | ;; be an ASCII one instead. | 1817 | (defvar byte-compile--docstrings nil "Table of already compiled docstrings.") |
| 1805 | (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) | 1818 | |
| 1806 | (when (string-match-p (rx (| " \"" (in " \t") bol) | 1819 | (defun byte-compile--docstring (doc kind name &optional is-a-value) |
| 1807 | (in "‘’")) | 1820 | (byte-compile--docstring-style-warn doc kind name) |
| 1808 | docs) | 1821 | ;; Make docstrings dynamic, when applicable. |
| 1809 | (byte-compile-warn-x | 1822 | (cond |
| 1810 | name | 1823 | ((and byte-compile-dynamic-docstrings |
| 1811 | "%sdocstring uses curved single quotes; use %s instead of ‘...’" | 1824 | ;; The native compiler doesn't use those dynamic docstrings. |
| 1812 | (funcall prefix) "`...'")))))) | 1825 | (not byte-native-compiling) |
| 1813 | form) | 1826 | ;; Docstrings can only be dynamic when compiling a file. |
| 1827 | byte-compile--\#$) | ||
| 1828 | (let* ((byte-pos (with-memoization | ||
| 1829 | ;; Reuse a previously written identical docstring. | ||
| 1830 | ;; This is not done out of thriftiness but to try and | ||
| 1831 | ;; make sure that "equal" functions remain `equal'. | ||
| 1832 | ;; (Often those identical docstrings come from | ||
| 1833 | ;; `help-add-fundoc-usage'). | ||
| 1834 | ;; Needed e.g. for `advice-tests-nadvice'. | ||
| 1835 | (gethash doc byte-compile--docstrings) | ||
| 1836 | (byte-compile-output-as-comment doc nil))) | ||
| 1837 | (newdoc (cons byte-compile--\#$ byte-pos))) | ||
| 1838 | (if is-a-value newdoc (macroexp-quote newdoc)))) | ||
| 1839 | (t doc))) | ||
| 1814 | 1840 | ||
| 1815 | ;; If we have compiled any calls to functions which are not known to be | 1841 | ;; If we have compiled any calls to functions which are not known to be |
| 1816 | ;; defined, issue a warning enumerating them. | 1842 | ;; defined, issue a warning enumerating them. |
| @@ -1845,6 +1871,8 @@ It is too wide if it has any lines longer than the largest of | |||
| 1845 | ;; macroenvironment. | 1871 | ;; macroenvironment. |
| 1846 | (copy-alist byte-compile-initial-macro-environment)) | 1872 | (copy-alist byte-compile-initial-macro-environment)) |
| 1847 | (byte-compile--outbuffer nil) | 1873 | (byte-compile--outbuffer nil) |
| 1874 | (byte-compile--\#$ nil) | ||
| 1875 | (byte-compile--docstrings (make-hash-table :test 'equal)) | ||
| 1848 | (overriding-plist-environment nil) | 1876 | (overriding-plist-environment nil) |
| 1849 | (byte-compile-function-environment nil) | 1877 | (byte-compile-function-environment nil) |
| 1850 | (byte-compile-bound-variables nil) | 1878 | (byte-compile-bound-variables nil) |
| @@ -1858,7 +1886,6 @@ It is too wide if it has any lines longer than the largest of | |||
| 1858 | ;; | 1886 | ;; |
| 1859 | (byte-compile-verbose byte-compile-verbose) | 1887 | (byte-compile-verbose byte-compile-verbose) |
| 1860 | (byte-optimize byte-optimize) | 1888 | (byte-optimize byte-optimize) |
| 1861 | (byte-compile-dynamic byte-compile-dynamic) | ||
| 1862 | (byte-compile-dynamic-docstrings | 1889 | (byte-compile-dynamic-docstrings |
| 1863 | byte-compile-dynamic-docstrings) | 1890 | byte-compile-dynamic-docstrings) |
| 1864 | (byte-compile-warnings byte-compile-warnings) | 1891 | (byte-compile-warnings byte-compile-warnings) |
| @@ -2373,7 +2400,12 @@ With argument ARG, insert value in current buffer after the form." | |||
| 2373 | (setq case-fold-search nil)) | 2400 | (setq case-fold-search nil)) |
| 2374 | (displaying-byte-compile-warnings | 2401 | (displaying-byte-compile-warnings |
| 2375 | (with-current-buffer inbuffer | 2402 | (with-current-buffer inbuffer |
| 2376 | (when byte-compile-current-file | 2403 | (when byte-compile-dest-file |
| 2404 | (setq byte-compile--\#$ | ||
| 2405 | (copy-sequence ;It needs to be a fresh new object. | ||
| 2406 | ;; Also it stands for the `load-file-name' when the `.elc' will | ||
| 2407 | ;; be loaded, so make it look like it. | ||
| 2408 | byte-compile-dest-file)) | ||
| 2377 | (byte-compile-insert-header byte-compile-current-file | 2409 | (byte-compile-insert-header byte-compile-current-file |
| 2378 | byte-compile--outbuffer) | 2410 | byte-compile--outbuffer) |
| 2379 | ;; Instruct native-comp to ignore this file. | 2411 | ;; Instruct native-comp to ignore this file. |
| @@ -2428,8 +2460,7 @@ With argument ARG, insert value in current buffer after the form." | |||
| 2428 | (defun byte-compile-insert-header (_filename outbuffer) | 2460 | (defun byte-compile-insert-header (_filename outbuffer) |
| 2429 | "Insert a header at the start of OUTBUFFER. | 2461 | "Insert a header at the start of OUTBUFFER. |
| 2430 | Call from the source buffer." | 2462 | Call from the source buffer." |
| 2431 | (let ((dynamic byte-compile-dynamic) | 2463 | (let ((optimize byte-optimize)) |
| 2432 | (optimize byte-optimize)) | ||
| 2433 | (with-current-buffer outbuffer | 2464 | (with-current-buffer outbuffer |
| 2434 | (goto-char (point-min)) | 2465 | (goto-char (point-min)) |
| 2435 | ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After | 2466 | ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After |
| @@ -2463,18 +2494,11 @@ Call from the source buffer." | |||
| 2463 | ((eq optimize 'byte) " byte-level optimization only") | 2494 | ((eq optimize 'byte) " byte-level optimization only") |
| 2464 | (optimize " all optimizations") | 2495 | (optimize " all optimizations") |
| 2465 | (t "out optimization")) | 2496 | (t "out optimization")) |
| 2466 | ".\n" | 2497 | ".\n\n\n")))) |
| 2467 | (if dynamic ";;; Function definitions are lazy-loaded.\n" | ||
| 2468 | "") | ||
| 2469 | "\n\n")))) | ||
| 2470 | 2498 | ||
| 2471 | (defun byte-compile-output-file-form (form) | 2499 | (defun byte-compile-output-file-form (form) |
| 2472 | ;; Write the given form to the output buffer, being careful of docstrings | 2500 | ;; Write the given form to the output buffer, being careful of docstrings |
| 2473 | ;; (for `byte-compile-dynamic-docstrings') in defvar, defvaralias, | 2501 | ;; (for `byte-compile-dynamic-docstrings'). |
| 2474 | ;; defconst, autoload, and custom-declare-variable. | ||
| 2475 | ;; defalias calls are output directly by byte-compile-file-form-defmumble; | ||
| 2476 | ;; it does not pay to first build the defalias in defmumble and then parse | ||
| 2477 | ;; it here. | ||
| 2478 | (when byte-native-compiling | 2502 | (when byte-native-compiling |
| 2479 | ;; Spill output for the native compiler here | 2503 | ;; Spill output for the native compiler here |
| 2480 | (push (make-byte-to-native-top-level :form form :lexical lexical-binding) | 2504 | (push (make-byte-to-native-top-level :form form :lexical lexical-binding) |
| @@ -2484,153 +2508,17 @@ Call from the source buffer." | |||
| 2484 | (print-level nil) | 2508 | (print-level nil) |
| 2485 | (print-quoted t) | 2509 | (print-quoted t) |
| 2486 | (print-gensym t) | 2510 | (print-gensym t) |
| 2487 | (print-circle t)) ; Handle circular data structures. | 2511 | (print-circle t) |
| 2488 | (if (memq (car-safe form) '(defvar defvaralias defconst | 2512 | (print-continuous-numbering t) |
| 2489 | autoload custom-declare-variable)) | 2513 | (print-number-table (make-hash-table :test #'eq))) |
| 2490 | (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 nil | 2514 | (when byte-compile--\#$ |
| 2491 | (memq (car form) | 2515 | (puthash byte-compile--\#$ "#$" print-number-table)) |
| 2492 | '(defvaralias autoload | 2516 | (princ "\n" byte-compile--outbuffer) |
| 2493 | custom-declare-variable))) | 2517 | (prin1 form byte-compile--outbuffer) |
| 2494 | (princ "\n" byte-compile--outbuffer) | 2518 | nil)) |
| 2495 | (prin1 form byte-compile--outbuffer) | ||
| 2496 | nil))) | ||
| 2497 | 2519 | ||
| 2498 | (defvar byte-compile--for-effect) | 2520 | (defvar byte-compile--for-effect) |
| 2499 | 2521 | ||
| 2500 | (defun byte-compile--output-docform-recurse | ||
| 2501 | (info position form cvecindex docindex specindex quoted) | ||
| 2502 | "Print a form with a doc string. INFO is (prefix postfix). | ||
| 2503 | POSITION is where the next doc string is to be inserted. | ||
| 2504 | CVECINDEX is the index in the FORM of the constant vector, or nil. | ||
| 2505 | DOCINDEX is the index of the doc string (or nil) in the FORM. | ||
| 2506 | If SPECINDEX is non-nil, it is the index in FORM | ||
| 2507 | of the function bytecode string. In that case, | ||
| 2508 | we output that argument and the following argument | ||
| 2509 | \(the constants vector) together, for lazy loading. | ||
| 2510 | QUOTED says that we have to put a quote before the | ||
| 2511 | list that represents a doc string reference. | ||
| 2512 | `defvaralias', `autoload' and `custom-declare-variable' need that. | ||
| 2513 | |||
| 2514 | Return the position after any inserted docstrings as comments." | ||
| 2515 | (let ((index 0) | ||
| 2516 | doc-string-position) | ||
| 2517 | ;; Insert the doc string, and make it a comment with #@LENGTH. | ||
| 2518 | (when (and byte-compile-dynamic-docstrings | ||
| 2519 | (stringp (nth docindex form))) | ||
| 2520 | (goto-char position) | ||
| 2521 | (setq doc-string-position | ||
| 2522 | (byte-compile-output-as-comment | ||
| 2523 | (nth docindex form) nil) | ||
| 2524 | position (point)) | ||
| 2525 | (goto-char (point-max))) | ||
| 2526 | |||
| 2527 | (insert (car info)) | ||
| 2528 | (prin1 (car form) byte-compile--outbuffer) | ||
| 2529 | (while (setq form (cdr form)) | ||
| 2530 | (setq index (1+ index)) | ||
| 2531 | (insert " ") | ||
| 2532 | (cond ((and (numberp specindex) (= index specindex) | ||
| 2533 | ;; Don't handle the definition dynamically | ||
| 2534 | ;; if it refers (or might refer) | ||
| 2535 | ;; to objects already output | ||
| 2536 | ;; (for instance, gensyms in the arg list). | ||
| 2537 | (let (non-nil) | ||
| 2538 | (when (hash-table-p print-number-table) | ||
| 2539 | (maphash (lambda (_k v) (if v (setq non-nil t))) | ||
| 2540 | print-number-table)) | ||
| 2541 | (not non-nil))) | ||
| 2542 | ;; Output the byte code and constants specially | ||
| 2543 | ;; for lazy dynamic loading. | ||
| 2544 | (goto-char position) | ||
| 2545 | (let ((lazy-position (byte-compile-output-as-comment | ||
| 2546 | (cons (car form) (nth 1 form)) | ||
| 2547 | t))) | ||
| 2548 | (setq position (point)) | ||
| 2549 | (goto-char (point-max)) | ||
| 2550 | (princ (format "(#$ . %d) nil" lazy-position) | ||
| 2551 | byte-compile--outbuffer) | ||
| 2552 | (setq form (cdr form)) | ||
| 2553 | (setq index (1+ index)))) | ||
| 2554 | ((eq index cvecindex) | ||
| 2555 | (let* ((cvec (car form)) | ||
| 2556 | (len (length cvec)) | ||
| 2557 | (index2 0) | ||
| 2558 | elt) | ||
| 2559 | (insert "[") | ||
| 2560 | (while (< index2 len) | ||
| 2561 | (setq elt (aref cvec index2)) | ||
| 2562 | (if (byte-code-function-p elt) | ||
| 2563 | (setq position | ||
| 2564 | (byte-compile--output-docform-recurse | ||
| 2565 | '("#[" "]") position | ||
| 2566 | (append elt nil) ; Convert the vector to a list. | ||
| 2567 | 2 4 specindex nil)) | ||
| 2568 | (prin1 elt byte-compile--outbuffer)) | ||
| 2569 | (setq index2 (1+ index2)) | ||
| 2570 | (unless (eq index2 len) | ||
| 2571 | (insert " "))) | ||
| 2572 | (insert "]"))) | ||
| 2573 | ((= index docindex) | ||
| 2574 | (cond | ||
| 2575 | (doc-string-position | ||
| 2576 | (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") | ||
| 2577 | doc-string-position) | ||
| 2578 | byte-compile--outbuffer)) | ||
| 2579 | ((stringp (car form)) | ||
| 2580 | (let ((print-escape-newlines nil)) | ||
| 2581 | (goto-char (prog1 (1+ (point)) | ||
| 2582 | (prin1 (car form) | ||
| 2583 | byte-compile--outbuffer))) | ||
| 2584 | (insert "\\\n") | ||
| 2585 | (goto-char (point-max)))) | ||
| 2586 | (t (prin1 (car form) byte-compile--outbuffer)))) | ||
| 2587 | (t (prin1 (car form) byte-compile--outbuffer)))) | ||
| 2588 | (insert (cadr info)) | ||
| 2589 | position)) | ||
| 2590 | |||
| 2591 | (defun byte-compile-output-docform (preface tailpiece name info form | ||
| 2592 | cvecindex docindex | ||
| 2593 | specindex quoted) | ||
| 2594 | "Print a form with a doc string. INFO is (prefix postfix). | ||
| 2595 | If PREFACE, NAME, and TAILPIECE are non-nil, print them too, | ||
| 2596 | before/after INFO and the FORM but after the doc string itself. | ||
| 2597 | CVECINDEX is the index in the FORM of the constant vector, or nil. | ||
| 2598 | DOCINDEX is the index of the doc string (or nil) in the FORM. | ||
| 2599 | If SPECINDEX is non-nil, it is the index in FORM | ||
| 2600 | of the function bytecode string. In that case, | ||
| 2601 | we output that argument and the following argument | ||
| 2602 | \(the constants vector) together, for lazy loading. | ||
| 2603 | QUOTED says that we have to put a quote before the | ||
| 2604 | list that represents a doc string reference. | ||
| 2605 | `defvaralias', `autoload' and `custom-declare-variable' need that." | ||
| 2606 | ;; We need to examine byte-compile-dynamic-docstrings | ||
| 2607 | ;; in the input buffer (now current), not in the output buffer. | ||
| 2608 | (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) | ||
| 2609 | (with-current-buffer byte-compile--outbuffer | ||
| 2610 | (let ((byte-compile-dynamic-docstrings dynamic-docstrings) | ||
| 2611 | (position (point)) | ||
| 2612 | (print-continuous-numbering t) | ||
| 2613 | print-number-table | ||
| 2614 | ;; FIXME: The bindings below are only needed for when we're | ||
| 2615 | ;; called from ...-defmumble. | ||
| 2616 | (print-escape-newlines t) | ||
| 2617 | (print-length nil) | ||
| 2618 | (print-level nil) | ||
| 2619 | (print-quoted t) | ||
| 2620 | (print-gensym t) | ||
| 2621 | (print-circle t)) ; Handle circular data structures. | ||
| 2622 | (when preface | ||
| 2623 | ;; FIXME: We don't handle uninterned names correctly. | ||
| 2624 | ;; E.g. if cl-define-compiler-macro uses uninterned name we get: | ||
| 2625 | ;; (defalias '#1=#:foo--cmacro #[514 ...]) | ||
| 2626 | ;; (put 'foo 'compiler-macro '#:foo--cmacro) | ||
| 2627 | (insert preface) | ||
| 2628 | (prin1 name byte-compile--outbuffer)) | ||
| 2629 | (byte-compile--output-docform-recurse | ||
| 2630 | info position form cvecindex docindex specindex quoted) | ||
| 2631 | (when tailpiece | ||
| 2632 | (insert tailpiece)))))) | ||
| 2633 | |||
| 2634 | (defun byte-compile-keep-pending (form &optional handler) | 2522 | (defun byte-compile-keep-pending (form &optional handler) |
| 2635 | (if (memq byte-optimize '(t source)) | 2523 | (if (memq byte-optimize '(t source)) |
| 2636 | (setq form (byte-optimize-one-form form t))) | 2524 | (setq form (byte-optimize-one-form form t))) |
| @@ -2650,7 +2538,7 @@ list that represents a doc string reference. | |||
| 2650 | (if byte-compile-output | 2538 | (if byte-compile-output |
| 2651 | (let ((form (byte-compile-out-toplevel t 'file))) | 2539 | (let ((form (byte-compile-out-toplevel t 'file))) |
| 2652 | (cond ((eq (car-safe form) 'progn) | 2540 | (cond ((eq (car-safe form) 'progn) |
| 2653 | (mapc 'byte-compile-output-file-form (cdr form))) | 2541 | (mapc #'byte-compile-output-file-form (cdr form))) |
| 2654 | (form | 2542 | (form |
| 2655 | (byte-compile-output-file-form form))) | 2543 | (byte-compile-output-file-form form))) |
| 2656 | (setq byte-compile-constants nil | 2544 | (setq byte-compile-constants nil |
| @@ -2725,12 +2613,12 @@ list that represents a doc string reference. | |||
| 2725 | (setq byte-compile-unresolved-functions | 2613 | (setq byte-compile-unresolved-functions |
| 2726 | (delq (assq funsym byte-compile-unresolved-functions) | 2614 | (delq (assq funsym byte-compile-unresolved-functions) |
| 2727 | byte-compile-unresolved-functions))))) | 2615 | byte-compile-unresolved-functions))))) |
| 2728 | (if (stringp (nth 3 form)) | 2616 | (let* ((doc (nth 3 form)) |
| 2729 | (prog1 | 2617 | (newdoc (if (not (stringp doc)) doc |
| 2730 | form | 2618 | (byte-compile--docstring |
| 2731 | (byte-compile-docstring-style-warn form)) | 2619 | doc 'autoload (nth 1 form))))) |
| 2732 | ;; No doc string, so we can compile this as a normal form. | 2620 | (byte-compile-keep-pending (byte-compile--list-with-n form 3 newdoc) |
| 2733 | (byte-compile-keep-pending form 'byte-compile-normal-call))) | 2621 | #'byte-compile-normal-call))) |
| 2734 | 2622 | ||
| 2735 | (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) | 2623 | (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) |
| 2736 | (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) | 2624 | (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) |
| @@ -2742,9 +2630,10 @@ list that represents a doc string reference. | |||
| 2742 | (byte-compile-warn-x | 2630 | (byte-compile-warn-x |
| 2743 | sym "global/dynamic var `%s' lacks a prefix" sym))) | 2631 | sym "global/dynamic var `%s' lacks a prefix" sym))) |
| 2744 | 2632 | ||
| 2745 | (defun byte-compile--declare-var (sym) | 2633 | (defun byte-compile--declare-var (sym &optional not-toplevel) |
| 2746 | (byte-compile--check-prefixed-var sym) | 2634 | (byte-compile--check-prefixed-var sym) |
| 2747 | (when (memq sym byte-compile-lexical-variables) | 2635 | (when (and (not not-toplevel) |
| 2636 | (memq sym byte-compile-lexical-variables)) | ||
| 2748 | (setq byte-compile-lexical-variables | 2637 | (setq byte-compile-lexical-variables |
| 2749 | (delq sym byte-compile-lexical-variables)) | 2638 | (delq sym byte-compile-lexical-variables)) |
| 2750 | (when (byte-compile-warning-enabled-p 'lexical sym) | 2639 | (when (byte-compile-warning-enabled-p 'lexical sym) |
| @@ -2753,19 +2642,7 @@ list that represents a doc string reference. | |||
| 2753 | (push sym byte-compile--seen-defvars)) | 2642 | (push sym byte-compile--seen-defvars)) |
| 2754 | 2643 | ||
| 2755 | (defun byte-compile-file-form-defvar (form) | 2644 | (defun byte-compile-file-form-defvar (form) |
| 2756 | (let ((sym (nth 1 form))) | 2645 | (byte-compile-defvar form 'toplevel)) |
| 2757 | (byte-compile--declare-var sym) | ||
| 2758 | (if (eq (car form) 'defconst) | ||
| 2759 | (push sym byte-compile-const-variables))) | ||
| 2760 | (if (and (null (cddr form)) ;No `value' provided. | ||
| 2761 | (eq (car form) 'defvar)) ;Just a declaration. | ||
| 2762 | nil | ||
| 2763 | (byte-compile-docstring-style-warn form) | ||
| 2764 | (setq form (copy-sequence form)) | ||
| 2765 | (when (consp (nth 2 form)) | ||
| 2766 | (setcar (cdr (cdr form)) | ||
| 2767 | (byte-compile-top-level (nth 2 form) nil 'file))) | ||
| 2768 | form)) | ||
| 2769 | 2646 | ||
| 2770 | (put 'define-abbrev-table 'byte-hunk-handler | 2647 | (put 'define-abbrev-table 'byte-hunk-handler |
| 2771 | 'byte-compile-file-form-defvar-function) | 2648 | 'byte-compile-file-form-defvar-function) |
| @@ -2773,26 +2650,37 @@ list that represents a doc string reference. | |||
| 2773 | 2650 | ||
| 2774 | (defun byte-compile-file-form-defvar-function (form) | 2651 | (defun byte-compile-file-form-defvar-function (form) |
| 2775 | (pcase-let (((or `',name (let name nil)) (nth 1 form))) | 2652 | (pcase-let (((or `',name (let name nil)) (nth 1 form))) |
| 2776 | (if name (byte-compile--declare-var name))) | 2653 | (if name (byte-compile--declare-var name)) |
| 2777 | ;; Variable aliases are better declared before the corresponding variable, | 2654 | ;; Variable aliases are better declared before the corresponding variable, |
| 2778 | ;; since it makes it more likely that only one of the two vars has a value | 2655 | ;; since it makes it more likely that only one of the two vars has a value |
| 2779 | ;; before the `defvaralias' gets executed, which avoids the need to | 2656 | ;; before the `defvaralias' gets executed, which avoids the need to |
| 2780 | ;; merge values. | 2657 | ;; merge values. |
| 2781 | (pcase form | 2658 | (pcase form |
| 2782 | (`(defvaralias ,_ ',newname . ,_) | 2659 | (`(defvaralias ,_ ',newname . ,_) |
| 2783 | (when (memq newname byte-compile-bound-variables) | 2660 | (when (memq newname byte-compile-bound-variables) |
| 2784 | (if (byte-compile-warning-enabled-p 'suspicious) | 2661 | (if (byte-compile-warning-enabled-p 'suspicious) |
| 2785 | (byte-compile-warn-x | 2662 | (byte-compile-warn-x |
| 2786 | newname | 2663 | newname |
| 2787 | "Alias for `%S' should be declared before its referent" newname))))) | 2664 | "Alias for `%S' should be declared before its referent" |
| 2788 | (byte-compile-docstring-style-warn form) | 2665 | newname))))) |
| 2789 | (byte-compile-keep-pending form)) | 2666 | (let ((doc (nth 3 form))) |
| 2667 | (when (stringp doc) | ||
| 2668 | (setcar (nthcdr 3 form) | ||
| 2669 | (byte-compile--docstring doc (nth 0 form) name)))) | ||
| 2670 | (byte-compile-keep-pending form))) | ||
| 2790 | 2671 | ||
| 2791 | (put 'custom-declare-variable 'byte-hunk-handler | 2672 | (put 'custom-declare-variable 'byte-hunk-handler |
| 2792 | 'byte-compile-file-form-defvar-function) | 2673 | 'byte-compile-file-form-defvar-function) |
| 2793 | 2674 | ||
| 2794 | (put 'custom-declare-face 'byte-hunk-handler | 2675 | (put 'custom-declare-face 'byte-hunk-handler |
| 2795 | 'byte-compile-docstring-style-warn) | 2676 | #'byte-compile--custom-declare-face) |
| 2677 | (defun byte-compile--custom-declare-face (form) | ||
| 2678 | (let ((kind (nth 0 form)) (name (nth 1 form)) (docs (nth 3 form))) | ||
| 2679 | (when (stringp docs) | ||
| 2680 | (let ((newdocs (byte-compile--docstring docs kind name))) | ||
| 2681 | (unless (eq docs newdocs) | ||
| 2682 | (setq form (byte-compile--list-with-n form 3 newdocs))))) | ||
| 2683 | form)) | ||
| 2796 | 2684 | ||
| 2797 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) | 2685 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) |
| 2798 | (defun byte-compile-file-form-require (form) | 2686 | (defun byte-compile-file-form-require (form) |
| @@ -2946,34 +2834,24 @@ not to take responsibility for the actual compilation of the code." | |||
| 2946 | (cons (cons bare-name code) | 2834 | (cons (cons bare-name code) |
| 2947 | (symbol-value this-kind)))) | 2835 | (symbol-value this-kind)))) |
| 2948 | 2836 | ||
| 2949 | (if rest | 2837 | (byte-compile-flush-pending) |
| 2950 | ;; There are additional args to `defalias' (like maybe a docstring) | 2838 | (let ((newform `(defalias ',bare-name |
| 2951 | ;; that the code below can't handle: punt! | 2839 | ,(if macro `'(macro . ,code) code) ,@rest))) |
| 2952 | nil | ||
| 2953 | ;; Otherwise, we have a bona-fide defun/defmacro definition, and use | ||
| 2954 | ;; special code to allow dynamic docstrings and byte-code. | ||
| 2955 | (byte-compile-flush-pending) | ||
| 2956 | (when byte-native-compiling | 2840 | (when byte-native-compiling |
| 2957 | ;; Spill output for the native compiler here. | 2841 | ;; Don't let `byte-compile-output-file-form' push the form to |
| 2842 | ;; `byte-to-native-top-level-forms' because we want to use | ||
| 2843 | ;; `make-byte-to-native-func-def' when possible. | ||
| 2958 | (push | 2844 | (push |
| 2959 | (if macro | 2845 | (if (or macro rest) |
| 2960 | (make-byte-to-native-top-level | 2846 | (make-byte-to-native-top-level |
| 2961 | :form `(defalias ',name '(macro . ,code) nil) | 2847 | :form newform |
| 2962 | :lexical lexical-binding) | 2848 | :lexical lexical-binding) |
| 2963 | (make-byte-to-native-func-def :name name | 2849 | (make-byte-to-native-func-def :name name |
| 2964 | :byte-func code)) | 2850 | :byte-func code)) |
| 2965 | byte-to-native-top-level-forms)) | 2851 | byte-to-native-top-level-forms)) |
| 2966 | ;; Output the form by hand, that's much simpler than having | 2852 | (let ((byte-native-compiling nil)) |
| 2967 | ;; b-c-output-file-form analyze the defalias. | 2853 | (byte-compile-output-file-form newform))) |
| 2968 | (byte-compile-output-docform | 2854 | t)))) |
| 2969 | "\n(defalias '" ")" | ||
| 2970 | bare-name | ||
| 2971 | (if macro '(" '(macro . #[" "])") '(" #[" "]")) | ||
| 2972 | (append code nil) ; Turn byte-code-function-p into list. | ||
| 2973 | 2 4 | ||
| 2974 | (and (atom code) byte-compile-dynamic 1) | ||
| 2975 | nil) | ||
| 2976 | t))))) | ||
| 2977 | 2855 | ||
| 2978 | (defun byte-compile-output-as-comment (exp quoted) | 2856 | (defun byte-compile-output-as-comment (exp quoted) |
| 2979 | "Print Lisp object EXP in the output file at point, inside a comment. | 2857 | "Print Lisp object EXP in the output file at point, inside a comment. |
| @@ -3018,18 +2896,10 @@ otherwise, print without quoting." | |||
| 3018 | 2896 | ||
| 3019 | (defun byte-compile--reify-function (fun) | 2897 | (defun byte-compile--reify-function (fun) |
| 3020 | "Return an expression which will evaluate to a function value FUN. | 2898 | "Return an expression which will evaluate to a function value FUN. |
| 3021 | FUN should be either a `lambda' value or a `closure' value." | 2899 | FUN should be an interpreted closure." |
| 3022 | (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil)) | 2900 | (pcase-let* ((`(closure ,env ,args . ,body) fun) |
| 3023 | `(closure ,env ,args . ,body)) | 2901 | (`(,preamble . ,body) (macroexp-parse-body body)) |
| 3024 | fun) | ||
| 3025 | (preamble nil) | ||
| 3026 | (renv ())) | 2902 | (renv ())) |
| 3027 | ;; Split docstring and `interactive' form from body. | ||
| 3028 | (when (stringp (car body)) | ||
| 3029 | (push (pop body) preamble)) | ||
| 3030 | (when (eq (car-safe (car body)) 'interactive) | ||
| 3031 | (push (pop body) preamble)) | ||
| 3032 | (setq preamble (nreverse preamble)) | ||
| 3033 | ;; Turn the function's closed vars (if any) into local let bindings. | 2903 | ;; Turn the function's closed vars (if any) into local let bindings. |
| 3034 | (dolist (binding env) | 2904 | (dolist (binding env) |
| 3035 | (cond | 2905 | (cond |
| @@ -3051,41 +2921,39 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 3051 | (fun (if (symbolp form) | 2921 | (fun (if (symbolp form) |
| 3052 | (symbol-function form) | 2922 | (symbol-function form) |
| 3053 | form)) | 2923 | form)) |
| 3054 | (macro (eq (car-safe fun) 'macro))) | 2924 | (macro (eq (car-safe fun) 'macro)) |
| 3055 | (if macro | 2925 | (need-a-value nil)) |
| 3056 | (setq fun (cdr fun))) | 2926 | (when macro |
| 3057 | (prog1 | 2927 | (setq need-a-value t) |
| 3058 | (cond | 2928 | (setq fun (cdr fun))) |
| 3059 | ;; Up until Emacs-24.1, byte-compile silently did nothing | 2929 | (cond |
| 3060 | ;; when asked to compile something invalid. So let's tone | 2930 | ;; Up until Emacs-24.1, byte-compile silently did nothing |
| 3061 | ;; down the complaint from an error to a simple message for | 2931 | ;; when asked to compile something invalid. So let's tone |
| 3062 | ;; the known case where signaling an error causes problems. | 2932 | ;; down the complaint from an error to a simple message for |
| 3063 | ((compiled-function-p fun) | 2933 | ;; the known case where signaling an error causes problems. |
| 3064 | (message "Function %s is already compiled" | 2934 | ((compiled-function-p fun) |
| 3065 | (if (symbolp form) form "provided")) | 2935 | (message "Function %s is already compiled" |
| 3066 | fun) | 2936 | (if (symbolp form) form "provided")) |
| 3067 | (t | 2937 | fun) |
| 3068 | (let (final-eval) | 2938 | (t |
| 3069 | (when (or (symbolp form) (eq (car-safe fun) 'closure)) | 2939 | (when (or (symbolp form) (eq (car-safe fun) 'closure)) |
| 3070 | ;; `fun' is a function *value*, so try to recover its corresponding | 2940 | ;; `fun' is a function *value*, so try to recover its |
| 3071 | ;; source code. | 2941 | ;; corresponding source code. |
| 3072 | (setq lexical-binding (eq (car fun) 'closure)) | 2942 | (when (setq lexical-binding (eq (car-safe fun) 'closure)) |
| 3073 | (setq fun (byte-compile--reify-function fun)) | 2943 | (setq fun (byte-compile--reify-function fun))) |
| 3074 | (setq final-eval t)) | 2944 | (setq need-a-value t)) |
| 3075 | ;; Expand macros. | 2945 | ;; Expand macros. |
| 3076 | (setq fun (byte-compile-preprocess fun)) | 2946 | (setq fun (byte-compile-preprocess fun)) |
| 3077 | (setq fun (byte-compile-top-level fun nil 'eval)) | 2947 | (setq fun (byte-compile-top-level fun nil 'eval)) |
| 3078 | (if (symbolp form) | 2948 | (when need-a-value |
| 3079 | ;; byte-compile-top-level returns an *expression* equivalent to the | 2949 | ;; `byte-compile-top-level' returns an *expression* equivalent to |
| 3080 | ;; `fun' expression, so we need to evaluate it, tho normally | 2950 | ;; the `fun' expression, so we need to evaluate it, tho normally |
| 3081 | ;; this is not needed because the expression is just a constant | 2951 | ;; this is not needed because the expression is just a constant |
| 3082 | ;; byte-code object, which is self-evaluating. | 2952 | ;; byte-code object, which is self-evaluating. |
| 3083 | (setq fun (eval fun t))) | 2953 | (setq fun (eval fun lexical-binding))) |
| 3084 | (if final-eval | 2954 | (if macro (push 'macro fun)) |
| 3085 | (setq fun (eval fun t))) | 2955 | (if (symbolp form) (fset form fun)) |
| 3086 | (if macro (push 'macro fun)) | 2956 | fun)))))) |
| 3087 | (if (symbolp form) (fset form fun)) | ||
| 3088 | fun)))))))) | ||
| 3089 | 2957 | ||
| 3090 | (defun byte-compile-sexp (sexp) | 2958 | (defun byte-compile-sexp (sexp) |
| 3091 | "Compile and return SEXP." | 2959 | "Compile and return SEXP." |
| @@ -3184,9 +3052,9 @@ lambda-expression." | |||
| 3184 | (setq fun (cons 'lambda fun)) | 3052 | (setq fun (cons 'lambda fun)) |
| 3185 | (unless (eq 'lambda (car-safe fun)) | 3053 | (unless (eq 'lambda (car-safe fun)) |
| 3186 | (error "Not a lambda list: %S" fun))) | 3054 | (error "Not a lambda list: %S" fun))) |
| 3187 | (byte-compile-docstring-style-warn fun) | ||
| 3188 | (byte-compile-check-lambda-list (nth 1 fun)) | 3055 | (byte-compile-check-lambda-list (nth 1 fun)) |
| 3189 | (let* ((arglist (nth 1 fun)) | 3056 | (let* ((arglist (nth 1 fun)) |
| 3057 | (bare-arglist (byte-run-strip-symbol-positions arglist)) ; for compile-defun. | ||
| 3190 | (arglistvars (byte-run-strip-symbol-positions | 3058 | (arglistvars (byte-run-strip-symbol-positions |
| 3191 | (byte-compile-arglist-vars arglist))) | 3059 | (byte-compile-arglist-vars arglist))) |
| 3192 | (byte-compile-bound-variables | 3060 | (byte-compile-bound-variables |
| @@ -3195,16 +3063,22 @@ lambda-expression." | |||
| 3195 | (body (cdr (cdr fun))) | 3063 | (body (cdr (cdr fun))) |
| 3196 | (doc (if (stringp (car body)) | 3064 | (doc (if (stringp (car body)) |
| 3197 | (prog1 (car body) | 3065 | (prog1 (car body) |
| 3198 | ;; Discard the doc string | 3066 | ;; Discard the doc string from the body |
| 3199 | ;; unless it is the last element of the body. | 3067 | ;; unless it is the last element of the body. |
| 3200 | (if (cdr body) | 3068 | (if (cdr body) |
| 3201 | (setq body (cdr body)))))) | 3069 | (setq body (cdr body)))))) |
| 3202 | (int (assq 'interactive body)) | 3070 | (int (assq 'interactive body)) |
| 3203 | command-modes) | 3071 | command-modes) |
| 3204 | (when lexical-binding | 3072 | (when lexical-binding |
| 3073 | (when arglist | ||
| 3074 | ;; byte-compile-make-args-desc lost the args's names, | ||
| 3075 | ;; so preserve them in the docstring. | ||
| 3076 | (setq doc (help-add-fundoc-usage doc bare-arglist))) | ||
| 3205 | (dolist (var arglistvars) | 3077 | (dolist (var arglistvars) |
| 3206 | (when (assq var byte-compile--known-dynamic-vars) | 3078 | (when (assq var byte-compile--known-dynamic-vars) |
| 3207 | (byte-compile--warn-lexical-dynamic var 'lambda)))) | 3079 | (byte-compile--warn-lexical-dynamic var 'lambda)))) |
| 3080 | (when (stringp doc) | ||
| 3081 | (setq doc (byte-compile--docstring doc "" nil 'is-a-value))) | ||
| 3208 | ;; Process the interactive spec. | 3082 | ;; Process the interactive spec. |
| 3209 | (when int | 3083 | (when int |
| 3210 | ;; Skip (interactive) if it is in front (the most usual location). | 3084 | ;; Skip (interactive) if it is in front (the most usual location). |
| @@ -3248,8 +3122,7 @@ lambda-expression." | |||
| 3248 | (and lexical-binding | 3122 | (and lexical-binding |
| 3249 | (byte-compile-make-lambda-lexenv | 3123 | (byte-compile-make-lambda-lexenv |
| 3250 | arglistvars)) | 3124 | arglistvars)) |
| 3251 | reserved-csts)) | 3125 | reserved-csts))) |
| 3252 | (bare-arglist (byte-run-strip-symbol-positions arglist))) ; for compile-defun. | ||
| 3253 | ;; Build the actual byte-coded function. | 3126 | ;; Build the actual byte-coded function. |
| 3254 | (cl-assert (eq 'byte-code (car-safe compiled))) | 3127 | (cl-assert (eq 'byte-code (car-safe compiled))) |
| 3255 | (let ((out | 3128 | (let ((out |
| @@ -3261,12 +3134,7 @@ lambda-expression." | |||
| 3261 | ;; byte-string, constants-vector, stack depth | 3134 | ;; byte-string, constants-vector, stack depth |
| 3262 | (cdr compiled) | 3135 | (cdr compiled) |
| 3263 | ;; optionally, the doc string. | 3136 | ;; optionally, the doc string. |
| 3264 | (cond ((and lexical-binding arglist) | 3137 | (when (or doc int) (list doc)) |
| 3265 | ;; byte-compile-make-args-desc lost the args's names, | ||
| 3266 | ;; so preserve them in the docstring. | ||
| 3267 | (list (help-add-fundoc-usage doc bare-arglist))) | ||
| 3268 | ((or doc int) | ||
| 3269 | (list doc))) | ||
| 3270 | ;; optionally, the interactive spec (and the modes the | 3138 | ;; optionally, the interactive spec (and the modes the |
| 3271 | ;; command applies to). | 3139 | ;; command applies to). |
| 3272 | (cond | 3140 | (cond |
| @@ -3820,7 +3688,6 @@ lambda-expression." | |||
| 3820 | (alen (length (cdr form))) | 3688 | (alen (length (cdr form))) |
| 3821 | (dynbinds ()) | 3689 | (dynbinds ()) |
| 3822 | lap) | 3690 | lap) |
| 3823 | (fetch-bytecode fun) | ||
| 3824 | (setq lap (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)) | 3691 | (setq lap (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)) |
| 3825 | ;; optimized switch bytecode makes it impossible to guess the correct | 3692 | ;; optimized switch bytecode makes it impossible to guess the correct |
| 3826 | ;; `byte-compile-depth', which can result in incorrect inlined code. | 3693 | ;; `byte-compile-depth', which can result in incorrect inlined code. |
| @@ -5147,49 +5014,49 @@ binding slots have been popped." | |||
| 5147 | (push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars)) | 5014 | (push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars)) |
| 5148 | (byte-compile-normal-call form)) | 5015 | (byte-compile-normal-call form)) |
| 5149 | 5016 | ||
| 5150 | (defun byte-compile-defvar (form) | 5017 | (defun byte-compile-defvar (form &optional toplevel) |
| 5151 | ;; This is not used for file-level defvar/consts. | 5018 | (let* ((fun (nth 0 form)) |
| 5152 | (when (and (symbolp (nth 1 form)) | 5019 | (var (nth 1 form)) |
| 5153 | (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) | 5020 | (value (nth 2 form)) |
| 5154 | (byte-compile-warning-enabled-p 'lexical (nth 1 form))) | 5021 | (string (nth 3 form))) |
| 5155 | (byte-compile-warn-x | 5022 | (byte-compile--declare-var var (not toplevel)) |
| 5156 | (nth 1 form) | ||
| 5157 | "global/dynamic var `%s' lacks a prefix" | ||
| 5158 | (nth 1 form))) | ||
| 5159 | (byte-compile-docstring-style-warn form) | ||
| 5160 | (let ((fun (nth 0 form)) | ||
| 5161 | (var (nth 1 form)) | ||
| 5162 | (value (nth 2 form)) | ||
| 5163 | (string (nth 3 form))) | ||
| 5164 | (when (or (> (length form) 4) | ||
| 5165 | (and (eq fun 'defconst) (null (cddr form)))) | ||
| 5166 | (let ((ncall (length (cdr form)))) | ||
| 5167 | (byte-compile-warn-x | ||
| 5168 | fun | ||
| 5169 | "`%s' called with %d argument%s, but %s %s" | ||
| 5170 | fun ncall | ||
| 5171 | (if (= 1 ncall) "" "s") | ||
| 5172 | (if (< ncall 2) "requires" "accepts only") | ||
| 5173 | "2-3"))) | ||
| 5174 | (push var byte-compile-bound-variables) | ||
| 5175 | (if (eq fun 'defconst) | 5023 | (if (eq fun 'defconst) |
| 5176 | (push var byte-compile-const-variables)) | 5024 | (push var byte-compile-const-variables)) |
| 5177 | (when (and string (not (stringp string))) | 5025 | (cond |
| 5026 | ((stringp string) | ||
| 5027 | (setq string (byte-compile--docstring string fun var 'is-a-value))) | ||
| 5028 | (string | ||
| 5178 | (byte-compile-warn-x | 5029 | (byte-compile-warn-x |
| 5179 | string | 5030 | string |
| 5180 | "third arg to `%s %s' is not a string: %s" | 5031 | "third arg to `%s %s' is not a string: %s" |
| 5181 | fun var string)) | 5032 | fun var string))) |
| 5182 | ;; Delegate the actual work to the function version of the | 5033 | (if toplevel |
| 5183 | ;; special form, named with a "-1" suffix. | 5034 | ;; At top-level we emit calls to defvar/defconst. |
| 5184 | (byte-compile-form-do-effect | 5035 | (if (and (null (cddr form)) ;No `value' provided. |
| 5185 | (cond | 5036 | (eq (car form) 'defvar)) ;Just a declaration. |
| 5186 | ((eq fun 'defconst) `(defconst-1 ',var ,@(nthcdr 2 form))) | 5037 | nil |
| 5187 | ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo. | 5038 | (let ((tail (nthcdr 4 form))) |
| 5188 | (t `(defvar-1 ',var | 5039 | (when (or tail string) (push string tail)) |
| 5189 | ;; Don't eval `value' if `defvar' wouldn't eval it either. | 5040 | (when (cddr form) |
| 5190 | ,(if (macroexp-const-p value) value | 5041 | (push (if (not (consp value)) value |
| 5191 | `(if (boundp ',var) nil ,value)) | 5042 | (byte-compile-top-level value nil 'file)) |
| 5192 | ,@(nthcdr 3 form))))))) | 5043 | tail)) |
| 5044 | `(,fun ,var ,@tail))) | ||
| 5045 | ;; At non-top-level, since there is no byte code for | ||
| 5046 | ;; defvar/defconst, we delegate the actual work to the function | ||
| 5047 | ;; version of the special form, named with a "-1" suffix. | ||
| 5048 | (byte-compile-form-do-effect | ||
| 5049 | (cond | ||
| 5050 | ((eq fun 'defconst) | ||
| 5051 | `(defconst-1 ',var ,@(byte-compile--list-with-n | ||
| 5052 | (nthcdr 2 form) 1 (macroexp-quote string)))) | ||
| 5053 | ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo. | ||
| 5054 | (t `(defvar-1 ',var | ||
| 5055 | ;; Don't eval `value' if `defvar' wouldn't eval it either. | ||
| 5056 | ,(if (macroexp-const-p value) value | ||
| 5057 | `(if (boundp ',var) nil ,value)) | ||
| 5058 | ,@(byte-compile--list-with-n | ||
| 5059 | (nthcdr 3 form) 0 (macroexp-quote string))))))))) | ||
| 5193 | 5060 | ||
| 5194 | (defun byte-compile-autoload (form) | 5061 | (defun byte-compile-autoload (form) |
| 5195 | (and (macroexp-const-p (nth 1 form)) | 5062 | (and (macroexp-const-p (nth 1 form)) |
| @@ -5215,14 +5082,6 @@ binding slots have been popped." | |||
| 5215 | ;; For the compilation itself, we could largely get rid of this hunk-handler, | 5082 | ;; For the compilation itself, we could largely get rid of this hunk-handler, |
| 5216 | ;; if it weren't for the fact that we need to figure out when a defalias | 5083 | ;; if it weren't for the fact that we need to figure out when a defalias |
| 5217 | ;; defines a macro, so as to add it to byte-compile-macro-environment. | 5084 | ;; defines a macro, so as to add it to byte-compile-macro-environment. |
| 5218 | ;; | ||
| 5219 | ;; FIXME: we also use this hunk-handler to implement the function's | ||
| 5220 | ;; dynamic docstring feature (via byte-compile-file-form-defmumble). | ||
| 5221 | ;; We should probably actually implement it (more elegantly) in | ||
| 5222 | ;; byte-compile-lambda so it applies to all lambdas. We did it here | ||
| 5223 | ;; so the resulting .elc format was recognizable by make-docfile, | ||
| 5224 | ;; but since then we stopped using DOC for the docstrings of | ||
| 5225 | ;; preloaded elc files so that obstacle is gone. | ||
| 5226 | (let ((byte-compile-free-references nil) | 5085 | (let ((byte-compile-free-references nil) |
| 5227 | (byte-compile-free-assignments nil)) | 5086 | (byte-compile-free-assignments nil)) |
| 5228 | (pcase form | 5087 | (pcase form |
| @@ -5231,7 +5090,11 @@ binding slots have been popped." | |||
| 5231 | ;; - `arg' is the expression to which it is defined. | 5090 | ;; - `arg' is the expression to which it is defined. |
| 5232 | ;; - `rest' is the rest of the arguments. | 5091 | ;; - `rest' is the rest of the arguments. |
| 5233 | (`(,_ ',name ,arg . ,rest) | 5092 | (`(,_ ',name ,arg . ,rest) |
| 5234 | (byte-compile-docstring-style-warn form) | 5093 | (let ((doc (car rest))) |
| 5094 | (when (stringp doc) | ||
| 5095 | (setq rest (byte-compile--list-with-n | ||
| 5096 | rest 0 | ||
| 5097 | (byte-compile--docstring doc (nth 0 form) name))))) | ||
| 5235 | (pcase-let* | 5098 | (pcase-let* |
| 5236 | ;; `macro' is non-nil if it defines a macro. | 5099 | ;; `macro' is non-nil if it defines a macro. |
| 5237 | ;; `fun' is the function part of `arg' (defaults to `arg'). | 5100 | ;; `fun' is the function part of `arg' (defaults to `arg'). |
| @@ -5900,6 +5763,16 @@ and corresponding effects." | |||
| 5900 | (eval form) | 5763 | (eval form) |
| 5901 | form))) | 5764 | form))) |
| 5902 | 5765 | ||
| 5766 | ;; Report comma operator used outside of backquote. | ||
| 5767 | ;; Inside backquote, backquote will transform it before it gets here. | ||
| 5768 | |||
| 5769 | (put '\, 'compiler-macro #'bytecomp--report-comma) | ||
| 5770 | (defun bytecomp--report-comma (form &rest _ignore) | ||
| 5771 | (macroexp-warn-and-return | ||
| 5772 | (format-message "`%s' called -- perhaps used not within backquote" | ||
| 5773 | (car form)) | ||
| 5774 | form (list 'suspicious (car form)) t)) | ||
| 5775 | |||
| 5903 | ;; Check for (in)comparable constant values in calls to `eq', `memq' etc. | 5776 | ;; Check for (in)comparable constant values in calls to `eq', `memq' etc. |
| 5904 | 5777 | ||
| 5905 | (defun bytecomp--dodgy-eq-arg-p (x number-ok) | 5778 | (defun bytecomp--dodgy-eq-arg-p (x number-ok) |
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e210cfdf5ce..4ff47971351 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el | |||
| @@ -621,12 +621,16 @@ places where they originally did not directly appear." | |||
| 621 | (cconv-convert exp env extend)) | 621 | (cconv-convert exp env extend)) |
| 622 | 622 | ||
| 623 | (`(,func . ,forms) | 623 | (`(,func . ,forms) |
| 624 | (if (symbolp func) | 624 | (if (or (symbolp func) (functionp func)) |
| 625 | ;; First element is function or whatever function-like forms are: | 625 | ;; First element is function or whatever function-like forms are: |
| 626 | ;; or, and, if, catch, progn, prog1, while, until | 626 | ;; or, and, if, catch, progn, prog1, while, until |
| 627 | `(,func . ,(mapcar (lambda (form) | 627 | (let ((args (mapcar (lambda (form) (cconv-convert form env extend)) |
| 628 | (cconv-convert form env extend)) | 628 | forms))) |
| 629 | forms)) | 629 | (unless (symbolp func) |
| 630 | (byte-compile-warn-x | ||
| 631 | form | ||
| 632 | "Use `funcall' instead of `%s' in the function position" func)) | ||
| 633 | `(,func . ,args)) | ||
| 630 | (byte-compile-warn-x form "Malformed function `%S'" func) | 634 | (byte-compile-warn-x form "Malformed function `%S'" func) |
| 631 | nil)) | 635 | nil)) |
| 632 | 636 | ||
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index 8e40b227b65..faa7824c8bd 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el | |||
| @@ -85,6 +85,9 @@ don't know how to recognize (e.g. some macros)." | |||
| 85 | (let (alist) | 85 | (let (alist) |
| 86 | (with-temp-buffer | 86 | (with-temp-buffer |
| 87 | (insert-file-contents file) | 87 | (insert-file-contents file) |
| 88 | ;; Ensure shorthands available, as we will be `read'ing Elisp | ||
| 89 | ;; (bug#67523) | ||
| 90 | (let (enable-local-variables) (hack-local-variables)) | ||
| 88 | ;; FIXME we could theoretically be inside a string. | 91 | ;; FIXME we could theoretically be inside a string. |
| 89 | (while (re-search-forward "^[ \t]*\\((declare-function\\)[ \t\n]" nil t) | 92 | (while (re-search-forward "^[ \t]*\\((declare-function\\)[ \t\n]" nil t) |
| 90 | (let ((pos (match-beginning 1))) | 93 | (let ((pos (match-beginning 1))) |
| @@ -145,64 +148,70 @@ is a string giving details of the error." | |||
| 145 | (if (file-regular-p fnfile) | 148 | (if (file-regular-p fnfile) |
| 146 | (with-temp-buffer | 149 | (with-temp-buffer |
| 147 | (insert-file-contents fnfile) | 150 | (insert-file-contents fnfile) |
| 151 | (unless cflag | ||
| 152 | ;; If in Elisp, ensure syntax and shorthands available | ||
| 153 | ;; (bug#67523) | ||
| 154 | (set-syntax-table emacs-lisp-mode-syntax-table) | ||
| 155 | (let (enable-local-variables) (hack-local-variables))) | ||
| 148 | ;; defsubst's don't _have_ to be known at compile time. | 156 | ;; defsubst's don't _have_ to be known at compile time. |
| 149 | (setq re (format (if cflag | 157 | (setq re (if cflag |
| 150 | "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\"" | 158 | (format "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\"" |
| 151 | "^[ \t]*(\\(fset[ \t]+'\\|\ | 159 | (regexp-opt (mapcar 'cadr fnlist) t)) |
| 160 | "^[ \t]*(\\(fset[ \t]+'\\|\ | ||
| 152 | cl-def\\(?:generic\\|method\\|un\\)\\|\ | 161 | cl-def\\(?:generic\\|method\\|un\\)\\|\ |
| 153 | def\\(?:un\\|subst\\|foo\\|method\\|class\\|\ | 162 | def\\(?:un\\|subst\\|foo\\|method\\|class\\|\ |
| 154 | ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\ | 163 | ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\ |
| 155 | \\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\ | 164 | \\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\ |
| 156 | ine-overloadable-function\\)\\)\ | 165 | ine-overloadable-function\\)\\)\ |
| 157 | [ \t]*%s\\([ \t;]+\\|$\\)") | 166 | [ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\([ \t;]+\\|$\\)")) |
| 158 | (regexp-opt (mapcar 'cadr fnlist) t))) | ||
| 159 | (while (re-search-forward re nil t) | 167 | (while (re-search-forward re nil t) |
| 160 | (skip-chars-forward " \t\n") | 168 | (skip-chars-forward " \t\n") |
| 161 | (setq fn (match-string 2) | 169 | (setq fn (symbol-name (car (read-from-string (match-string 2))))) |
| 162 | type (match-string 1) | 170 | (when (member fn (mapcar 'cadr fnlist)) |
| 163 | ;; (min . max) for a fixed number of arguments, or | 171 | (setq type (match-string 1) |
| 164 | ;; arglists with optional elements. | 172 | ;; (min . max) for a fixed number of arguments, or |
| 165 | ;; (min) for arglists with &rest. | 173 | ;; arglists with optional elements. |
| 166 | ;; sig = 'err means we could not find an arglist. | 174 | ;; (min) for arglists with &rest. |
| 167 | sig (cond (cflag | 175 | ;; sig = 'err means we could not find an arglist. |
| 168 | (or | 176 | sig (cond (cflag |
| 169 | (when (search-forward "," nil t 3) | 177 | (or |
| 170 | (skip-chars-forward " \t\n") | 178 | (when (search-forward "," nil t 3) |
| 171 | ;; Assuming minargs and maxargs on same line. | 179 | (skip-chars-forward " \t\n") |
| 172 | (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\ | 180 | ;; Assuming minargs and maxargs on same line. |
| 181 | (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\ | ||
| 173 | \\([0-9]+\\|MANY\\|UNEVALLED\\)") | 182 | \\([0-9]+\\|MANY\\|UNEVALLED\\)") |
| 174 | (setq minargs (string-to-number | 183 | (setq minargs (string-to-number |
| 175 | (match-string 1)) | 184 | (match-string 1)) |
| 176 | maxargs (match-string 2)) | 185 | maxargs (match-string 2)) |
| 177 | (cons minargs (unless (string-match "[^0-9]" | 186 | (cons minargs (unless (string-match "[^0-9]" |
| 178 | maxargs) | 187 | maxargs) |
| 179 | (string-to-number | 188 | (string-to-number |
| 180 | maxargs))))) | 189 | maxargs))))) |
| 181 | 'err)) | 190 | 'err)) |
| 182 | ((string-match | 191 | ((string-match |
| 183 | "\\`define-\\(derived\\|generic\\)-mode\\'" | 192 | "\\`define-\\(derived\\|generic\\)-mode\\'" |
| 184 | type) | 193 | type) |
| 185 | '(0 . 0)) | 194 | '(0 . 0)) |
| 186 | ((string-match | 195 | ((string-match |
| 187 | "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'" | 196 | "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'" |
| 188 | type) | 197 | type) |
| 189 | '(0 . 1)) | 198 | '(0 . 1)) |
| 190 | ;; Prompt to update. | 199 | ;; Prompt to update. |
| 191 | ((string-match | 200 | ((string-match |
| 192 | "\\`define-obsolete-function-alias\\>" | 201 | "\\`define-obsolete-function-alias\\>" |
| 193 | type) | 202 | type) |
| 194 | 'obsolete) | 203 | 'obsolete) |
| 195 | ;; Can't easily check arguments in these cases. | 204 | ;; Can't easily check arguments in these cases. |
| 196 | ((string-match "\\`\\(def\\(alias\\|class\\)\\|\ | 205 | ((string-match "\\`\\(def\\(alias\\|class\\)\\|\ |
| 197 | fset\\|\\(?:cl-\\)?defmethod\\)\\>" type) | 206 | fset\\|\\(?:cl-\\)?defmethod\\)\\>" type) |
| 198 | t) | 207 | t) |
| 199 | ((looking-at "\\((\\|nil\\)") | 208 | ((looking-at "\\((\\|nil\\)") |
| 200 | (byte-compile-arglist-signature | 209 | (byte-compile-arglist-signature |
| 201 | (read (current-buffer)))) | 210 | (read (current-buffer)))) |
| 202 | (t | 211 | (t |
| 203 | 'err)) | 212 | 'err)) |
| 204 | ;; alist of functions and arglist signatures. | 213 | ;; alist of functions and arglist signatures. |
| 205 | siglist (cons (cons fn sig) siglist))))) | 214 | siglist (cons (cons fn sig) siglist)))))) |
| 206 | (dolist (e fnlist) | 215 | (dolist (e fnlist) |
| 207 | (setq arglist (nth 2 e) | 216 | (setq arglist (nth 2 e) |
| 208 | type | 217 | type |
| @@ -319,9 +328,14 @@ Returns non-nil if any false statements are found." | |||
| 319 | (setq root (directory-file-name (file-relative-name root))) | 328 | (setq root (directory-file-name (file-relative-name root))) |
| 320 | (or (file-directory-p root) | 329 | (or (file-directory-p root) |
| 321 | (error "Directory `%s' not found" root)) | 330 | (error "Directory `%s' not found" root)) |
| 322 | (let ((files (directory-files-recursively root "\\.el\\'"))) | 331 | (when-let* ((files (directory-files-recursively root "\\.el\\'")) |
| 323 | (when files | 332 | (files (mapcan (lambda (file) |
| 324 | (apply #'check-declare-files files)))) | 333 | ;; Filter out lock files. |
| 334 | (and (not (string-prefix-p | ||
| 335 | ".#" (file-name-nondirectory file))) | ||
| 336 | (list file))) | ||
| 337 | files))) | ||
| 338 | (apply #'check-declare-files files))) | ||
| 325 | 339 | ||
| 326 | (provide 'check-declare) | 340 | (provide 'check-declare) |
| 327 | 341 | ||
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 82c6c03a592..02c11cae573 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el | |||
| @@ -1994,7 +1994,7 @@ from the comment." | |||
| 1994 | (defun-depth (ppss-depth (syntax-ppss))) | 1994 | (defun-depth (ppss-depth (syntax-ppss))) |
| 1995 | (lst nil) | 1995 | (lst nil) |
| 1996 | (ret nil) | 1996 | (ret nil) |
| 1997 | (oo (make-vector 3 0))) ;substitute obarray for `read' | 1997 | (oo (obarray-make 3))) ;substitute obarray for `read' |
| 1998 | (forward-char 1) | 1998 | (forward-char 1) |
| 1999 | (forward-sexp 1) | 1999 | (forward-sexp 1) |
| 2000 | (skip-chars-forward " \n\t") | 2000 | (skip-chars-forward " \n\t") |
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index bdccdcc48ce..f439a97f88c 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el | |||
| @@ -1140,12 +1140,8 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." | |||
| 1140 | 1140 | ||
| 1141 | (add-hook 'help-fns-describe-function-functions #'cl--generic-describe) | 1141 | (add-hook 'help-fns-describe-function-functions #'cl--generic-describe) |
| 1142 | (defun cl--generic-describe (function) | 1142 | (defun cl--generic-describe (function) |
| 1143 | ;; Supposedly this is called from help-fns, so help-fns should be loaded at | ||
| 1144 | ;; this point. | ||
| 1145 | (declare-function help-fns-short-filename "help-fns" (filename)) | ||
| 1146 | (let ((generic (if (symbolp function) (cl--generic function)))) | 1143 | (let ((generic (if (symbolp function) (cl--generic function)))) |
| 1147 | (when generic | 1144 | (when generic |
| 1148 | (require 'help-mode) ;Needed for `help-function-def' button! | ||
| 1149 | (save-excursion | 1145 | (save-excursion |
| 1150 | ;; Ensure that we have two blank lines (but not more). | 1146 | ;; Ensure that we have two blank lines (but not more). |
| 1151 | (unless (looking-back "\n\n" (- (point) 2)) | 1147 | (unless (looking-back "\n\n" (- (point) 2)) |
| @@ -1153,33 +1149,49 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." | |||
| 1153 | (insert "This is a generic function.\n\n") | 1149 | (insert "This is a generic function.\n\n") |
| 1154 | (insert (propertize "Implementations:\n\n" 'face 'bold)) | 1150 | (insert (propertize "Implementations:\n\n" 'face 'bold)) |
| 1155 | ;; Loop over fanciful generics | 1151 | ;; Loop over fanciful generics |
| 1156 | (dolist (method (cl--generic-method-table generic)) | 1152 | (cl--map-methods-documentation |
| 1157 | (pcase-let* | 1153 | function |
| 1158 | ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))) | 1154 | (lambda (quals signature file doc) |
| 1159 | ;; FIXME: Add hyperlinks for the types as well. | 1155 | (insert (format "%s%S%s\n\n%s\n\n" |
| 1160 | (let ((print-quoted nil) | 1156 | quals signature |
| 1161 | (quals (if (length> qualifiers 0) | 1157 | (if file (format-message " in `%s'." file) "") |
| 1162 | (concat (substring qualifiers | 1158 | (or doc "Undocumented"))))))))) |
| 1163 | 0 (string-match " *\\'" | 1159 | |
| 1164 | qualifiers)) | 1160 | (defun cl--map-methods-documentation (funname metname-printer) |
| 1165 | "\n") | 1161 | "Iterate on FUNNAME's methods documentation at point." |
| 1166 | ""))) | 1162 | ;; Supposedly this is called from help-fns, so help-fns should be loaded at |
| 1167 | (insert (format "%s%S" | 1163 | ;; this point. |
| 1168 | quals | 1164 | (require 'help-fns) |
| 1169 | (cons function | 1165 | (declare-function help-fns-short-filename "help-fns" (filename)) |
| 1170 | (cl--generic-upcase-formal-args args))))) | 1166 | (let ((generic (if (symbolp funname) (cl--generic funname)))) |
| 1171 | (let* ((met-name (cl--generic-load-hist-format | 1167 | (when generic |
| 1172 | function | 1168 | (require 'help-mode) ;Needed for `help-function-def' button! |
| 1173 | (cl--generic-method-qualifiers method) | 1169 | ;; Loop over fanciful generics |
| 1174 | (cl--generic-method-specializers method))) | 1170 | (dolist (method (cl--generic-method-table generic)) |
| 1175 | (file (find-lisp-object-file-name met-name 'cl-defmethod))) | 1171 | (pcase-let* |
| 1176 | (when file | 1172 | ((`(,qualifiers ,args ,doc) (cl--generic-method-info method)) |
| 1177 | (insert (substitute-command-keys " in `")) | 1173 | ;; FIXME: Add hyperlinks for the types as well. |
| 1178 | (help-insert-xref-button (help-fns-short-filename file) | 1174 | (quals (if (length> qualifiers 0) |
| 1179 | 'help-function-def met-name file | 1175 | (concat (substring qualifiers |
| 1180 | 'cl-defmethod) | 1176 | 0 (string-match " *\\'" |
| 1181 | (insert (substitute-command-keys "'.\n")))) | 1177 | qualifiers)) |
| 1182 | (insert "\n" (or doc "Undocumented") "\n\n"))))))) | 1178 | "\n") |
| 1179 | "")) | ||
| 1180 | (met-name (cl--generic-load-hist-format | ||
| 1181 | funname | ||
| 1182 | (cl--generic-method-qualifiers method) | ||
| 1183 | (cl--generic-method-specializers method))) | ||
| 1184 | (file (find-lisp-object-file-name met-name 'cl-defmethod))) | ||
| 1185 | (funcall metname-printer | ||
| 1186 | quals | ||
| 1187 | (cons funname | ||
| 1188 | (cl--generic-upcase-formal-args args)) | ||
| 1189 | (when file | ||
| 1190 | (make-text-button (help-fns-short-filename file) nil | ||
| 1191 | 'type 'help-function-def | ||
| 1192 | 'help-args | ||
| 1193 | (list met-name file 'cl-defmethod))) | ||
| 1194 | doc)))))) | ||
| 1183 | 1195 | ||
| 1184 | (defun cl--generic-specializers-apply-to-type-p (specializers type) | 1196 | (defun cl--generic-specializers-apply-to-type-p (specializers type) |
| 1185 | "Return non-nil if a method with SPECIALIZERS applies to TYPE." | 1197 | "Return non-nil if a method with SPECIALIZERS applies to TYPE." |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 88447203a64..be477b7a6df 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -3344,14 +3344,14 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the | |||
| 3344 | contents of field NAME is matched against PAT, or they can be of | 3344 | contents of field NAME is matched against PAT, or they can be of |
| 3345 | the form NAME which is a shorthand for (NAME NAME)." | 3345 | the form NAME which is a shorthand for (NAME NAME)." |
| 3346 | (declare (debug (sexp &rest [&or (sexp pcase-PAT) sexp]))) | 3346 | (declare (debug (sexp &rest [&or (sexp pcase-PAT) sexp]))) |
| 3347 | `(and (pred (pcase--flip cl-typep ',type)) | 3347 | `(and (pred (cl-typep _ ',type)) |
| 3348 | ,@(mapcar | 3348 | ,@(mapcar |
| 3349 | (lambda (field) | 3349 | (lambda (field) |
| 3350 | (let* ((name (if (consp field) (car field) field)) | 3350 | (let* ((name (if (consp field) (car field) field)) |
| 3351 | (pat (if (consp field) (cadr field) field))) | 3351 | (pat (if (consp field) (cadr field) field))) |
| 3352 | `(app ,(if (eq (cl-struct-sequence-type type) 'list) | 3352 | `(app ,(if (eq (cl-struct-sequence-type type) 'list) |
| 3353 | `(nth ,(cl-struct-slot-offset type name)) | 3353 | `(nth ,(cl-struct-slot-offset type name)) |
| 3354 | `(pcase--flip aref ,(cl-struct-slot-offset type name))) | 3354 | `(aref _ ,(cl-struct-slot-offset type name))) |
| 3355 | ,pat))) | 3355 | ,pat))) |
| 3356 | fields))) | 3356 | fields))) |
| 3357 | 3357 | ||
| @@ -3368,13 +3368,13 @@ the form NAME which is a shorthand for (NAME NAME)." | |||
| 3368 | "Extra special cases for `cl-typep' predicates." | 3368 | "Extra special cases for `cl-typep' predicates." |
| 3369 | (let* ((x1 pred1) (x2 pred2) | 3369 | (let* ((x1 pred1) (x2 pred2) |
| 3370 | (t1 | 3370 | (t1 |
| 3371 | (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1)) | 3371 | (and (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1)) |
| 3372 | (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1)) | 3372 | (eq '_ (car-safe x1)) (setq x1 (cdr x1)) |
| 3373 | (null (cdr-safe x1)) (setq x1 (car x1)) | 3373 | (null (cdr-safe x1)) (setq x1 (car x1)) |
| 3374 | (eq 'quote (car-safe x1)) (cadr x1))) | 3374 | (eq 'quote (car-safe x1)) (cadr x1))) |
| 3375 | (t2 | 3375 | (t2 |
| 3376 | (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2)) | 3376 | (and (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2)) |
| 3377 | (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2)) | 3377 | (eq '_ (car-safe x2)) (setq x2 (cdr x2)) |
| 3378 | (null (cdr-safe x2)) (setq x2 (car x2)) | 3378 | (null (cdr-safe x2)) (setq x2 (car x2)) |
| 3379 | (eq 'quote (car-safe x2)) (cadr x2)))) | 3379 | (eq 'quote (car-safe x2)) (cadr x2)))) |
| 3380 | (or | 3380 | (or |
| @@ -3460,6 +3460,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." | |||
| 3460 | (or (cdr (assq sym byte-compile-function-environment)) | 3460 | (or (cdr (assq sym byte-compile-function-environment)) |
| 3461 | (cdr (assq sym macroexpand-all-environment)))))) | 3461 | (cdr (assq sym macroexpand-all-environment)))))) |
| 3462 | 3462 | ||
| 3463 | ;; Please keep it in sync with `comp-known-predicates'. | ||
| 3463 | (pcase-dolist (`(,type . ,pred) | 3464 | (pcase-dolist (`(,type . ,pred) |
| 3464 | ;; Mostly kept in alphabetical order. | 3465 | ;; Mostly kept in alphabetical order. |
| 3465 | '((array . arrayp) | 3466 | '((array . arrayp) |
| @@ -3487,6 +3488,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." | |||
| 3487 | (natnum . natnump) | 3488 | (natnum . natnump) |
| 3488 | (number . numberp) | 3489 | (number . numberp) |
| 3489 | (null . null) | 3490 | (null . null) |
| 3491 | (obarray . obarrayp) | ||
| 3490 | (overlay . overlayp) | 3492 | (overlay . overlayp) |
| 3491 | (process . processp) | 3493 | (process . processp) |
| 3492 | (real . numberp) | 3494 | (real . numberp) |
| @@ -3494,6 +3496,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." | |||
| 3494 | (subr . subrp) | 3496 | (subr . subrp) |
| 3495 | (string . stringp) | 3497 | (string . stringp) |
| 3496 | (symbol . symbolp) | 3498 | (symbol . symbolp) |
| 3499 | (symbol-with-pos . symbol-with-pos-p) | ||
| 3497 | (vector . vectorp) | 3500 | (vector . vectorp) |
| 3498 | (window . windowp) | 3501 | (window . windowp) |
| 3499 | ;; FIXME: Do we really want to consider these types? | 3502 | ;; FIXME: Do we really want to consider these types? |
| @@ -3818,7 +3821,8 @@ STRUCT-TYPE and SLOT-NAME are symbols. INST is a structure instance." | |||
| 3818 | (pcase-defmacro cl-type (type) | 3821 | (pcase-defmacro cl-type (type) |
| 3819 | "Pcase pattern that matches objects of TYPE. | 3822 | "Pcase pattern that matches objects of TYPE. |
| 3820 | TYPE is a type descriptor as accepted by `cl-typep', which see." | 3823 | TYPE is a type descriptor as accepted by `cl-typep', which see." |
| 3821 | `(pred (pcase--flip cl-typep ',type))) | 3824 | `(pred (cl-typep _ ',type))) |
| 3825 | |||
| 3822 | 3826 | ||
| 3823 | ;; Local variables: | 3827 | ;; Local variables: |
| 3824 | ;; generated-autoload-file: "cl-loaddefs.el" | 3828 | ;; generated-autoload-file: "cl-loaddefs.el" |
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 0b30e10b344..fb06b127676 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el | |||
| @@ -62,7 +62,7 @@ | |||
| 62 | tree-sitter-parser user-ptr font-object font-entity font-spec | 62 | tree-sitter-parser user-ptr font-object font-entity font-spec |
| 63 | condvar mutex thread terminal hash-table frame buffer function | 63 | condvar mutex thread terminal hash-table frame buffer function |
| 64 | window process window-configuration overlay integer-or-marker | 64 | window process window-configuration overlay integer-or-marker |
| 65 | number-or-marker symbol array) | 65 | number-or-marker symbol array obarray) |
| 66 | (number float integer) | 66 | (number float integer) |
| 67 | (number-or-marker marker number) | 67 | (number-or-marker marker number) |
| 68 | (integer bignum fixnum) | 68 | (integer bignum fixnum) |
diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 6ba9664ea5c..221f819e474 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el | |||
| @@ -240,7 +240,8 @@ Used to modify the compiler environment." | |||
| 240 | (integer-or-marker-p (function (t) boolean)) | 240 | (integer-or-marker-p (function (t) boolean)) |
| 241 | (integerp (function (t) boolean)) | 241 | (integerp (function (t) boolean)) |
| 242 | (interactive-p (function () boolean)) | 242 | (interactive-p (function () boolean)) |
| 243 | (intern-soft (function ((or string symbol) &optional vector) symbol)) | 243 | (intern-soft (function ((or string symbol) &optional (or obarray vector)) |
| 244 | symbol)) | ||
| 244 | (invocation-directory (function () string)) | 245 | (invocation-directory (function () string)) |
| 245 | (invocation-name (function () string)) | 246 | (invocation-name (function () string)) |
| 246 | (isnan (function (float) boolean)) | 247 | (isnan (function (float) boolean)) |
| @@ -309,7 +310,7 @@ Used to modify the compiler environment." | |||
| 309 | (numberp (function (t) boolean)) | 310 | (numberp (function (t) boolean)) |
| 310 | (one-window-p (function (&optional t t) boolean)) | 311 | (one-window-p (function (&optional t t) boolean)) |
| 311 | (overlayp (function (t) boolean)) | 312 | (overlayp (function (t) boolean)) |
| 312 | (parse-colon-path (function (string) cons)) | 313 | (parse-colon-path (function (string) list)) |
| 313 | (plist-get (function (list t &optional t) t)) | 314 | (plist-get (function (list t &optional t) t)) |
| 314 | (plist-member (function (list t &optional t) list)) | 315 | (plist-member (function (list t &optional t) list)) |
| 315 | (point (function () integer)) | 316 | (point (function () integer)) |
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 0a8b3b7efb2..55d92841cd5 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el | |||
| @@ -44,7 +44,7 @@ | |||
| 44 | ;; TODO can we just add t in `cl--typeof-types'? | 44 | ;; TODO can we just add t in `cl--typeof-types'? |
| 45 | "Like `cl--typeof-types' but with t as common supertype.") | 45 | "Like `cl--typeof-types' but with t as common supertype.") |
| 46 | 46 | ||
| 47 | (cl-defstruct (comp-cstr (:constructor comp-type-to-cstr | 47 | (cl-defstruct (comp-cstr (:constructor comp--type-to-cstr |
| 48 | (type &aux | 48 | (type &aux |
| 49 | (null (eq type 'null)) | 49 | (null (eq type 'null)) |
| 50 | (integer (eq type 'integer)) | 50 | (integer (eq type 'integer)) |
| @@ -55,7 +55,7 @@ | |||
| 55 | '(nil))) | 55 | '(nil))) |
| 56 | (range (when integer | 56 | (range (when integer |
| 57 | '((- . +)))))) | 57 | '((- . +)))))) |
| 58 | (:constructor comp-value-to-cstr | 58 | (:constructor comp--value-to-cstr |
| 59 | (value &aux | 59 | (value &aux |
| 60 | (integer (integerp value)) | 60 | (integer (integerp value)) |
| 61 | (valset (unless integer | 61 | (valset (unless integer |
| @@ -63,7 +63,7 @@ | |||
| 63 | (range (when integer | 63 | (range (when integer |
| 64 | `((,value . ,value)))) | 64 | `((,value . ,value)))) |
| 65 | (typeset ()))) | 65 | (typeset ()))) |
| 66 | (:constructor comp-irange-to-cstr | 66 | (:constructor comp--irange-to-cstr |
| 67 | (irange &aux | 67 | (irange &aux |
| 68 | (range (list irange)) | 68 | (range (list irange)) |
| 69 | (typeset ()))) | 69 | (typeset ()))) |
| @@ -229,10 +229,10 @@ Return them as multiple value." | |||
| 229 | ;; builds. | 229 | ;; builds. |
| 230 | (defvar comp-ctxt nil) | 230 | (defvar comp-ctxt nil) |
| 231 | 231 | ||
| 232 | (defvar comp-cstr-one (comp-value-to-cstr 1) | 232 | (defvar comp-cstr-one (comp--value-to-cstr 1) |
| 233 | "Represent the integer immediate one.") | 233 | "Represent the integer immediate one.") |
| 234 | 234 | ||
| 235 | (defvar comp-cstr-t (comp-type-to-cstr t) | 235 | (defvar comp-cstr-t (comp--type-to-cstr t) |
| 236 | "Represent the superclass t.") | 236 | "Represent the superclass t.") |
| 237 | 237 | ||
| 238 | 238 | ||
| @@ -249,6 +249,8 @@ Return them as multiple value." | |||
| 249 | t) | 249 | t) |
| 250 | ((and (not (symbolp x)) (symbolp y)) | 250 | ((and (not (symbolp x)) (symbolp y)) |
| 251 | nil) | 251 | nil) |
| 252 | ((or (consp x) (consp y) | ||
| 253 | nil)) | ||
| 252 | (t | 254 | (t |
| 253 | (< (sxhash-equal x) | 255 | (< (sxhash-equal x) |
| 254 | (sxhash-equal y))))))) | 256 | (sxhash-equal y))))))) |
| @@ -1211,14 +1213,14 @@ FN non-nil indicates we are parsing a function lambda list." | |||
| 1211 | ('nil | 1213 | ('nil |
| 1212 | (make-comp-cstr :typeset ())) | 1214 | (make-comp-cstr :typeset ())) |
| 1213 | ('fixnum | 1215 | ('fixnum |
| 1214 | (comp-irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum))) | 1216 | (comp--irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum))) |
| 1215 | ('boolean | 1217 | ('boolean |
| 1216 | (comp-type-spec-to-cstr '(member t nil))) | 1218 | (comp-type-spec-to-cstr '(member t nil))) |
| 1217 | ('integer | 1219 | ('integer |
| 1218 | (comp-irange-to-cstr '(- . +))) | 1220 | (comp--irange-to-cstr '(- . +))) |
| 1219 | ('null (comp-value-to-cstr nil)) | 1221 | ('null (comp--value-to-cstr nil)) |
| 1220 | ((pred atom) | 1222 | ((pred atom) |
| 1221 | (comp-type-to-cstr type-spec)) | 1223 | (comp--type-to-cstr type-spec)) |
| 1222 | (`(or . ,rest) | 1224 | (`(or . ,rest) |
| 1223 | (apply #'comp-cstr-union-make | 1225 | (apply #'comp-cstr-union-make |
| 1224 | (mapcar #'comp-type-spec-to-cstr rest))) | 1226 | (mapcar #'comp-type-spec-to-cstr rest))) |
| @@ -1228,16 +1230,16 @@ FN non-nil indicates we are parsing a function lambda list." | |||
| 1228 | (`(not ,cstr) | 1230 | (`(not ,cstr) |
| 1229 | (comp-cstr-negation-make (comp-type-spec-to-cstr cstr))) | 1231 | (comp-cstr-negation-make (comp-type-spec-to-cstr cstr))) |
| 1230 | (`(integer ,(and (pred integerp) l) ,(and (pred integerp) h)) | 1232 | (`(integer ,(and (pred integerp) l) ,(and (pred integerp) h)) |
| 1231 | (comp-irange-to-cstr `(,l . ,h))) | 1233 | (comp--irange-to-cstr `(,l . ,h))) |
| 1232 | (`(integer * ,(and (pred integerp) h)) | 1234 | (`(integer * ,(and (pred integerp) h)) |
| 1233 | (comp-irange-to-cstr `(- . ,h))) | 1235 | (comp--irange-to-cstr `(- . ,h))) |
| 1234 | (`(integer ,(and (pred integerp) l) *) | 1236 | (`(integer ,(and (pred integerp) l) *) |
| 1235 | (comp-irange-to-cstr `(,l . +))) | 1237 | (comp--irange-to-cstr `(,l . +))) |
| 1236 | (`(float ,(pred comp-star-or-num-p) ,(pred comp-star-or-num-p)) | 1238 | (`(float ,(pred comp-star-or-num-p) ,(pred comp-star-or-num-p)) |
| 1237 | ;; No float range support :/ | 1239 | ;; No float range support :/ |
| 1238 | (comp-type-to-cstr 'float)) | 1240 | (comp--type-to-cstr 'float)) |
| 1239 | (`(member . ,rest) | 1241 | (`(member . ,rest) |
| 1240 | (apply #'comp-cstr-union-make (mapcar #'comp-value-to-cstr rest))) | 1242 | (apply #'comp-cstr-union-make (mapcar #'comp--value-to-cstr rest))) |
| 1241 | (`(function ,args ,ret) | 1243 | (`(function ,args ,ret) |
| 1242 | (make-comp-cstr-f | 1244 | (make-comp-cstr-f |
| 1243 | :args (mapcar (lambda (x) | 1245 | :args (mapcar (lambda (x) |
diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 5d1a193269d..8fcbe31cf0b 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el | |||
| @@ -25,7 +25,7 @@ | |||
| 25 | 25 | ||
| 26 | ;; While the main native compiler is implemented in comp.el, when | 26 | ;; While the main native compiler is implemented in comp.el, when |
| 27 | ;; commonly used as a jit compiler it is only loaded by Emacs sub | 27 | ;; commonly used as a jit compiler it is only loaded by Emacs sub |
| 28 | ;; processes performing async compilation. This files contains all | 28 | ;; processes performing async compilation. This file contains all |
| 29 | ;; the code needed to drive async compilations and any Lisp code | 29 | ;; the code needed to drive async compilations and any Lisp code |
| 30 | ;; needed at runtime to run native code. | 30 | ;; needed at runtime to run native code. |
| 31 | 31 | ||
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 8441b228898..21e2bb01ed0 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el | |||
| @@ -43,7 +43,7 @@ | |||
| 43 | (defvar native-comp-eln-load-path) | 43 | (defvar native-comp-eln-load-path) |
| 44 | (defvar native-comp-enable-subr-trampolines) | 44 | (defvar native-comp-enable-subr-trampolines) |
| 45 | 45 | ||
| 46 | (declare-function comp--compile-ctxt-to-file "comp.c") | 46 | (declare-function comp--compile-ctxt-to-file0 "comp.c") |
| 47 | (declare-function comp--init-ctxt "comp.c") | 47 | (declare-function comp--init-ctxt "comp.c") |
| 48 | (declare-function comp--release-ctxt "comp.c") | 48 | (declare-function comp--release-ctxt "comp.c") |
| 49 | (declare-function comp-el-to-eln-filename "comp.c") | 49 | (declare-function comp-el-to-eln-filename "comp.c") |
| @@ -68,7 +68,7 @@ | |||
| 68 | :safe #'integerp | 68 | :safe #'integerp |
| 69 | :version "28.1") | 69 | :version "28.1") |
| 70 | 70 | ||
| 71 | (defcustom native-comp-debug 0 | 71 | (defcustom native-comp-debug 0 |
| 72 | "Debug level for native compilation, a number between 0 and 3. | 72 | "Debug level for native compilation, a number between 0 and 3. |
| 73 | This is intended for debugging the compiler itself. | 73 | This is intended for debugging the compiler itself. |
| 74 | 0 no debug output. | 74 | 0 no debug output. |
| @@ -155,17 +155,18 @@ native compilation runs.") | |||
| 155 | "Current allocation class. | 155 | "Current allocation class. |
| 156 | Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") | 156 | Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") |
| 157 | 157 | ||
| 158 | (defconst comp-passes '(comp-spill-lap | 158 | (defconst comp-passes '(comp--spill-lap |
| 159 | comp-limplify | 159 | comp--limplify |
| 160 | comp-fwprop | 160 | comp--fwprop |
| 161 | comp-call-optim | 161 | comp--call-optim |
| 162 | comp-ipa-pure | 162 | comp--ipa-pure |
| 163 | comp-add-cstrs | 163 | comp--add-cstrs |
| 164 | comp-fwprop | 164 | comp--fwprop |
| 165 | comp-tco | 165 | comp--tco |
| 166 | comp-fwprop | 166 | comp--fwprop |
| 167 | comp-remove-type-hints | 167 | comp--remove-type-hints |
| 168 | comp-final) | 168 | comp--compute-function-types |
| 169 | comp--final) | ||
| 169 | "Passes to be executed in order.") | 170 | "Passes to be executed in order.") |
| 170 | 171 | ||
| 171 | (defvar comp-disabled-passes '() | 172 | (defvar comp-disabled-passes '() |
| @@ -187,31 +188,42 @@ Useful to hook into pass checkers.") | |||
| 187 | finally return h) | 188 | finally return h) |
| 188 | "Hash table function -> `comp-constraint'.") | 189 | "Hash table function -> `comp-constraint'.") |
| 189 | 190 | ||
| 191 | ;; Keep it in sync with the `cl-deftype-satisfies' property set in | ||
| 192 | ;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the | ||
| 193 | ;; relation type <-> predicate is not bijective (bug#45576). | ||
| 190 | (defconst comp-known-predicates | 194 | (defconst comp-known-predicates |
| 191 | '((arrayp . array) | 195 | '((arrayp . array) |
| 192 | (atom . atom) | 196 | (atom . atom) |
| 193 | (characterp . fixnum) | ||
| 194 | (booleanp . boolean) | ||
| 195 | (bool-vector-p . bool-vector) | 197 | (bool-vector-p . bool-vector) |
| 198 | (booleanp . boolean) | ||
| 196 | (bufferp . buffer) | 199 | (bufferp . buffer) |
| 197 | (natnump . (integer 0 *)) | ||
| 198 | (char-table-p . char-table) | 200 | (char-table-p . char-table) |
| 199 | (hash-table-p . hash-table) | 201 | (characterp . fixnum) |
| 200 | (consp . cons) | 202 | (consp . cons) |
| 201 | (integerp . integer) | ||
| 202 | (floatp . float) | 203 | (floatp . float) |
| 204 | (framep . frame) | ||
| 203 | (functionp . (or function symbol)) | 205 | (functionp . (or function symbol)) |
| 206 | (hash-table-p . hash-table) | ||
| 207 | (integer-or-marker-p . integer-or-marker) | ||
| 204 | (integerp . integer) | 208 | (integerp . integer) |
| 205 | (keywordp . keyword) | 209 | (keywordp . keyword) |
| 206 | (listp . list) | 210 | (listp . list) |
| 207 | (numberp . number) | 211 | (markerp . marker) |
| 212 | (natnump . (integer 0 *)) | ||
| 208 | (null . null) | 213 | (null . null) |
| 214 | (number-or-marker-p . number-or-marker) | ||
| 209 | (numberp . number) | 215 | (numberp . number) |
| 216 | (numberp . number) | ||
| 217 | (obarrayp . obarray) | ||
| 218 | (overlayp . overlay) | ||
| 219 | (processp . process) | ||
| 210 | (sequencep . sequence) | 220 | (sequencep . sequence) |
| 211 | (stringp . string) | 221 | (stringp . string) |
| 222 | (subrp . subr) | ||
| 223 | (symbol-with-pos-p . symbol-with-pos) | ||
| 212 | (symbolp . symbol) | 224 | (symbolp . symbol) |
| 213 | (vectorp . vector) | 225 | (vectorp . vector) |
| 214 | (integer-or-marker-p . integer-or-marker)) | 226 | (windowp . window)) |
| 215 | "Alist predicate -> matched type specifier.") | 227 | "Alist predicate -> matched type specifier.") |
| 216 | 228 | ||
| 217 | (defconst comp-known-predicates-h | 229 | (defconst comp-known-predicates-h |
| @@ -388,7 +400,7 @@ This is typically for top-level forms other than defun.") | |||
| 388 | (closed nil :type boolean | 400 | (closed nil :type boolean |
| 389 | :documentation "t if closed.") | 401 | :documentation "t if closed.") |
| 390 | ;; All the following are for SSA and CGF analysis. | 402 | ;; All the following are for SSA and CGF analysis. |
| 391 | ;; Keep in sync with `comp-clean-ssa'!! | 403 | ;; Keep in sync with `comp--clean-ssa'!! |
| 392 | (in-edges () :type list | 404 | (in-edges () :type list |
| 393 | :documentation "List of incoming edges.") | 405 | :documentation "List of incoming edges.") |
| 394 | (out-edges () :type list | 406 | (out-edges () :type list |
| @@ -416,7 +428,7 @@ into it.") | |||
| 416 | :documentation "Start block LAP address.") | 428 | :documentation "Start block LAP address.") |
| 417 | (non-ret-insn nil :type list | 429 | (non-ret-insn nil :type list |
| 418 | :documentation "Insn known to perform a non local exit. | 430 | :documentation "Insn known to perform a non local exit. |
| 419 | `comp-fwprop' may identify and store here basic blocks performing | 431 | `comp--fwprop' may identify and store here basic blocks performing |
| 420 | non local exits and mark it rewrite it later.") | 432 | non local exits and mark it rewrite it later.") |
| 421 | (no-ret nil :type boolean | 433 | (no-ret nil :type boolean |
| 422 | :documentation "t when the block is known to perform a | 434 | :documentation "t when the block is known to perform a |
| @@ -507,7 +519,7 @@ CFG is mutated by a pass.") | |||
| 507 | (lambda-list nil :type list | 519 | (lambda-list nil :type list |
| 508 | :documentation "Original lambda-list.")) | 520 | :documentation "Original lambda-list.")) |
| 509 | 521 | ||
| 510 | (cl-defstruct (comp-mvar (:constructor make--comp-mvar) | 522 | (cl-defstruct (comp-mvar (:constructor make--comp-mvar0) |
| 511 | (:include comp-cstr)) | 523 | (:include comp-cstr)) |
| 512 | "A meta-variable being a slot in the meta-stack." | 524 | "A meta-variable being a slot in the meta-stack." |
| 513 | (id nil :type (or null number) | 525 | (id nil :type (or null number) |
| @@ -516,6 +528,7 @@ CFG is mutated by a pass.") | |||
| 516 | :documentation "Slot number in the array if a number or | 528 | :documentation "Slot number in the array if a number or |
| 517 | `scratch' for scratch slot.")) | 529 | `scratch' for scratch slot.")) |
| 518 | 530 | ||
| 531 | ;; In use by comp.c. | ||
| 519 | (defun comp-mvar-type-hint-match-p (mvar type-hint) | 532 | (defun comp-mvar-type-hint-match-p (mvar type-hint) |
| 520 | "Match MVAR against TYPE-HINT. | 533 | "Match MVAR against TYPE-HINT. |
| 521 | In use by the back-end." | 534 | In use by the back-end." |
| @@ -569,10 +582,9 @@ In use by the back-end." | |||
| 569 | finally return t) | 582 | finally return t) |
| 570 | t)) | 583 | t)) |
| 571 | 584 | ||
| 572 | (defsubst comp--symbol-func-to-fun (symbol-funcion) | 585 | (defsubst comp--symbol-func-to-fun (symbol-func) |
| 573 | "Given a function called SYMBOL-FUNCION return its `comp-func'." | 586 | "Given a function called SYMBOL-FUNC return its `comp-func'." |
| 574 | (gethash (gethash symbol-funcion (comp-ctxt-sym-to-c-name-h | 587 | (gethash (gethash symbol-func (comp-ctxt-sym-to-c-name-h comp-ctxt)) |
| 575 | comp-ctxt)) | ||
| 576 | (comp-ctxt-funcs-h comp-ctxt))) | 588 | (comp-ctxt-funcs-h comp-ctxt))) |
| 577 | 589 | ||
| 578 | (defun comp--function-pure-p (f) | 590 | (defun comp--function-pure-p (f) |
| @@ -637,7 +649,7 @@ VERBOSITY is a number between 0 and 3." | |||
| 637 | 649 | ||
| 638 | 650 | ||
| 639 | 651 | ||
| 640 | (defmacro comp-loop-insn-in-block (basic-block &rest body) | 652 | (defmacro comp--loop-insn-in-block (basic-block &rest body) |
| 641 | "Loop over all insns in BASIC-BLOCK executing BODY. | 653 | "Loop over all insns in BASIC-BLOCK executing BODY. |
| 642 | Inside BODY, `insn' and `insn-cell'can be used to read or set the | 654 | Inside BODY, `insn' and `insn-cell'can be used to read or set the |
| 643 | current instruction or its cell." | 655 | current instruction or its cell." |
| @@ -651,19 +663,19 @@ current instruction or its cell." | |||
| 651 | 663 | ||
| 652 | ;;; spill-lap pass specific code. | 664 | ;;; spill-lap pass specific code. |
| 653 | 665 | ||
| 654 | (defun comp-lex-byte-func-p (f) | 666 | (defun comp--lex-byte-func-p (f) |
| 655 | "Return t if F is a lexically-scoped byte compiled function." | 667 | "Return t if F is a lexically-scoped byte compiled function." |
| 656 | (and (byte-code-function-p f) | 668 | (and (byte-code-function-p f) |
| 657 | (fixnump (aref f 0)))) | 669 | (fixnump (aref f 0)))) |
| 658 | 670 | ||
| 659 | (defun comp-spill-decl-spec (function-name spec) | 671 | (defun comp--spill-decl-spec (function-name spec) |
| 660 | "Return the declared specifier SPEC for FUNCTION-NAME." | 672 | "Return the declared specifier SPEC for FUNCTION-NAME." |
| 661 | (plist-get (cdr (assq function-name byte-to-native-plist-environment)) | 673 | (plist-get (cdr (assq function-name byte-to-native-plist-environment)) |
| 662 | spec)) | 674 | spec)) |
| 663 | 675 | ||
| 664 | (defun comp-spill-speed (function-name) | 676 | (defun comp--spill-speed (function-name) |
| 665 | "Return the speed for FUNCTION-NAME." | 677 | "Return the speed for FUNCTION-NAME." |
| 666 | (or (comp-spill-decl-spec function-name 'speed) | 678 | (or (comp--spill-decl-spec function-name 'speed) |
| 667 | (comp-ctxt-speed comp-ctxt))) | 679 | (comp-ctxt-speed comp-ctxt))) |
| 668 | 680 | ||
| 669 | ;; Autoloaded as might be used by `disassemble-internal'. | 681 | ;; Autoloaded as might be used by `disassemble-internal'. |
| @@ -702,7 +714,7 @@ clashes." | |||
| 702 | ;; pick the first one. | 714 | ;; pick the first one. |
| 703 | (concat prefix crypted "_" human-readable "_0")))) | 715 | (concat prefix crypted "_" human-readable "_0")))) |
| 704 | 716 | ||
| 705 | (defun comp-decrypt-arg-list (x function-name) | 717 | (defun comp--decrypt-arg-list (x function-name) |
| 706 | "Decrypt argument list X for FUNCTION-NAME." | 718 | "Decrypt argument list X for FUNCTION-NAME." |
| 707 | (unless (fixnump x) | 719 | (unless (fixnump x) |
| 708 | (signal 'native-compiler-error-dyn-func (list function-name))) | 720 | (signal 'native-compiler-error-dyn-func (list function-name))) |
| @@ -717,21 +729,21 @@ clashes." | |||
| 717 | :nonrest nonrest | 729 | :nonrest nonrest |
| 718 | :rest rest)))) | 730 | :rest rest)))) |
| 719 | 731 | ||
| 720 | (defsubst comp-byte-frame-size (byte-compiled-func) | 732 | (defsubst comp--byte-frame-size (byte-compiled-func) |
| 721 | "Return the frame size to be allocated for BYTE-COMPILED-FUNC." | 733 | "Return the frame size to be allocated for BYTE-COMPILED-FUNC." |
| 722 | (aref byte-compiled-func 3)) | 734 | (aref byte-compiled-func 3)) |
| 723 | 735 | ||
| 724 | (defun comp-add-func-to-ctxt (func) | 736 | (defun comp--add-func-to-ctxt (func) |
| 725 | "Add FUNC to the current compiler context." | 737 | "Add FUNC to the current compiler context." |
| 726 | (let ((name (comp-func-name func)) | 738 | (let ((name (comp-func-name func)) |
| 727 | (c-name (comp-func-c-name func))) | 739 | (c-name (comp-func-c-name func))) |
| 728 | (puthash name c-name (comp-ctxt-sym-to-c-name-h comp-ctxt)) | 740 | (puthash name c-name (comp-ctxt-sym-to-c-name-h comp-ctxt)) |
| 729 | (puthash c-name func (comp-ctxt-funcs-h comp-ctxt)))) | 741 | (puthash c-name func (comp-ctxt-funcs-h comp-ctxt)))) |
| 730 | 742 | ||
| 731 | (cl-defgeneric comp-spill-lap-function (input) | 743 | (cl-defgeneric comp--spill-lap-function (input) |
| 732 | "Byte-compile INPUT and spill lap for further stages.") | 744 | "Byte-compile INPUT and spill lap for further stages.") |
| 733 | 745 | ||
| 734 | (cl-defmethod comp-spill-lap-function ((function-name symbol)) | 746 | (cl-defmethod comp--spill-lap-function ((function-name symbol)) |
| 735 | "Byte-compile FUNCTION-NAME, spilling data from the byte compiler." | 747 | "Byte-compile FUNCTION-NAME, spilling data from the byte compiler." |
| 736 | (unless (comp-ctxt-output comp-ctxt) | 748 | (unless (comp-ctxt-output comp-ctxt) |
| 737 | (setf (comp-ctxt-output comp-ctxt) | 749 | (setf (comp-ctxt-output comp-ctxt) |
| @@ -747,9 +759,9 @@ clashes." | |||
| 747 | (list (make-byte-to-native-func-def :name function-name | 759 | (list (make-byte-to-native-func-def :name function-name |
| 748 | :c-name c-name | 760 | :c-name c-name |
| 749 | :byte-func byte-code))) | 761 | :byte-func byte-code))) |
| 750 | (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))) | 762 | (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) |
| 751 | 763 | ||
| 752 | (cl-defmethod comp-spill-lap-function ((form list)) | 764 | (cl-defmethod comp--spill-lap-function ((form list)) |
| 753 | "Byte-compile FORM, spilling data from the byte compiler." | 765 | "Byte-compile FORM, spilling data from the byte compiler." |
| 754 | (unless (memq (car-safe form) '(lambda closure)) | 766 | (unless (memq (car-safe form) '(lambda closure)) |
| 755 | (signal 'native-compiler-error | 767 | (signal 'native-compiler-error |
| @@ -763,9 +775,9 @@ clashes." | |||
| 763 | (list (make-byte-to-native-func-def :name '--anonymous-lambda | 775 | (list (make-byte-to-native-func-def :name '--anonymous-lambda |
| 764 | :c-name c-name | 776 | :c-name c-name |
| 765 | :byte-func byte-code))) | 777 | :byte-func byte-code))) |
| 766 | (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))) | 778 | (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) |
| 767 | 779 | ||
| 768 | (defun comp-intern-func-in-ctxt (_ obj) | 780 | (defun comp--intern-func-in-ctxt (_ obj) |
| 769 | "Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'." | 781 | "Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'." |
| 770 | (when-let ((byte-func (byte-to-native-lambda-byte-func obj))) | 782 | (when-let ((byte-func (byte-to-native-lambda-byte-func obj))) |
| 771 | (let* ((lap (byte-to-native-lambda-lap obj)) | 783 | (let* ((lap (byte-to-native-lambda-lap obj)) |
| @@ -778,9 +790,9 @@ clashes." | |||
| 778 | (name (when top-l-form | 790 | (name (when top-l-form |
| 779 | (byte-to-native-func-def-name top-l-form))) | 791 | (byte-to-native-func-def-name top-l-form))) |
| 780 | (c-name (comp-c-func-name (or name "anonymous-lambda") "F")) | 792 | (c-name (comp-c-func-name (or name "anonymous-lambda") "F")) |
| 781 | (func (if (comp-lex-byte-func-p byte-func) | 793 | (func (if (comp--lex-byte-func-p byte-func) |
| 782 | (make-comp-func-l | 794 | (make-comp-func-l |
| 783 | :args (comp-decrypt-arg-list (aref byte-func 0) | 795 | :args (comp--decrypt-arg-list (aref byte-func 0) |
| 784 | name)) | 796 | name)) |
| 785 | (make-comp-func-d :lambda-list (aref byte-func 0))))) | 797 | (make-comp-func-d :lambda-list (aref byte-func 0))))) |
| 786 | (setf (comp-func-name func) name | 798 | (setf (comp-func-name func) name |
| @@ -790,9 +802,9 @@ clashes." | |||
| 790 | (comp-func-command-modes func) (command-modes byte-func) | 802 | (comp-func-command-modes func) (command-modes byte-func) |
| 791 | (comp-func-c-name func) c-name | 803 | (comp-func-c-name func) c-name |
| 792 | (comp-func-lap func) lap | 804 | (comp-func-lap func) lap |
| 793 | (comp-func-frame-size func) (comp-byte-frame-size byte-func) | 805 | (comp-func-frame-size func) (comp--byte-frame-size byte-func) |
| 794 | (comp-func-speed func) (comp-spill-speed name) | 806 | (comp-func-speed func) (comp--spill-speed name) |
| 795 | (comp-func-pure func) (comp-spill-decl-spec name 'pure)) | 807 | (comp-func-pure func) (comp--spill-decl-spec name 'pure)) |
| 796 | 808 | ||
| 797 | ;; Store the c-name to have it retrievable from | 809 | ;; Store the c-name to have it retrievable from |
| 798 | ;; `comp-ctxt-top-level-forms'. | 810 | ;; `comp-ctxt-top-level-forms'. |
| @@ -800,11 +812,11 @@ clashes." | |||
| 800 | (setf (byte-to-native-func-def-c-name top-l-form) c-name)) | 812 | (setf (byte-to-native-func-def-c-name top-l-form) c-name)) |
| 801 | (unless name | 813 | (unless name |
| 802 | (puthash byte-func func (comp-ctxt-byte-func-to-func-h comp-ctxt))) | 814 | (puthash byte-func func (comp-ctxt-byte-func-to-func-h comp-ctxt))) |
| 803 | (comp-add-func-to-ctxt func) | 815 | (comp--add-func-to-ctxt func) |
| 804 | (comp-log (format "Function %s:\n" name) 1) | 816 | (comp-log (format "Function %s:\n" name) 1) |
| 805 | (comp-log lap 1 t)))) | 817 | (comp-log lap 1 t)))) |
| 806 | 818 | ||
| 807 | (cl-defmethod comp-spill-lap-function ((filename string)) | 819 | (cl-defmethod comp--spill-lap-function ((filename string)) |
| 808 | "Byte-compile FILENAME, spilling data from the byte compiler." | 820 | "Byte-compile FILENAME, spilling data from the byte compiler." |
| 809 | (byte-compile-file filename) | 821 | (byte-compile-file filename) |
| 810 | (when (or (null byte-native-qualities) | 822 | (when (or (null byte-native-qualities) |
| @@ -829,7 +841,7 @@ clashes." | |||
| 829 | collect | 841 | collect |
| 830 | (if (and (byte-to-native-func-def-p form) | 842 | (if (and (byte-to-native-func-def-p form) |
| 831 | (eq -1 | 843 | (eq -1 |
| 832 | (comp-spill-speed (byte-to-native-func-def-name form)))) | 844 | (comp--spill-speed (byte-to-native-func-def-name form)))) |
| 833 | (let ((byte-code (byte-to-native-func-def-byte-func form))) | 845 | (let ((byte-code (byte-to-native-func-def-byte-func form))) |
| 834 | (remhash byte-code byte-to-native-lambdas-h) | 846 | (remhash byte-code byte-to-native-lambdas-h) |
| 835 | (make-byte-to-native-top-level | 847 | (make-byte-to-native-top-level |
| @@ -837,11 +849,11 @@ clashes." | |||
| 837 | ',(byte-to-native-func-def-name form) | 849 | ',(byte-to-native-func-def-name form) |
| 838 | ,byte-code | 850 | ,byte-code |
| 839 | nil) | 851 | nil) |
| 840 | :lexical (comp-lex-byte-func-p byte-code))) | 852 | :lexical (comp--lex-byte-func-p byte-code))) |
| 841 | form))) | 853 | form))) |
| 842 | (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)) | 854 | (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)) |
| 843 | 855 | ||
| 844 | (defun comp-spill-lap (input) | 856 | (defun comp--spill-lap (input) |
| 845 | "Byte-compile and spill the LAP representation for INPUT. | 857 | "Byte-compile and spill the LAP representation for INPUT. |
| 846 | If INPUT is a symbol, it is the function-name to be compiled. | 858 | If INPUT is a symbol, it is the function-name to be compiled. |
| 847 | If INPUT is a string, it is the filename to be compiled." | 859 | If INPUT is a string, it is the filename to be compiled." |
| @@ -849,7 +861,7 @@ If INPUT is a string, it is the filename to be compiled." | |||
| 849 | (byte-to-native-lambdas-h (make-hash-table :test #'eq)) | 861 | (byte-to-native-lambdas-h (make-hash-table :test #'eq)) |
| 850 | (byte-to-native-top-level-forms ()) | 862 | (byte-to-native-top-level-forms ()) |
| 851 | (byte-to-native-plist-environment ()) | 863 | (byte-to-native-plist-environment ()) |
| 852 | (res (comp-spill-lap-function input))) | 864 | (res (comp--spill-lap-function input))) |
| 853 | (comp-cstr-ctxt-update-type-slots comp-ctxt) | 865 | (comp-cstr-ctxt-update-type-slots comp-ctxt) |
| 854 | res)) | 866 | res)) |
| 855 | 867 | ||
| @@ -878,55 +890,55 @@ Points to the next slot to be filled.") | |||
| 878 | byte-switch byte-pushconditioncase) | 890 | byte-switch byte-pushconditioncase) |
| 879 | "LAP end of basic blocks op codes.") | 891 | "LAP end of basic blocks op codes.") |
| 880 | 892 | ||
| 881 | (defun comp-lap-eob-p (inst) | 893 | (defun comp--lap-eob-p (inst) |
| 882 | "Return t if INST closes the current basic blocks, nil otherwise." | 894 | "Return t if INST closes the current basic blocks, nil otherwise." |
| 883 | (when (memq (car inst) comp-lap-eob-ops) | 895 | (when (memq (car inst) comp-lap-eob-ops) |
| 884 | t)) | 896 | t)) |
| 885 | 897 | ||
| 886 | (defun comp-lap-fall-through-p (inst) | 898 | (defun comp--lap-fall-through-p (inst) |
| 887 | "Return t if INST falls through, nil otherwise." | 899 | "Return t if INST falls through, nil otherwise." |
| 888 | (when (not (memq (car inst) '(byte-goto byte-return))) | 900 | (when (not (memq (car inst) '(byte-goto byte-return))) |
| 889 | t)) | 901 | t)) |
| 890 | 902 | ||
| 891 | (defsubst comp-sp () | 903 | (defsubst comp--sp () |
| 892 | "Current stack pointer." | 904 | "Current stack pointer." |
| 893 | (declare (gv-setter (lambda (val) | 905 | (declare (gv-setter (lambda (val) |
| 894 | `(setf (comp-limplify-sp comp-pass) ,val)))) | 906 | `(setf (comp-limplify-sp comp-pass) ,val)))) |
| 895 | (comp-limplify-sp comp-pass)) | 907 | (comp-limplify-sp comp-pass)) |
| 896 | 908 | ||
| 897 | (defmacro comp-with-sp (sp &rest body) | 909 | (defmacro comp--with-sp (sp &rest body) |
| 898 | "Execute BODY setting the stack pointer to SP. | 910 | "Execute BODY setting the stack pointer to SP. |
| 899 | Restore the original value afterwards." | 911 | Restore the original value afterwards." |
| 900 | (declare (debug (form body)) | 912 | (declare (debug (form body)) |
| 901 | (indent defun)) | 913 | (indent defun)) |
| 902 | (let ((sym (gensym))) | 914 | (let ((sym (gensym))) |
| 903 | `(let ((,sym (comp-sp))) | 915 | `(let ((,sym (comp--sp))) |
| 904 | (setf (comp-sp) ,sp) | 916 | (setf (comp--sp) ,sp) |
| 905 | (progn ,@body) | 917 | (progn ,@body) |
| 906 | (setf (comp-sp) ,sym)))) | 918 | (setf (comp--sp) ,sym)))) |
| 907 | 919 | ||
| 908 | (defsubst comp-slot-n (n) | 920 | (defsubst comp--slot-n (n) |
| 909 | "Slot N into the meta-stack." | 921 | "Slot N into the meta-stack." |
| 910 | (comp-vec-aref (comp-limplify-frame comp-pass) n)) | 922 | (comp-vec-aref (comp-limplify-frame comp-pass) n)) |
| 911 | 923 | ||
| 912 | (defsubst comp-slot () | 924 | (defsubst comp--slot () |
| 913 | "Current slot into the meta-stack pointed by sp." | 925 | "Current slot into the meta-stack pointed by sp." |
| 914 | (comp-slot-n (comp-sp))) | 926 | (comp--slot-n (comp--sp))) |
| 915 | 927 | ||
| 916 | (defsubst comp-slot+1 () | 928 | (defsubst comp--slot+1 () |
| 917 | "Slot into the meta-stack pointed by sp + 1." | 929 | "Slot into the meta-stack pointed by sp + 1." |
| 918 | (comp-slot-n (1+ (comp-sp)))) | 930 | (comp--slot-n (1+ (comp--sp)))) |
| 919 | 931 | ||
| 920 | (defsubst comp-label-to-addr (label) | 932 | (defsubst comp--label-to-addr (label) |
| 921 | "Find the address of LABEL." | 933 | "Find the address of LABEL." |
| 922 | (or (gethash label (comp-limplify-label-to-addr comp-pass)) | 934 | (or (gethash label (comp-limplify-label-to-addr comp-pass)) |
| 923 | (signal 'native-ice (list "label not found" label)))) | 935 | (signal 'native-ice (list "label not found" label)))) |
| 924 | 936 | ||
| 925 | (defsubst comp-mark-curr-bb-closed () | 937 | (defsubst comp--mark-curr-bb-closed () |
| 926 | "Mark the current basic block as closed." | 938 | "Mark the current basic block as closed." |
| 927 | (setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t)) | 939 | (setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t)) |
| 928 | 940 | ||
| 929 | (defun comp-bb-maybe-add (lap-addr &optional sp) | 941 | (defun comp--bb-maybe-add (lap-addr &optional sp) |
| 930 | "If necessary create a pending basic block for LAP-ADDR with stack depth SP. | 942 | "If necessary create a pending basic block for LAP-ADDR with stack depth SP. |
| 931 | The basic block is returned regardless it was already declared or not." | 943 | The basic block is returned regardless it was already declared or not." |
| 932 | (let ((bb (or (cl-loop ; See if the block was already limplified. | 944 | (let ((bb (or (cl-loop ; See if the block was already limplified. |
| @@ -944,24 +956,24 @@ The basic block is returned regardless it was already declared or not." | |||
| 944 | (signal 'native-ice (list "incoherent stack pointers" | 956 | (signal 'native-ice (list "incoherent stack pointers" |
| 945 | sp (comp-block-lap-sp bb)))) | 957 | sp (comp-block-lap-sp bb)))) |
| 946 | bb) | 958 | bb) |
| 947 | (car (push (make--comp-block-lap lap-addr sp (comp-new-block-sym)) | 959 | (car (push (make--comp-block-lap lap-addr sp (comp--new-block-sym)) |
| 948 | (comp-limplify-pending-blocks comp-pass)))))) | 960 | (comp-limplify-pending-blocks comp-pass)))))) |
| 949 | 961 | ||
| 950 | (defsubst comp-call (func &rest args) | 962 | (defsubst comp--call (func &rest args) |
| 951 | "Emit a call for function FUNC with ARGS." | 963 | "Emit a call for function FUNC with ARGS." |
| 952 | `(call ,func ,@args)) | 964 | `(call ,func ,@args)) |
| 953 | 965 | ||
| 954 | (defun comp-callref (func nargs stack-off) | 966 | (defun comp--callref (func nargs stack-off) |
| 955 | "Emit a call using narg abi for FUNC. | 967 | "Emit a call using narg abi for FUNC. |
| 956 | NARGS is the number of arguments. | 968 | NARGS is the number of arguments. |
| 957 | STACK-OFF is the index of the first slot frame involved." | 969 | STACK-OFF is the index of the first slot frame involved." |
| 958 | `(callref ,func ,@(cl-loop repeat nargs | 970 | `(callref ,func ,@(cl-loop repeat nargs |
| 959 | for sp from stack-off | 971 | for sp from stack-off |
| 960 | collect (comp-slot-n sp)))) | 972 | collect (comp--slot-n sp)))) |
| 961 | 973 | ||
| 962 | (cl-defun make-comp-mvar (&key slot (constant nil const-vld) type neg) | 974 | (cl-defun make--comp-mvar (&key slot (constant nil const-vld) type neg) |
| 963 | "`comp-mvar' initializer." | 975 | "`comp-mvar' initializer." |
| 964 | (let ((mvar (make--comp-mvar :slot slot))) | 976 | (let ((mvar (make--comp-mvar0 :slot slot))) |
| 965 | (when const-vld | 977 | (when const-vld |
| 966 | (comp--add-const-to-relocs constant) | 978 | (comp--add-const-to-relocs constant) |
| 967 | (setf (comp-cstr-imm mvar) constant)) | 979 | (setf (comp-cstr-imm mvar) constant)) |
| @@ -971,49 +983,49 @@ STACK-OFF is the index of the first slot frame involved." | |||
| 971 | (setf (comp-mvar-neg mvar) t)) | 983 | (setf (comp-mvar-neg mvar) t)) |
| 972 | mvar)) | 984 | mvar)) |
| 973 | 985 | ||
| 974 | (defun comp-new-frame (size vsize &optional ssa) | 986 | (defun comp--new-frame (size vsize &optional ssa) |
| 975 | "Return a clean frame of meta variables of size SIZE and VSIZE. | 987 | "Return a clean frame of meta variables of size SIZE and VSIZE. |
| 976 | If SSA is non-nil, populate it with m-var in ssa form." | 988 | If SSA is non-nil, populate it with m-var in ssa form." |
| 977 | (cl-loop with v = (make-comp-vec :beg (- vsize) :end size) | 989 | (cl-loop with v = (make-comp-vec :beg (- vsize) :end size) |
| 978 | for i from (- vsize) below size | 990 | for i from (- vsize) below size |
| 979 | for mvar = (if ssa | 991 | for mvar = (if ssa |
| 980 | (make-comp-ssa-mvar :slot i) | 992 | (make--comp--ssa-mvar :slot i) |
| 981 | (make-comp-mvar :slot i)) | 993 | (make--comp-mvar :slot i)) |
| 982 | do (setf (comp-vec-aref v i) mvar) | 994 | do (setf (comp-vec-aref v i) mvar) |
| 983 | finally return v)) | 995 | finally return v)) |
| 984 | 996 | ||
| 985 | (defun comp-emit (insn) | 997 | (defun comp--emit (insn) |
| 986 | "Emit INSN into basic block BB." | 998 | "Emit INSN into basic block BB." |
| 987 | (let ((bb (comp-limplify-curr-block comp-pass))) | 999 | (let ((bb (comp-limplify-curr-block comp-pass))) |
| 988 | (cl-assert (not (comp-block-closed bb))) | 1000 | (cl-assert (not (comp-block-closed bb))) |
| 989 | (push insn (comp-block-insns bb)))) | 1001 | (push insn (comp-block-insns bb)))) |
| 990 | 1002 | ||
| 991 | (defun comp-emit-set-call (call) | 1003 | (defun comp--emit-set-call (call) |
| 992 | "Emit CALL assigning the result to the current slot frame. | 1004 | "Emit CALL assigning the result to the current slot frame. |
| 993 | If the callee function is known to have a return type, propagate it." | 1005 | If the callee function is known to have a return type, propagate it." |
| 994 | (cl-assert call) | 1006 | (cl-assert call) |
| 995 | (comp-emit (list 'set (comp-slot) call))) | 1007 | (comp--emit (list 'set (comp--slot) call))) |
| 996 | 1008 | ||
| 997 | (defun comp-copy-slot (src-n &optional dst-n) | 1009 | (defun comp--copy-slot (src-n &optional dst-n) |
| 998 | "Set slot number DST-N to slot number SRC-N as source. | 1010 | "Set slot number DST-N to slot number SRC-N as source. |
| 999 | If DST-N is specified, use it; otherwise assume it to be the current slot." | 1011 | If DST-N is specified, use it; otherwise assume it to be the current slot." |
| 1000 | (comp-with-sp (or dst-n (comp-sp)) | 1012 | (comp--with-sp (or dst-n (comp--sp)) |
| 1001 | (let ((src-slot (comp-slot-n src-n))) | 1013 | (let ((src-slot (comp--slot-n src-n))) |
| 1002 | (cl-assert src-slot) | 1014 | (cl-assert src-slot) |
| 1003 | (comp-emit `(set ,(comp-slot) ,src-slot))))) | 1015 | (comp--emit `(set ,(comp--slot) ,src-slot))))) |
| 1004 | 1016 | ||
| 1005 | (defsubst comp-emit-annotation (str) | 1017 | (defsubst comp--emit-annotation (str) |
| 1006 | "Emit annotation STR." | 1018 | "Emit annotation STR." |
| 1007 | (comp-emit `(comment ,str))) | 1019 | (comp--emit `(comment ,str))) |
| 1008 | 1020 | ||
| 1009 | (defsubst comp-emit-setimm (val) | 1021 | (defsubst comp--emit-setimm (val) |
| 1010 | "Set constant VAL to current slot." | 1022 | "Set constant VAL to current slot." |
| 1011 | (comp--add-const-to-relocs val) | 1023 | (comp--add-const-to-relocs val) |
| 1012 | ;; Leave relocation index nil on purpose, will be fixed-up in final | 1024 | ;; Leave relocation index nil on purpose, will be fixed-up in final |
| 1013 | ;; by `comp-finalize-relocs'. | 1025 | ;; by `comp-finalize-relocs'. |
| 1014 | (comp-emit `(setimm ,(comp-slot) ,val))) | 1026 | (comp--emit `(setimm ,(comp--slot) ,val))) |
| 1015 | 1027 | ||
| 1016 | (defun comp-make-curr-block (block-name entry-sp &optional addr) | 1028 | (defun comp--make-curr-block (block-name entry-sp &optional addr) |
| 1017 | "Create a basic block with BLOCK-NAME and set it as current block. | 1029 | "Create a basic block with BLOCK-NAME and set it as current block. |
| 1018 | ENTRY-SP is the sp value when entering. | 1030 | ENTRY-SP is the sp value when entering. |
| 1019 | Add block to the current function and return it." | 1031 | Add block to the current function and return it." |
| @@ -1025,104 +1037,104 @@ Add block to the current function and return it." | |||
| 1025 | (puthash (comp-block-name bb) bb (comp-func-blocks comp-func)) | 1037 | (puthash (comp-block-name bb) bb (comp-func-blocks comp-func)) |
| 1026 | bb)) | 1038 | bb)) |
| 1027 | 1039 | ||
| 1028 | (defun comp-latch-make-fill (target) | 1040 | (defun comp--latch-make-fill (target) |
| 1029 | "Create a latch pointing to TARGET and fill it. | 1041 | "Create a latch pointing to TARGET and fill it. |
| 1030 | Return the created latch." | 1042 | Return the created latch." |
| 1031 | (let ((latch (make-comp-latch :name (comp-new-block-sym "latch"))) | 1043 | (let ((latch (make-comp-latch :name (comp--new-block-sym "latch"))) |
| 1032 | (curr-bb (comp-limplify-curr-block comp-pass))) | 1044 | (curr-bb (comp-limplify-curr-block comp-pass))) |
| 1033 | ;; See `comp-make-curr-block'. | 1045 | ;; See `comp--make-curr-block'. |
| 1034 | (setf (comp-limplify-curr-block comp-pass) latch) | 1046 | (setf (comp-limplify-curr-block comp-pass) latch) |
| 1035 | (when (< (comp-func-speed comp-func) 3) | 1047 | (when (< (comp-func-speed comp-func) 3) |
| 1036 | ;; At speed 3 the programmer is responsible to manually | 1048 | ;; At speed 3 the programmer is responsible to manually |
| 1037 | ;; place `comp-maybe-gc-or-quit'. | 1049 | ;; place `comp-maybe-gc-or-quit'. |
| 1038 | (comp-emit '(call comp-maybe-gc-or-quit))) | 1050 | (comp--emit '(call comp-maybe-gc-or-quit))) |
| 1039 | ;; See `comp-emit-uncond-jump'. | 1051 | ;; See `comp--emit-uncond-jump'. |
| 1040 | (comp-emit `(jump ,(comp-block-name target))) | 1052 | (comp--emit `(jump ,(comp-block-name target))) |
| 1041 | (comp-mark-curr-bb-closed) | 1053 | (comp--mark-curr-bb-closed) |
| 1042 | (puthash (comp-block-name latch) latch (comp-func-blocks comp-func)) | 1054 | (puthash (comp-block-name latch) latch (comp-func-blocks comp-func)) |
| 1043 | (setf (comp-limplify-curr-block comp-pass) curr-bb) | 1055 | (setf (comp-limplify-curr-block comp-pass) curr-bb) |
| 1044 | latch)) | 1056 | latch)) |
| 1045 | 1057 | ||
| 1046 | (defun comp-emit-uncond-jump (lap-label) | 1058 | (defun comp--emit-uncond-jump (lap-label) |
| 1047 | "Emit an unconditional branch to LAP-LABEL." | 1059 | "Emit an unconditional branch to LAP-LABEL." |
| 1048 | (cl-destructuring-bind (label-num . stack-depth) lap-label | 1060 | (cl-destructuring-bind (label-num . stack-depth) lap-label |
| 1049 | (when stack-depth | 1061 | (when stack-depth |
| 1050 | (cl-assert (= (1- stack-depth) (comp-sp)))) | 1062 | (cl-assert (= (1- stack-depth) (comp--sp)))) |
| 1051 | (let* ((target-addr (comp-label-to-addr label-num)) | 1063 | (let* ((target-addr (comp--label-to-addr label-num)) |
| 1052 | (target (comp-bb-maybe-add target-addr | 1064 | (target (comp--bb-maybe-add target-addr |
| 1053 | (comp-sp))) | 1065 | (comp--sp))) |
| 1054 | (latch (when (< target-addr (comp-limplify-pc comp-pass)) | 1066 | (latch (when (< target-addr (comp-limplify-pc comp-pass)) |
| 1055 | (comp-latch-make-fill target))) | 1067 | (comp--latch-make-fill target))) |
| 1056 | (eff-target-name (comp-block-name (or latch target)))) | 1068 | (eff-target-name (comp-block-name (or latch target)))) |
| 1057 | (comp-emit `(jump ,eff-target-name)) | 1069 | (comp--emit `(jump ,eff-target-name)) |
| 1058 | (comp-mark-curr-bb-closed)))) | 1070 | (comp--mark-curr-bb-closed)))) |
| 1059 | 1071 | ||
| 1060 | (defun comp-emit-cond-jump (a b target-offset lap-label negated) | 1072 | (defun comp--emit-cond-jump (a b target-offset lap-label negated) |
| 1061 | "Emit a conditional jump to LAP-LABEL when A and B satisfy EQ. | 1073 | "Emit a conditional jump to LAP-LABEL when A and B satisfy EQ. |
| 1062 | TARGET-OFFSET is the positive offset on the SP when branching to the target | 1074 | TARGET-OFFSET is the positive offset on the SP when branching to the target |
| 1063 | block. | 1075 | block. |
| 1064 | If NEGATED is non null, negate the tested condition. | 1076 | If NEGATED is non null, negate the tested condition. |
| 1065 | Return value is the fall-through block name." | 1077 | Return value is the fall-through block name." |
| 1066 | (cl-destructuring-bind (label-num . label-sp) lap-label | 1078 | (cl-destructuring-bind (label-num . label-sp) lap-label |
| 1067 | (let* ((bb (comp-block-name (comp-bb-maybe-add | 1079 | (let* ((bb (comp-block-name (comp--bb-maybe-add |
| 1068 | (1+ (comp-limplify-pc comp-pass)) | 1080 | (1+ (comp-limplify-pc comp-pass)) |
| 1069 | (comp-sp)))) ; Fall through block. | 1081 | (comp--sp)))) ; Fall through block. |
| 1070 | (target-sp (+ target-offset (comp-sp))) | 1082 | (target-sp (+ target-offset (comp--sp))) |
| 1071 | (target-addr (comp-label-to-addr label-num)) | 1083 | (target-addr (comp--label-to-addr label-num)) |
| 1072 | (target (comp-bb-maybe-add target-addr target-sp)) | 1084 | (target (comp--bb-maybe-add target-addr target-sp)) |
| 1073 | (latch (when (< target-addr (comp-limplify-pc comp-pass)) | 1085 | (latch (when (< target-addr (comp-limplify-pc comp-pass)) |
| 1074 | (comp-latch-make-fill target))) | 1086 | (comp--latch-make-fill target))) |
| 1075 | (eff-target-name (comp-block-name (or latch target)))) | 1087 | (eff-target-name (comp-block-name (or latch target)))) |
| 1076 | (when label-sp | 1088 | (when label-sp |
| 1077 | (cl-assert (= (1- label-sp) (+ target-offset (comp-sp))))) | 1089 | (cl-assert (= (1- label-sp) (+ target-offset (comp--sp))))) |
| 1078 | (comp-emit (if negated | 1090 | (comp--emit (if negated |
| 1079 | (list 'cond-jump a b bb eff-target-name) | 1091 | (list 'cond-jump a b bb eff-target-name) |
| 1080 | (list 'cond-jump a b eff-target-name bb))) | 1092 | (list 'cond-jump a b eff-target-name bb))) |
| 1081 | (comp-mark-curr-bb-closed) | 1093 | (comp--mark-curr-bb-closed) |
| 1082 | bb))) | 1094 | bb))) |
| 1083 | 1095 | ||
| 1084 | (defun comp-emit-handler (lap-label handler-type) | 1096 | (defun comp--emit-handler (lap-label handler-type) |
| 1085 | "Emit a nonlocal-exit handler to LAP-LABEL of type HANDLER-TYPE." | 1097 | "Emit a nonlocal-exit handler to LAP-LABEL of type HANDLER-TYPE." |
| 1086 | (cl-destructuring-bind (label-num . label-sp) lap-label | 1098 | (cl-destructuring-bind (label-num . label-sp) lap-label |
| 1087 | (cl-assert (= (- label-sp 2) (comp-sp))) | 1099 | (cl-assert (= (- label-sp 2) (comp--sp))) |
| 1088 | (setf (comp-func-has-non-local comp-func) t) | 1100 | (setf (comp-func-has-non-local comp-func) t) |
| 1089 | (let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) | 1101 | (let* ((guarded-bb (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) |
| 1090 | (comp-sp))) | 1102 | (comp--sp))) |
| 1091 | (handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num) | 1103 | (handler-bb (comp--bb-maybe-add (comp--label-to-addr label-num) |
| 1092 | (1+ (comp-sp)))) | 1104 | (1+ (comp--sp)))) |
| 1093 | (pop-bb (make--comp-block-lap nil (comp-sp) (comp-new-block-sym)))) | 1105 | (pop-bb (make--comp-block-lap nil (comp--sp) (comp--new-block-sym)))) |
| 1094 | (comp-emit (list 'push-handler | 1106 | (comp--emit (list 'push-handler |
| 1095 | handler-type | 1107 | handler-type |
| 1096 | (comp-slot+1) | 1108 | (comp--slot+1) |
| 1097 | (comp-block-name pop-bb) | 1109 | (comp-block-name pop-bb) |
| 1098 | (comp-block-name guarded-bb))) | 1110 | (comp-block-name guarded-bb))) |
| 1099 | (comp-mark-curr-bb-closed) | 1111 | (comp--mark-curr-bb-closed) |
| 1100 | ;; Emit the basic block to pop the handler if we got the non local. | 1112 | ;; Emit the basic block to pop the handler if we got the non local. |
| 1101 | (puthash (comp-block-name pop-bb) pop-bb (comp-func-blocks comp-func)) | 1113 | (puthash (comp-block-name pop-bb) pop-bb (comp-func-blocks comp-func)) |
| 1102 | (setf (comp-limplify-curr-block comp-pass) pop-bb) | 1114 | (setf (comp-limplify-curr-block comp-pass) pop-bb) |
| 1103 | (comp-emit `(fetch-handler ,(comp-slot+1))) | 1115 | (comp--emit `(fetch-handler ,(comp--slot+1))) |
| 1104 | (comp-emit `(jump ,(comp-block-name handler-bb))) | 1116 | (comp--emit `(jump ,(comp-block-name handler-bb))) |
| 1105 | (comp-mark-curr-bb-closed)))) | 1117 | (comp--mark-curr-bb-closed)))) |
| 1106 | 1118 | ||
| 1107 | (defun comp-limplify-listn (n) | 1119 | (defun comp--limplify-listn (n) |
| 1108 | "Limplify list N." | 1120 | "Limplify list N." |
| 1109 | (comp-with-sp (+ (comp-sp) n -1) | 1121 | (comp--with-sp (+ (comp--sp) n -1) |
| 1110 | (comp-emit-set-call (comp-call 'cons | 1122 | (comp--emit-set-call (comp--call 'cons |
| 1111 | (comp-slot) | 1123 | (comp--slot) |
| 1112 | (make-comp-mvar :constant nil)))) | 1124 | (make--comp-mvar :constant nil)))) |
| 1113 | (cl-loop for sp from (+ (comp-sp) n -2) downto (comp-sp) | 1125 | (cl-loop for sp from (+ (comp--sp) n -2) downto (comp--sp) |
| 1114 | do (comp-with-sp sp | 1126 | do (comp--with-sp sp |
| 1115 | (comp-emit-set-call (comp-call 'cons | 1127 | (comp--emit-set-call (comp--call 'cons |
| 1116 | (comp-slot) | 1128 | (comp--slot) |
| 1117 | (comp-slot+1)))))) | 1129 | (comp--slot+1)))))) |
| 1118 | 1130 | ||
| 1119 | (defun comp-new-block-sym (&optional postfix) | 1131 | (defun comp--new-block-sym (&optional postfix) |
| 1120 | "Return a unique symbol postfixing POSTFIX naming the next new basic block." | 1132 | "Return a unique symbol postfixing POSTFIX naming the next new basic block." |
| 1121 | (intern (format (if postfix "bb_%s_%s" "bb_%s") | 1133 | (intern (format (if postfix "bb_%s_%s" "bb_%s") |
| 1122 | (funcall (comp-func-block-cnt-gen comp-func)) | 1134 | (funcall (comp-func-block-cnt-gen comp-func)) |
| 1123 | postfix))) | 1135 | postfix))) |
| 1124 | 1136 | ||
| 1125 | (defun comp-fill-label-h () | 1137 | (defun comp--fill-label-h () |
| 1126 | "Fill label-to-addr hash table for the current function." | 1138 | "Fill label-to-addr hash table for the current function." |
| 1127 | (setf (comp-limplify-label-to-addr comp-pass) (make-hash-table :test 'eql)) | 1139 | (setf (comp-limplify-label-to-addr comp-pass) (make-hash-table :test 'eql)) |
| 1128 | (cl-loop for insn in (comp-func-lap comp-func) | 1140 | (cl-loop for insn in (comp-func-lap comp-func) |
| @@ -1131,7 +1143,7 @@ Return value is the fall-through block name." | |||
| 1131 | (`(TAG ,label . ,_) | 1143 | (`(TAG ,label . ,_) |
| 1132 | (puthash label addr (comp-limplify-label-to-addr comp-pass)))))) | 1144 | (puthash label addr (comp-limplify-label-to-addr comp-pass)))))) |
| 1133 | 1145 | ||
| 1134 | (defun comp-jump-table-optimizable (jmp-table) | 1146 | (defun comp--jump-table-optimizable (jmp-table) |
| 1135 | "Return t if JMP-TABLE can be optimized out." | 1147 | "Return t if JMP-TABLE can be optimized out." |
| 1136 | ;; Identify LAP sequences like: | 1148 | ;; Identify LAP sequences like: |
| 1137 | ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24) | 1149 | ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24) |
| @@ -1143,13 +1155,13 @@ Return value is the fall-through block name." | |||
| 1143 | (`(TAG ,target . ,_label-sp) | 1155 | (`(TAG ,target . ,_label-sp) |
| 1144 | (= target (car targets))))))) | 1156 | (= target (car targets))))))) |
| 1145 | 1157 | ||
| 1146 | (defun comp-emit-switch (var last-insn) | 1158 | (defun comp--emit-switch (var last-insn) |
| 1147 | "Emit a Limple for a lap jump table given VAR and LAST-INSN." | 1159 | "Emit a Limple for a lap jump table given VAR and LAST-INSN." |
| 1148 | ;; FIXME this not efficient for big jump tables. We should have a second | 1160 | ;; FIXME this not efficient for big jump tables. We should have a second |
| 1149 | ;; strategy for this case. | 1161 | ;; strategy for this case. |
| 1150 | (pcase last-insn | 1162 | (pcase last-insn |
| 1151 | (`(setimm ,_ ,jmp-table) | 1163 | (`(setimm ,_ ,jmp-table) |
| 1152 | (unless (comp-jump-table-optimizable jmp-table) | 1164 | (unless (comp--jump-table-optimizable jmp-table) |
| 1153 | (cl-loop | 1165 | (cl-loop |
| 1154 | for test being each hash-keys of jmp-table | 1166 | for test being each hash-keys of jmp-table |
| 1155 | using (hash-value target-label) | 1167 | using (hash-value target-label) |
| @@ -1157,27 +1169,27 @@ Return value is the fall-through block name." | |||
| 1157 | with test-func = (hash-table-test jmp-table) | 1169 | with test-func = (hash-table-test jmp-table) |
| 1158 | for n from 1 | 1170 | for n from 1 |
| 1159 | for last = (= n len) | 1171 | for last = (= n len) |
| 1160 | for m-test = (make-comp-mvar :constant test) | 1172 | for m-test = (make--comp-mvar :constant test) |
| 1161 | for target-name = (comp-block-name (comp-bb-maybe-add | 1173 | for target-name = (comp-block-name (comp--bb-maybe-add |
| 1162 | (comp-label-to-addr target-label) | 1174 | (comp--label-to-addr target-label) |
| 1163 | (comp-sp))) | 1175 | (comp--sp))) |
| 1164 | for ff-bb = (if last | 1176 | for ff-bb = (if last |
| 1165 | (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) | 1177 | (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) |
| 1166 | (comp-sp)) | 1178 | (comp--sp)) |
| 1167 | (make--comp-block-lap nil | 1179 | (make--comp-block-lap nil |
| 1168 | (comp-sp) | 1180 | (comp--sp) |
| 1169 | (comp-new-block-sym))) | 1181 | (comp--new-block-sym))) |
| 1170 | for ff-bb-name = (comp-block-name ff-bb) | 1182 | for ff-bb-name = (comp-block-name ff-bb) |
| 1171 | if (eq test-func 'eq) | 1183 | if (eq test-func 'eq) |
| 1172 | do (comp-emit (list 'cond-jump var m-test target-name ff-bb-name)) | 1184 | do (comp--emit (list 'cond-jump var m-test target-name ff-bb-name)) |
| 1173 | else | 1185 | else |
| 1174 | ;; Store the result of the comparison into the scratch slot before | 1186 | ;; Store the result of the comparison into the scratch slot before |
| 1175 | ;; emitting the conditional jump. | 1187 | ;; emitting the conditional jump. |
| 1176 | do (comp-emit (list 'set (make-comp-mvar :slot 'scratch) | 1188 | do (comp--emit (list 'set (make--comp-mvar :slot 'scratch) |
| 1177 | (comp-call test-func var m-test))) | 1189 | (comp--call test-func var m-test))) |
| 1178 | (comp-emit (list 'cond-jump | 1190 | (comp--emit (list 'cond-jump |
| 1179 | (make-comp-mvar :slot 'scratch) | 1191 | (make--comp-mvar :slot 'scratch) |
| 1180 | (make-comp-mvar :constant nil) | 1192 | (make--comp-mvar :constant nil) |
| 1181 | ff-bb-name target-name)) | 1193 | ff-bb-name target-name)) |
| 1182 | unless last | 1194 | unless last |
| 1183 | ;; All fall through are artificially created here except the last one. | 1195 | ;; All fall through are artificially created here except the last one. |
| @@ -1192,7 +1204,7 @@ SUBR-NAME is the name of function." | |||
| 1192 | (or (gethash subr-name comp-subr-arities-h) | 1204 | (or (gethash subr-name comp-subr-arities-h) |
| 1193 | (func-arity subr-name))) | 1205 | (func-arity subr-name))) |
| 1194 | 1206 | ||
| 1195 | (defun comp-emit-set-call-subr (subr-name sp-delta) | 1207 | (defun comp--emit-set-call-subr (subr-name sp-delta) |
| 1196 | "Emit a call for SUBR-NAME. | 1208 | "Emit a call for SUBR-NAME. |
| 1197 | SP-DELTA is the stack adjustment." | 1209 | SP-DELTA is the stack adjustment." |
| 1198 | (let* ((nargs (1+ (- sp-delta))) | 1210 | (let* ((nargs (1+ (- sp-delta))) |
| @@ -1203,39 +1215,39 @@ SP-DELTA is the stack adjustment." | |||
| 1203 | (signal 'native-ice (list "subr contains unevalled args" subr-name))) | 1215 | (signal 'native-ice (list "subr contains unevalled args" subr-name))) |
| 1204 | (if (eq maxarg 'many) | 1216 | (if (eq maxarg 'many) |
| 1205 | ;; callref case. | 1217 | ;; callref case. |
| 1206 | (comp-emit-set-call (comp-callref subr-name nargs (comp-sp))) | 1218 | (comp--emit-set-call (comp--callref subr-name nargs (comp--sp))) |
| 1207 | ;; Normal call. | 1219 | ;; Normal call. |
| 1208 | (unless (and (>= maxarg nargs) (<= minarg nargs)) | 1220 | (unless (and (>= maxarg nargs) (<= minarg nargs)) |
| 1209 | (signal 'native-ice | 1221 | (signal 'native-ice |
| 1210 | (list "incoherent stack adjustment" nargs maxarg minarg))) | 1222 | (list "incoherent stack adjustment" nargs maxarg minarg))) |
| 1211 | (let* ((subr-name subr-name) | 1223 | (let* ((subr-name subr-name) |
| 1212 | (slots (cl-loop for i from 0 below maxarg | 1224 | (slots (cl-loop for i from 0 below maxarg |
| 1213 | collect (comp-slot-n (+ i (comp-sp)))))) | 1225 | collect (comp--slot-n (+ i (comp--sp)))))) |
| 1214 | (comp-emit-set-call (apply #'comp-call (cons subr-name slots))))))) | 1226 | (comp--emit-set-call (apply #'comp--call (cons subr-name slots))))))) |
| 1215 | 1227 | ||
| 1216 | (eval-when-compile | 1228 | (eval-when-compile |
| 1217 | (defun comp-op-to-fun (x) | 1229 | (defun comp--op-to-fun (x) |
| 1218 | "Given the LAP op strip \"byte-\" to have the subr name." | 1230 | "Given the LAP op strip \"byte-\" to have the subr name." |
| 1219 | (intern (string-replace "byte-" "" x))) | 1231 | (intern (string-replace "byte-" "" x))) |
| 1220 | 1232 | ||
| 1221 | (defun comp-body-eff (body op-name sp-delta) | 1233 | (defun comp--body-eff (body op-name sp-delta) |
| 1222 | "Given the original BODY, compute the effective one. | 1234 | "Given the original BODY, compute the effective one. |
| 1223 | When BODY is `auto', guess function name from the LAP byte-code | 1235 | When BODY is `auto', guess function name from the LAP byte-code |
| 1224 | name. Otherwise expect lname fnname." | 1236 | name. Otherwise expect lname fnname." |
| 1225 | (pcase (car body) | 1237 | (pcase (car body) |
| 1226 | ('auto | 1238 | ('auto |
| 1227 | `((comp-emit-set-call-subr ',(comp-op-to-fun op-name) ,sp-delta))) | 1239 | `((comp--emit-set-call-subr ',(comp--op-to-fun op-name) ,sp-delta))) |
| 1228 | ((pred symbolp) | 1240 | ((pred symbolp) |
| 1229 | `((comp-emit-set-call-subr ',(car body) ,sp-delta))) | 1241 | `((comp--emit-set-call-subr ',(car body) ,sp-delta))) |
| 1230 | (_ body)))) | 1242 | (_ body)))) |
| 1231 | 1243 | ||
| 1232 | (defmacro comp-op-case (&rest cases) | 1244 | (defmacro comp--op-case (&rest cases) |
| 1233 | "Expand CASES into the corresponding `pcase' expansion. | 1245 | "Expand CASES into the corresponding `pcase' expansion. |
| 1234 | This is responsible for generating the proper stack adjustment, when known, | 1246 | This is responsible for generating the proper stack adjustment, when known, |
| 1235 | and the annotation emission." | 1247 | and the annotation emission." |
| 1236 | (declare (debug (body)) | 1248 | (declare (debug (body)) |
| 1237 | (indent defun)) | 1249 | (indent defun)) |
| 1238 | (declare-function comp-body-eff nil (body op-name sp-delta)) | 1250 | (declare-function comp--body-eff nil (body op-name sp-delta)) |
| 1239 | `(pcase op | 1251 | `(pcase op |
| 1240 | ,@(cl-loop for (op . body) in cases | 1252 | ,@(cl-loop for (op . body) in cases |
| 1241 | for sp-delta = (gethash op comp-op-stack-info) | 1253 | for sp-delta = (gethash op comp-op-stack-info) |
| @@ -1244,55 +1256,55 @@ and the annotation emission." | |||
| 1244 | collect `(',op | 1256 | collect `(',op |
| 1245 | ;; Log all LAP ops except the TAG one. | 1257 | ;; Log all LAP ops except the TAG one. |
| 1246 | ;; ,(unless (eq op 'TAG) | 1258 | ;; ,(unless (eq op 'TAG) |
| 1247 | ;; `(comp-emit-annotation | 1259 | ;; `(comp--emit-annotation |
| 1248 | ;; ,(concat "LAP op " op-name))) | 1260 | ;; ,(concat "LAP op " op-name))) |
| 1249 | ;; Emit the stack adjustment if present. | 1261 | ;; Emit the stack adjustment if present. |
| 1250 | ,(when (and sp-delta (not (eq 0 sp-delta))) | 1262 | ,(when (and sp-delta (not (eq 0 sp-delta))) |
| 1251 | `(cl-incf (comp-sp) ,sp-delta)) | 1263 | `(cl-incf (comp--sp) ,sp-delta)) |
| 1252 | ,@(comp-body-eff body op-name sp-delta)) | 1264 | ,@(comp--body-eff body op-name sp-delta)) |
| 1253 | else | 1265 | else |
| 1254 | collect `(',op (signal 'native-ice | 1266 | collect `(',op (signal 'native-ice |
| 1255 | (list "unsupported LAP op" ',op-name)))) | 1267 | (list "unsupported LAP op" ',op-name)))) |
| 1256 | (_ (signal 'native-ice (list "unexpected LAP op" (symbol-name op)))))) | 1268 | (_ (signal 'native-ice (list "unexpected LAP op" (symbol-name op)))))) |
| 1257 | 1269 | ||
| 1258 | (defun comp-limplify-lap-inst (insn) | 1270 | (defun comp--limplify-lap-inst (insn) |
| 1259 | "Limplify LAP instruction INSN pushing it in the proper basic block." | 1271 | "Limplify LAP instruction INSN pushing it in the proper basic block." |
| 1260 | (let ((op (car insn)) | 1272 | (let ((op (car insn)) |
| 1261 | (arg (if (consp (cdr insn)) | 1273 | (arg (if (consp (cdr insn)) |
| 1262 | (cadr insn) | 1274 | (cadr insn) |
| 1263 | (cdr insn)))) | 1275 | (cdr insn)))) |
| 1264 | (comp-op-case | 1276 | (comp--op-case |
| 1265 | (TAG | 1277 | (TAG |
| 1266 | (cl-destructuring-bind (_TAG label-num . label-sp) insn | 1278 | (cl-destructuring-bind (_TAG label-num . label-sp) insn |
| 1267 | ;; Paranoid? | 1279 | ;; Paranoid? |
| 1268 | (when label-sp | 1280 | (when label-sp |
| 1269 | (cl-assert (= (1- label-sp) (comp-limplify-sp comp-pass)))) | 1281 | (cl-assert (= (1- label-sp) (comp-limplify-sp comp-pass)))) |
| 1270 | (comp-emit-annotation (format "LAP TAG %d" label-num)))) | 1282 | (comp--emit-annotation (format "LAP TAG %d" label-num)))) |
| 1271 | (byte-stack-ref | 1283 | (byte-stack-ref |
| 1272 | (comp-copy-slot (- (comp-sp) arg 1))) | 1284 | (comp--copy-slot (- (comp--sp) arg 1))) |
| 1273 | (byte-varref | 1285 | (byte-varref |
| 1274 | (comp-emit-set-call (comp-call 'symbol-value (make-comp-mvar | 1286 | (comp--emit-set-call (comp--call 'symbol-value (make--comp-mvar |
| 1275 | :constant arg)))) | 1287 | :constant arg)))) |
| 1276 | (byte-varset | 1288 | (byte-varset |
| 1277 | (comp-emit (comp-call 'set_internal | 1289 | (comp--emit (comp--call 'set_internal |
| 1278 | (make-comp-mvar :constant arg) | 1290 | (make--comp-mvar :constant arg) |
| 1279 | (comp-slot+1)))) | 1291 | (comp--slot+1)))) |
| 1280 | (byte-varbind ;; Verify | 1292 | (byte-varbind ;; Verify |
| 1281 | (comp-emit (comp-call 'specbind | 1293 | (comp--emit (comp--call 'specbind |
| 1282 | (make-comp-mvar :constant arg) | 1294 | (make--comp-mvar :constant arg) |
| 1283 | (comp-slot+1)))) | 1295 | (comp--slot+1)))) |
| 1284 | (byte-call | 1296 | (byte-call |
| 1285 | (cl-incf (comp-sp) (- arg)) | 1297 | (cl-incf (comp--sp) (- arg)) |
| 1286 | (comp-emit-set-call (comp-callref 'funcall (1+ arg) (comp-sp)))) | 1298 | (comp--emit-set-call (comp--callref 'funcall (1+ arg) (comp--sp)))) |
| 1287 | (byte-unbind | 1299 | (byte-unbind |
| 1288 | (comp-emit (comp-call 'helper_unbind_n | 1300 | (comp--emit (comp--call 'helper_unbind_n |
| 1289 | (make-comp-mvar :constant arg)))) | 1301 | (make--comp-mvar :constant arg)))) |
| 1290 | (byte-pophandler | 1302 | (byte-pophandler |
| 1291 | (comp-emit '(pop-handler))) | 1303 | (comp--emit '(pop-handler))) |
| 1292 | (byte-pushconditioncase | 1304 | (byte-pushconditioncase |
| 1293 | (comp-emit-handler (cddr insn) 'condition-case)) | 1305 | (comp--emit-handler (cddr insn) 'condition-case)) |
| 1294 | (byte-pushcatch | 1306 | (byte-pushcatch |
| 1295 | (comp-emit-handler (cddr insn) 'catcher)) | 1307 | (comp--emit-handler (cddr insn) 'catcher)) |
| 1296 | (byte-nth auto) | 1308 | (byte-nth auto) |
| 1297 | (byte-symbolp auto) | 1309 | (byte-symbolp auto) |
| 1298 | (byte-consp auto) | 1310 | (byte-consp auto) |
| @@ -1301,19 +1313,19 @@ and the annotation emission." | |||
| 1301 | (byte-eq auto) | 1313 | (byte-eq auto) |
| 1302 | (byte-memq auto) | 1314 | (byte-memq auto) |
| 1303 | (byte-not | 1315 | (byte-not |
| 1304 | (comp-emit-set-call (comp-call 'eq (comp-slot-n (comp-sp)) | 1316 | (comp--emit-set-call (comp--call 'eq (comp--slot-n (comp--sp)) |
| 1305 | (make-comp-mvar :constant nil)))) | 1317 | (make--comp-mvar :constant nil)))) |
| 1306 | (byte-car auto) | 1318 | (byte-car auto) |
| 1307 | (byte-cdr auto) | 1319 | (byte-cdr auto) |
| 1308 | (byte-cons auto) | 1320 | (byte-cons auto) |
| 1309 | (byte-list1 | 1321 | (byte-list1 |
| 1310 | (comp-limplify-listn 1)) | 1322 | (comp--limplify-listn 1)) |
| 1311 | (byte-list2 | 1323 | (byte-list2 |
| 1312 | (comp-limplify-listn 2)) | 1324 | (comp--limplify-listn 2)) |
| 1313 | (byte-list3 | 1325 | (byte-list3 |
| 1314 | (comp-limplify-listn 3)) | 1326 | (comp--limplify-listn 3)) |
| 1315 | (byte-list4 | 1327 | (byte-list4 |
| 1316 | (comp-limplify-listn 4)) | 1328 | (comp--limplify-listn 4)) |
| 1317 | (byte-length auto) | 1329 | (byte-length auto) |
| 1318 | (byte-aref auto) | 1330 | (byte-aref auto) |
| 1319 | (byte-aset auto) | 1331 | (byte-aset auto) |
| @@ -1324,11 +1336,11 @@ and the annotation emission." | |||
| 1324 | (byte-get auto) | 1336 | (byte-get auto) |
| 1325 | (byte-substring auto) | 1337 | (byte-substring auto) |
| 1326 | (byte-concat2 | 1338 | (byte-concat2 |
| 1327 | (comp-emit-set-call (comp-callref 'concat 2 (comp-sp)))) | 1339 | (comp--emit-set-call (comp--callref 'concat 2 (comp--sp)))) |
| 1328 | (byte-concat3 | 1340 | (byte-concat3 |
| 1329 | (comp-emit-set-call (comp-callref 'concat 3 (comp-sp)))) | 1341 | (comp--emit-set-call (comp--callref 'concat 3 (comp--sp)))) |
| 1330 | (byte-concat4 | 1342 | (byte-concat4 |
| 1331 | (comp-emit-set-call (comp-callref 'concat 4 (comp-sp)))) | 1343 | (comp--emit-set-call (comp--callref 'concat 4 (comp--sp)))) |
| 1332 | (byte-sub1 1-) | 1344 | (byte-sub1 1-) |
| 1333 | (byte-add1 1+) | 1345 | (byte-add1 1+) |
| 1334 | (byte-eqlsign =) | 1346 | (byte-eqlsign =) |
| @@ -1338,7 +1350,7 @@ and the annotation emission." | |||
| 1338 | (byte-geq >=) | 1350 | (byte-geq >=) |
| 1339 | (byte-diff -) | 1351 | (byte-diff -) |
| 1340 | (byte-negate | 1352 | (byte-negate |
| 1341 | (comp-emit-set-call (comp-call 'negate (comp-slot)))) | 1353 | (comp--emit-set-call (comp--call 'negate (comp--slot)))) |
| 1342 | (byte-plus +) | 1354 | (byte-plus +) |
| 1343 | (byte-max auto) | 1355 | (byte-max auto) |
| 1344 | (byte-min auto) | 1356 | (byte-min auto) |
| @@ -1353,9 +1365,9 @@ and the annotation emission." | |||
| 1353 | (byte-preceding-char preceding-char) | 1365 | (byte-preceding-char preceding-char) |
| 1354 | (byte-current-column auto) | 1366 | (byte-current-column auto) |
| 1355 | (byte-indent-to | 1367 | (byte-indent-to |
| 1356 | (comp-emit-set-call (comp-call 'indent-to | 1368 | (comp--emit-set-call (comp--call 'indent-to |
| 1357 | (comp-slot) | 1369 | (comp--slot) |
| 1358 | (make-comp-mvar :constant nil)))) | 1370 | (make--comp-mvar :constant nil)))) |
| 1359 | (byte-scan-buffer-OBSOLETE) | 1371 | (byte-scan-buffer-OBSOLETE) |
| 1360 | (byte-eolp auto) | 1372 | (byte-eolp auto) |
| 1361 | (byte-eobp auto) | 1373 | (byte-eobp auto) |
| @@ -1364,7 +1376,7 @@ and the annotation emission." | |||
| 1364 | (byte-current-buffer auto) | 1376 | (byte-current-buffer auto) |
| 1365 | (byte-set-buffer auto) | 1377 | (byte-set-buffer auto) |
| 1366 | (byte-save-current-buffer | 1378 | (byte-save-current-buffer |
| 1367 | (comp-emit (comp-call 'record_unwind_current_buffer))) | 1379 | (comp--emit (comp--call 'record_unwind_current_buffer))) |
| 1368 | (byte-set-mark-OBSOLETE) | 1380 | (byte-set-mark-OBSOLETE) |
| 1369 | (byte-interactive-p-OBSOLETE) | 1381 | (byte-interactive-p-OBSOLETE) |
| 1370 | (byte-forward-char auto) | 1382 | (byte-forward-char auto) |
| @@ -1376,41 +1388,41 @@ and the annotation emission." | |||
| 1376 | (byte-buffer-substring auto) | 1388 | (byte-buffer-substring auto) |
| 1377 | (byte-delete-region auto) | 1389 | (byte-delete-region auto) |
| 1378 | (byte-narrow-to-region | 1390 | (byte-narrow-to-region |
| 1379 | (comp-emit-set-call (comp-call 'narrow-to-region | 1391 | (comp--emit-set-call (comp--call 'narrow-to-region |
| 1380 | (comp-slot) | 1392 | (comp--slot) |
| 1381 | (comp-slot+1)))) | 1393 | (comp--slot+1)))) |
| 1382 | (byte-widen | 1394 | (byte-widen |
| 1383 | (comp-emit-set-call (comp-call 'widen))) | 1395 | (comp--emit-set-call (comp--call 'widen))) |
| 1384 | (byte-end-of-line auto) | 1396 | (byte-end-of-line auto) |
| 1385 | (byte-constant2) ; TODO | 1397 | (byte-constant2) ; TODO |
| 1386 | ;; Branches. | 1398 | ;; Branches. |
| 1387 | (byte-goto | 1399 | (byte-goto |
| 1388 | (comp-emit-uncond-jump (cddr insn))) | 1400 | (comp--emit-uncond-jump (cddr insn))) |
| 1389 | (byte-goto-if-nil | 1401 | (byte-goto-if-nil |
| 1390 | (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0 | 1402 | (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0 |
| 1391 | (cddr insn) nil)) | 1403 | (cddr insn) nil)) |
| 1392 | (byte-goto-if-not-nil | 1404 | (byte-goto-if-not-nil |
| 1393 | (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0 | 1405 | (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0 |
| 1394 | (cddr insn) t)) | 1406 | (cddr insn) t)) |
| 1395 | (byte-goto-if-nil-else-pop | 1407 | (byte-goto-if-nil-else-pop |
| 1396 | (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1 | 1408 | (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1 |
| 1397 | (cddr insn) nil)) | 1409 | (cddr insn) nil)) |
| 1398 | (byte-goto-if-not-nil-else-pop | 1410 | (byte-goto-if-not-nil-else-pop |
| 1399 | (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1 | 1411 | (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1 |
| 1400 | (cddr insn) t)) | 1412 | (cddr insn) t)) |
| 1401 | (byte-return | 1413 | (byte-return |
| 1402 | (comp-emit `(return ,(comp-slot+1)))) | 1414 | (comp--emit `(return ,(comp--slot+1)))) |
| 1403 | (byte-discard 'pass) | 1415 | (byte-discard 'pass) |
| 1404 | (byte-dup | 1416 | (byte-dup |
| 1405 | (comp-copy-slot (1- (comp-sp)))) | 1417 | (comp--copy-slot (1- (comp--sp)))) |
| 1406 | (byte-save-excursion | 1418 | (byte-save-excursion |
| 1407 | (comp-emit (comp-call 'record_unwind_protect_excursion))) | 1419 | (comp--emit (comp--call 'record_unwind_protect_excursion))) |
| 1408 | (byte-save-window-excursion-OBSOLETE) | 1420 | (byte-save-window-excursion-OBSOLETE) |
| 1409 | (byte-save-restriction | 1421 | (byte-save-restriction |
| 1410 | (comp-emit (comp-call 'helper_save_restriction))) | 1422 | (comp--emit (comp--call 'helper_save_restriction))) |
| 1411 | (byte-catch) ;; Obsolete | 1423 | (byte-catch) ;; Obsolete |
| 1412 | (byte-unwind-protect | 1424 | (byte-unwind-protect |
| 1413 | (comp-emit (comp-call 'helper_unwind_protect (comp-slot+1)))) | 1425 | (comp--emit (comp--call 'helper_unwind_protect (comp--slot+1)))) |
| 1414 | (byte-condition-case) ;; Obsolete | 1426 | (byte-condition-case) ;; Obsolete |
| 1415 | (byte-temp-output-buffer-setup-OBSOLETE) | 1427 | (byte-temp-output-buffer-setup-OBSOLETE) |
| 1416 | (byte-temp-output-buffer-show-OBSOLETE) | 1428 | (byte-temp-output-buffer-show-OBSOLETE) |
| @@ -1437,61 +1449,61 @@ and the annotation emission." | |||
| 1437 | (byte-numberp auto) | 1449 | (byte-numberp auto) |
| 1438 | (byte-integerp auto) | 1450 | (byte-integerp auto) |
| 1439 | (byte-listN | 1451 | (byte-listN |
| 1440 | (cl-incf (comp-sp) (- 1 arg)) | 1452 | (cl-incf (comp--sp) (- 1 arg)) |
| 1441 | (comp-emit-set-call (comp-callref 'list arg (comp-sp)))) | 1453 | (comp--emit-set-call (comp--callref 'list arg (comp--sp)))) |
| 1442 | (byte-concatN | 1454 | (byte-concatN |
| 1443 | (cl-incf (comp-sp) (- 1 arg)) | 1455 | (cl-incf (comp--sp) (- 1 arg)) |
| 1444 | (comp-emit-set-call (comp-callref 'concat arg (comp-sp)))) | 1456 | (comp--emit-set-call (comp--callref 'concat arg (comp--sp)))) |
| 1445 | (byte-insertN | 1457 | (byte-insertN |
| 1446 | (cl-incf (comp-sp) (- 1 arg)) | 1458 | (cl-incf (comp--sp) (- 1 arg)) |
| 1447 | (comp-emit-set-call (comp-callref 'insert arg (comp-sp)))) | 1459 | (comp--emit-set-call (comp--callref 'insert arg (comp--sp)))) |
| 1448 | (byte-stack-set | 1460 | (byte-stack-set |
| 1449 | (comp-copy-slot (1+ (comp-sp)) (- (comp-sp) arg -1))) | 1461 | (comp--copy-slot (1+ (comp--sp)) (- (comp--sp) arg -1))) |
| 1450 | (byte-stack-set2 (cl-assert nil)) ;; TODO | 1462 | (byte-stack-set2 (cl-assert nil)) ;; TODO |
| 1451 | (byte-discardN | 1463 | (byte-discardN |
| 1452 | (cl-incf (comp-sp) (- arg))) | 1464 | (cl-incf (comp--sp) (- arg))) |
| 1453 | (byte-switch | 1465 | (byte-switch |
| 1454 | ;; Assume to follow the emission of a setimm. | 1466 | ;; Assume to follow the emission of a setimm. |
| 1455 | ;; This is checked into comp-emit-switch. | 1467 | ;; This is checked into comp--emit-switch. |
| 1456 | (comp-emit-switch (comp-slot+1) | 1468 | (comp--emit-switch (comp--slot+1) |
| 1457 | (cl-first (comp-block-insns | 1469 | (cl-first (comp-block-insns |
| 1458 | (comp-limplify-curr-block comp-pass))))) | 1470 | (comp-limplify-curr-block comp-pass))))) |
| 1459 | (byte-constant | 1471 | (byte-constant |
| 1460 | (comp-emit-setimm arg)) | 1472 | (comp--emit-setimm arg)) |
| 1461 | (byte-discardN-preserve-tos | 1473 | (byte-discardN-preserve-tos |
| 1462 | (cl-incf (comp-sp) (- arg)) | 1474 | (cl-incf (comp--sp) (- arg)) |
| 1463 | (comp-copy-slot (+ arg (comp-sp))))))) | 1475 | (comp--copy-slot (+ arg (comp--sp))))))) |
| 1464 | 1476 | ||
| 1465 | (defun comp-emit-narg-prologue (minarg nonrest rest) | 1477 | (defun comp--emit-narg-prologue (minarg nonrest rest) |
| 1466 | "Emit the prologue for a narg function." | 1478 | "Emit the prologue for a narg function." |
| 1467 | (cl-loop for i below minarg | 1479 | (cl-loop for i below minarg |
| 1468 | do (comp-emit `(set-args-to-local ,(comp-slot-n i))) | 1480 | do (comp--emit `(set-args-to-local ,(comp--slot-n i))) |
| 1469 | (comp-emit '(inc-args))) | 1481 | (comp--emit '(inc-args))) |
| 1470 | (cl-loop for i from minarg below nonrest | 1482 | (cl-loop for i from minarg below nonrest |
| 1471 | for bb = (intern (format "entry_%s" i)) | 1483 | for bb = (intern (format "entry_%s" i)) |
| 1472 | for fallback = (intern (format "entry_fallback_%s" i)) | 1484 | for fallback = (intern (format "entry_fallback_%s" i)) |
| 1473 | do (comp-emit `(cond-jump-narg-leq ,i ,fallback ,bb)) | 1485 | do (comp--emit `(cond-jump-narg-leq ,i ,fallback ,bb)) |
| 1474 | (comp-make-curr-block bb (comp-sp)) | 1486 | (comp--make-curr-block bb (comp--sp)) |
| 1475 | (comp-emit `(set-args-to-local ,(comp-slot-n i))) | 1487 | (comp--emit `(set-args-to-local ,(comp--slot-n i))) |
| 1476 | (comp-emit '(inc-args)) | 1488 | (comp--emit '(inc-args)) |
| 1477 | finally (comp-emit '(jump entry_rest_args))) | 1489 | finally (comp--emit '(jump entry_rest_args))) |
| 1478 | (when (/= minarg nonrest) | 1490 | (when (/= minarg nonrest) |
| 1479 | (cl-loop for i from minarg below nonrest | 1491 | (cl-loop for i from minarg below nonrest |
| 1480 | for bb = (intern (format "entry_fallback_%s" i)) | 1492 | for bb = (intern (format "entry_fallback_%s" i)) |
| 1481 | for next-bb = (if (= (1+ i) nonrest) | 1493 | for next-bb = (if (= (1+ i) nonrest) |
| 1482 | 'entry_rest_args | 1494 | 'entry_rest_args |
| 1483 | (intern (format "entry_fallback_%s" (1+ i)))) | 1495 | (intern (format "entry_fallback_%s" (1+ i)))) |
| 1484 | do (comp-with-sp i | 1496 | do (comp--with-sp i |
| 1485 | (comp-make-curr-block bb (comp-sp)) | 1497 | (comp--make-curr-block bb (comp--sp)) |
| 1486 | (comp-emit-setimm nil) | 1498 | (comp--emit-setimm nil) |
| 1487 | (comp-emit `(jump ,next-bb))))) | 1499 | (comp--emit `(jump ,next-bb))))) |
| 1488 | (comp-make-curr-block 'entry_rest_args (comp-sp)) | 1500 | (comp--make-curr-block 'entry_rest_args (comp--sp)) |
| 1489 | (comp-emit `(set-rest-args-to-local ,(comp-slot-n nonrest))) | 1501 | (comp--emit `(set-rest-args-to-local ,(comp--slot-n nonrest))) |
| 1490 | (setf (comp-sp) nonrest) | 1502 | (setf (comp--sp) nonrest) |
| 1491 | (when (and (> nonrest 8) (null rest)) | 1503 | (when (and (> nonrest 8) (null rest)) |
| 1492 | (cl-decf (comp-sp)))) | 1504 | (cl-decf (comp--sp)))) |
| 1493 | 1505 | ||
| 1494 | (defun comp-limplify-finalize-function (func) | 1506 | (defun comp--limplify-finalize-function (func) |
| 1495 | "Reverse insns into all basic blocks of FUNC." | 1507 | "Reverse insns into all basic blocks of FUNC." |
| 1496 | (cl-loop for bb being the hash-value in (comp-func-blocks func) | 1508 | (cl-loop for bb being the hash-value in (comp-func-blocks func) |
| 1497 | do (setf (comp-block-insns bb) | 1509 | do (setf (comp-block-insns bb) |
| @@ -1499,49 +1511,49 @@ and the annotation emission." | |||
| 1499 | (comp--log-func func 2) | 1511 | (comp--log-func func 2) |
| 1500 | func) | 1512 | func) |
| 1501 | 1513 | ||
| 1502 | (cl-defgeneric comp-prepare-args-for-top-level (function) | 1514 | (cl-defgeneric comp--prepare-args-for-top-level (function) |
| 1503 | "Given FUNCTION, return the two arguments for comp--register-...") | 1515 | "Given FUNCTION, return the two arguments for comp--register-...") |
| 1504 | 1516 | ||
| 1505 | (cl-defmethod comp-prepare-args-for-top-level ((function comp-func-l)) | 1517 | (cl-defmethod comp--prepare-args-for-top-level ((function comp-func-l)) |
| 1506 | "Lexically-scoped FUNCTION." | 1518 | "Lexically-scoped FUNCTION." |
| 1507 | (let ((args (comp-func-l-args function))) | 1519 | (let ((args (comp-func-l-args function))) |
| 1508 | (cons (make-comp-mvar :constant (comp-args-base-min args)) | 1520 | (cons (make--comp-mvar :constant (comp-args-base-min args)) |
| 1509 | (make-comp-mvar :constant (cond | 1521 | (make--comp-mvar :constant (cond |
| 1510 | ((comp-args-p args) (comp-args-max args)) | 1522 | ((comp-args-p args) (comp-args-max args)) |
| 1511 | ((comp-nargs-rest args) 'many) | 1523 | ((comp-nargs-rest args) 'many) |
| 1512 | (t (comp-nargs-nonrest args))))))) | 1524 | (t (comp-nargs-nonrest args))))))) |
| 1513 | 1525 | ||
| 1514 | (cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d)) | 1526 | (cl-defmethod comp--prepare-args-for-top-level ((function comp-func-d)) |
| 1515 | "Dynamically scoped FUNCTION." | 1527 | "Dynamically scoped FUNCTION." |
| 1516 | (cons (make-comp-mvar :constant (func-arity (comp-func-byte-func function))) | 1528 | (cons (make--comp-mvar :constant (func-arity (comp-func-byte-func function))) |
| 1517 | (let ((comp-curr-allocation-class 'd-default)) | 1529 | (let ((comp-curr-allocation-class 'd-default)) |
| 1518 | ;; Lambda-lists must stay in the same relocation class of | 1530 | ;; Lambda-lists must stay in the same relocation class of |
| 1519 | ;; the object referenced by code to respect uninterned | 1531 | ;; the object referenced by code to respect uninterned |
| 1520 | ;; symbols. | 1532 | ;; symbols. |
| 1521 | (make-comp-mvar :constant (comp-func-d-lambda-list function))))) | 1533 | (make--comp-mvar :constant (comp-func-d-lambda-list function))))) |
| 1522 | 1534 | ||
| 1523 | (cl-defgeneric comp-emit-for-top-level (form for-late-load) | 1535 | (cl-defgeneric comp--emit-for-top-level (form for-late-load) |
| 1524 | "Emit the Limple code for top level FORM.") | 1536 | "Emit the Limple code for top level FORM.") |
| 1525 | 1537 | ||
| 1526 | (cl-defmethod comp-emit-for-top-level ((form byte-to-native-func-def) | 1538 | (cl-defmethod comp--emit-for-top-level ((form byte-to-native-func-def) |
| 1527 | for-late-load) | 1539 | for-late-load) |
| 1528 | (let* ((name (byte-to-native-func-def-name form)) | 1540 | (let* ((name (byte-to-native-func-def-name form)) |
| 1529 | (c-name (byte-to-native-func-def-c-name form)) | 1541 | (c-name (byte-to-native-func-def-c-name form)) |
| 1530 | (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt))) | 1542 | (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt))) |
| 1531 | (args (comp-prepare-args-for-top-level f))) | 1543 | (args (comp--prepare-args-for-top-level f))) |
| 1532 | (cl-assert (and name f)) | 1544 | (cl-assert (and name f)) |
| 1533 | (comp-emit | 1545 | (comp--emit |
| 1534 | `(set ,(make-comp-mvar :slot 1) | 1546 | `(set ,(make--comp-mvar :slot 1) |
| 1535 | ,(comp-call (if for-late-load | 1547 | ,(comp--call (if for-late-load |
| 1536 | 'comp--late-register-subr | 1548 | 'comp--late-register-subr |
| 1537 | 'comp--register-subr) | 1549 | 'comp--register-subr) |
| 1538 | (make-comp-mvar :constant name) | 1550 | (make--comp-mvar :constant name) |
| 1539 | (make-comp-mvar :constant c-name) | 1551 | (make--comp-mvar :constant c-name) |
| 1540 | (car args) | 1552 | (car args) |
| 1541 | (cdr args) | 1553 | (cdr args) |
| 1542 | (setf (comp-func-type f) | 1554 | (setf (comp-func-type f) |
| 1543 | (make-comp-mvar :constant nil)) | 1555 | (make--comp-mvar :constant nil)) |
| 1544 | (make-comp-mvar | 1556 | (make--comp-mvar |
| 1545 | :constant | 1557 | :constant |
| 1546 | (list | 1558 | (list |
| 1547 | (let* ((h (comp-ctxt-function-docs comp-ctxt)) | 1559 | (let* ((h (comp-ctxt-function-docs comp-ctxt)) |
| @@ -1552,40 +1564,40 @@ and the annotation emission." | |||
| 1552 | (comp-func-command-modes f))) | 1564 | (comp-func-command-modes f))) |
| 1553 | ;; This is the compilation unit it-self passed as | 1565 | ;; This is the compilation unit it-self passed as |
| 1554 | ;; parameter. | 1566 | ;; parameter. |
| 1555 | (make-comp-mvar :slot 0)))))) | 1567 | (make--comp-mvar :slot 0)))))) |
| 1556 | 1568 | ||
| 1557 | (cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level) | 1569 | (cl-defmethod comp--emit-for-top-level ((form byte-to-native-top-level) |
| 1558 | for-late-load) | 1570 | for-late-load) |
| 1559 | (unless for-late-load | 1571 | (unless for-late-load |
| 1560 | (comp-emit | 1572 | (comp--emit |
| 1561 | (comp-call 'eval | 1573 | (comp--call 'eval |
| 1562 | (let ((comp-curr-allocation-class 'd-impure)) | 1574 | (let ((comp-curr-allocation-class 'd-impure)) |
| 1563 | (make-comp-mvar :constant | 1575 | (make--comp-mvar :constant |
| 1564 | (byte-to-native-top-level-form form))) | 1576 | (byte-to-native-top-level-form form))) |
| 1565 | (make-comp-mvar :constant | 1577 | (make--comp-mvar :constant |
| 1566 | (byte-to-native-top-level-lexical form)))))) | 1578 | (byte-to-native-top-level-lexical form)))))) |
| 1567 | 1579 | ||
| 1568 | (defun comp-emit-lambda-for-top-level (func) | 1580 | (defun comp--emit-lambda-for-top-level (func) |
| 1569 | "Emit the creation of subrs for lambda FUNC. | 1581 | "Emit the creation of subrs for lambda FUNC. |
| 1570 | These are stored in the reloc data array." | 1582 | These are stored in the reloc data array." |
| 1571 | (let ((args (comp-prepare-args-for-top-level func))) | 1583 | (let ((args (comp--prepare-args-for-top-level func))) |
| 1572 | (let ((comp-curr-allocation-class 'd-impure)) | 1584 | (let ((comp-curr-allocation-class 'd-impure)) |
| 1573 | (comp--add-const-to-relocs (comp-func-byte-func func))) | 1585 | (comp--add-const-to-relocs (comp-func-byte-func func))) |
| 1574 | (comp-emit | 1586 | (comp--emit |
| 1575 | (comp-call 'comp--register-lambda | 1587 | (comp--call 'comp--register-lambda |
| 1576 | ;; mvar to be fixed-up when containers are | 1588 | ;; mvar to be fixed-up when containers are |
| 1577 | ;; finalized. | 1589 | ;; finalized. |
| 1578 | (or (gethash (comp-func-byte-func func) | 1590 | (or (gethash (comp-func-byte-func func) |
| 1579 | (comp-ctxt-lambda-fixups-h comp-ctxt)) | 1591 | (comp-ctxt-lambda-fixups-h comp-ctxt)) |
| 1580 | (puthash (comp-func-byte-func func) | 1592 | (puthash (comp-func-byte-func func) |
| 1581 | (make-comp-mvar :constant nil) | 1593 | (make--comp-mvar :constant nil) |
| 1582 | (comp-ctxt-lambda-fixups-h comp-ctxt))) | 1594 | (comp-ctxt-lambda-fixups-h comp-ctxt))) |
| 1583 | (make-comp-mvar :constant (comp-func-c-name func)) | 1595 | (make--comp-mvar :constant (comp-func-c-name func)) |
| 1584 | (car args) | 1596 | (car args) |
| 1585 | (cdr args) | 1597 | (cdr args) |
| 1586 | (setf (comp-func-type func) | 1598 | (setf (comp-func-type func) |
| 1587 | (make-comp-mvar :constant nil)) | 1599 | (make--comp-mvar :constant nil)) |
| 1588 | (make-comp-mvar | 1600 | (make--comp-mvar |
| 1589 | :constant | 1601 | :constant |
| 1590 | (list | 1602 | (list |
| 1591 | (let* ((h (comp-ctxt-function-docs comp-ctxt)) | 1603 | (let* ((h (comp-ctxt-function-docs comp-ctxt)) |
| @@ -1596,9 +1608,9 @@ These are stored in the reloc data array." | |||
| 1596 | (comp-func-command-modes func))) | 1608 | (comp-func-command-modes func))) |
| 1597 | ;; This is the compilation unit it-self passed as | 1609 | ;; This is the compilation unit it-self passed as |
| 1598 | ;; parameter. | 1610 | ;; parameter. |
| 1599 | (make-comp-mvar :slot 0))))) | 1611 | (make--comp-mvar :slot 0))))) |
| 1600 | 1612 | ||
| 1601 | (defun comp-limplify-top-level (for-late-load) | 1613 | (defun comp--limplify-top-level (for-late-load) |
| 1602 | "Create a Limple function to modify the global environment at load. | 1614 | "Create a Limple function to modify the global environment at load. |
| 1603 | When FOR-LATE-LOAD is non-nil, the emitted function modifies only | 1615 | When FOR-LATE-LOAD is non-nil, the emitted function modifies only |
| 1604 | function definition. | 1616 | function definition. |
| @@ -1628,22 +1640,22 @@ into the C code forwarding the compilation unit." | |||
| 1628 | (comp-func func) | 1640 | (comp-func func) |
| 1629 | (comp-pass (make-comp-limplify | 1641 | (comp-pass (make-comp-limplify |
| 1630 | :curr-block (make--comp-block-lap -1 0 'top-level) | 1642 | :curr-block (make--comp-block-lap -1 0 'top-level) |
| 1631 | :frame (comp-new-frame 1 0)))) | 1643 | :frame (comp--new-frame 1 0)))) |
| 1632 | (comp-make-curr-block 'entry (comp-sp)) | 1644 | (comp--make-curr-block 'entry (comp--sp)) |
| 1633 | (comp-emit-annotation (if for-late-load | 1645 | (comp--emit-annotation (if for-late-load |
| 1634 | "Late top level" | 1646 | "Late top level" |
| 1635 | "Top level")) | 1647 | "Top level")) |
| 1636 | ;; Assign the compilation unit incoming as parameter to the slot frame 0. | 1648 | ;; Assign the compilation unit incoming as parameter to the slot frame 0. |
| 1637 | (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0)) | 1649 | (comp--emit `(set-par-to-local ,(comp--slot-n 0) 0)) |
| 1638 | (maphash (lambda (_ func) | 1650 | (maphash (lambda (_ func) |
| 1639 | (comp-emit-lambda-for-top-level func)) | 1651 | (comp--emit-lambda-for-top-level func)) |
| 1640 | (comp-ctxt-byte-func-to-func-h comp-ctxt)) | 1652 | (comp-ctxt-byte-func-to-func-h comp-ctxt)) |
| 1641 | (mapc (lambda (x) (comp-emit-for-top-level x for-late-load)) | 1653 | (mapc (lambda (x) (comp--emit-for-top-level x for-late-load)) |
| 1642 | (comp-ctxt-top-level-forms comp-ctxt)) | 1654 | (comp-ctxt-top-level-forms comp-ctxt)) |
| 1643 | (comp-emit `(return ,(make-comp-mvar :slot 1))) | 1655 | (comp--emit `(return ,(make--comp-mvar :slot 1))) |
| 1644 | (comp-limplify-finalize-function func))) | 1656 | (comp--limplify-finalize-function func))) |
| 1645 | 1657 | ||
| 1646 | (defun comp-addr-to-bb-name (addr) | 1658 | (defun comp--addr-to-bb-name (addr) |
| 1647 | "Search for a block starting at ADDR into pending or limplified blocks." | 1659 | "Search for a block starting at ADDR into pending or limplified blocks." |
| 1648 | ;; FIXME Actually we could have another hash for this. | 1660 | ;; FIXME Actually we could have another hash for this. |
| 1649 | (cl-flet ((pred (bb) | 1661 | (cl-flet ((pred (bb) |
| @@ -1655,7 +1667,7 @@ into the C code forwarding the compilation unit." | |||
| 1655 | when (pred bb) | 1667 | when (pred bb) |
| 1656 | return (comp-block-name bb))))) | 1668 | return (comp-block-name bb))))) |
| 1657 | 1669 | ||
| 1658 | (defun comp-limplify-block (bb) | 1670 | (defun comp--limplify-block (bb) |
| 1659 | "Limplify basic-block BB and add it to the current function." | 1671 | "Limplify basic-block BB and add it to the current function." |
| 1660 | (setf (comp-limplify-curr-block comp-pass) bb | 1672 | (setf (comp-limplify-curr-block comp-pass) bb |
| 1661 | (comp-limplify-sp comp-pass) (comp-block-lap-sp bb) | 1673 | (comp-limplify-sp comp-pass) (comp-block-lap-sp bb) |
| @@ -1666,51 +1678,51 @@ into the C code forwarding the compilation unit." | |||
| 1666 | (comp-func-lap comp-func)) | 1678 | (comp-func-lap comp-func)) |
| 1667 | for inst = (car inst-cell) | 1679 | for inst = (car inst-cell) |
| 1668 | for next-inst = (car-safe (cdr inst-cell)) | 1680 | for next-inst = (car-safe (cdr inst-cell)) |
| 1669 | do (comp-limplify-lap-inst inst) | 1681 | do (comp--limplify-lap-inst inst) |
| 1670 | (cl-incf (comp-limplify-pc comp-pass)) | 1682 | (cl-incf (comp-limplify-pc comp-pass)) |
| 1671 | when (comp-lap-fall-through-p inst) | 1683 | when (comp--lap-fall-through-p inst) |
| 1672 | do (pcase next-inst | 1684 | do (pcase next-inst |
| 1673 | (`(TAG ,_label . ,label-sp) | 1685 | (`(TAG ,_label . ,label-sp) |
| 1674 | (when label-sp | 1686 | (when label-sp |
| 1675 | (cl-assert (= (1- label-sp) (comp-sp)))) | 1687 | (cl-assert (= (1- label-sp) (comp--sp)))) |
| 1676 | (let* ((stack-depth (if label-sp | 1688 | (let* ((stack-depth (if label-sp |
| 1677 | (1- label-sp) | 1689 | (1- label-sp) |
| 1678 | (comp-sp))) | 1690 | (comp--sp))) |
| 1679 | (next-bb (comp-block-name (comp-bb-maybe-add | 1691 | (next-bb (comp-block-name (comp--bb-maybe-add |
| 1680 | (comp-limplify-pc comp-pass) | 1692 | (comp-limplify-pc comp-pass) |
| 1681 | stack-depth)))) | 1693 | stack-depth)))) |
| 1682 | (unless (comp-block-closed bb) | 1694 | (unless (comp-block-closed bb) |
| 1683 | (comp-emit `(jump ,next-bb)))) | 1695 | (comp--emit `(jump ,next-bb)))) |
| 1684 | (cl-return))) | 1696 | (cl-return))) |
| 1685 | until (comp-lap-eob-p inst))) | 1697 | until (comp--lap-eob-p inst))) |
| 1686 | 1698 | ||
| 1687 | (defun comp-limplify-function (func) | 1699 | (defun comp--limplify-function (func) |
| 1688 | "Limplify a single function FUNC." | 1700 | "Limplify a single function FUNC." |
| 1689 | (let* ((frame-size (comp-func-frame-size func)) | 1701 | (let* ((frame-size (comp-func-frame-size func)) |
| 1690 | (comp-func func) | 1702 | (comp-func func) |
| 1691 | (comp-pass (make-comp-limplify | 1703 | (comp-pass (make-comp-limplify |
| 1692 | :frame (comp-new-frame frame-size 0)))) | 1704 | :frame (comp--new-frame frame-size 0)))) |
| 1693 | (comp-fill-label-h) | 1705 | (comp--fill-label-h) |
| 1694 | ;; Prologue | 1706 | ;; Prologue |
| 1695 | (comp-make-curr-block 'entry (comp-sp)) | 1707 | (comp--make-curr-block 'entry (comp--sp)) |
| 1696 | (comp-emit-annotation (concat "Lisp function: " | 1708 | (comp--emit-annotation (concat "Lisp function: " |
| 1697 | (symbol-name (comp-func-name func)))) | 1709 | (symbol-name (comp-func-name func)))) |
| 1698 | ;; Dynamic functions have parameters bound by the trampoline. | 1710 | ;; Dynamic functions have parameters bound by the trampoline. |
| 1699 | (when (comp-func-l-p func) | 1711 | (when (comp-func-l-p func) |
| 1700 | (let ((args (comp-func-l-args func))) | 1712 | (let ((args (comp-func-l-args func))) |
| 1701 | (if (comp-args-p args) | 1713 | (if (comp-args-p args) |
| 1702 | (cl-loop for i below (comp-args-max args) | 1714 | (cl-loop for i below (comp-args-max args) |
| 1703 | do (cl-incf (comp-sp)) | 1715 | do (cl-incf (comp--sp)) |
| 1704 | (comp-emit `(set-par-to-local ,(comp-slot) ,i))) | 1716 | (comp--emit `(set-par-to-local ,(comp--slot) ,i))) |
| 1705 | (comp-emit-narg-prologue (comp-args-base-min args) | 1717 | (comp--emit-narg-prologue (comp-args-base-min args) |
| 1706 | (comp-nargs-nonrest args) | 1718 | (comp-nargs-nonrest args) |
| 1707 | (comp-nargs-rest args))))) | 1719 | (comp-nargs-rest args))))) |
| 1708 | (comp-emit '(jump bb_0)) | 1720 | (comp--emit '(jump bb_0)) |
| 1709 | ;; Body | 1721 | ;; Body |
| 1710 | (comp-bb-maybe-add 0 (comp-sp)) | 1722 | (comp--bb-maybe-add 0 (comp--sp)) |
| 1711 | (cl-loop for next-bb = (pop (comp-limplify-pending-blocks comp-pass)) | 1723 | (cl-loop for next-bb = (pop (comp-limplify-pending-blocks comp-pass)) |
| 1712 | while next-bb | 1724 | while next-bb |
| 1713 | do (comp-limplify-block next-bb)) | 1725 | do (comp--limplify-block next-bb)) |
| 1714 | ;; Sanity check against block duplication. | 1726 | ;; Sanity check against block duplication. |
| 1715 | (cl-loop with addr-h = (make-hash-table) | 1727 | (cl-loop with addr-h = (make-hash-table) |
| 1716 | for bb being the hash-value in (comp-func-blocks func) | 1728 | for bb being the hash-value in (comp-func-blocks func) |
| @@ -1719,15 +1731,15 @@ into the C code forwarding the compilation unit." | |||
| 1719 | when addr | 1731 | when addr |
| 1720 | do (cl-assert (null (gethash addr addr-h))) | 1732 | do (cl-assert (null (gethash addr addr-h))) |
| 1721 | (puthash addr t addr-h)) | 1733 | (puthash addr t addr-h)) |
| 1722 | (comp-limplify-finalize-function func))) | 1734 | (comp--limplify-finalize-function func))) |
| 1723 | 1735 | ||
| 1724 | (defun comp-limplify (_) | 1736 | (defun comp--limplify (_) |
| 1725 | "Compute LIMPLE IR for forms in `comp-ctxt'." | 1737 | "Compute LIMPLE IR for forms in `comp-ctxt'." |
| 1726 | (maphash (lambda (_ f) (comp-limplify-function f)) | 1738 | (maphash (lambda (_ f) (comp--limplify-function f)) |
| 1727 | (comp-ctxt-funcs-h comp-ctxt)) | 1739 | (comp-ctxt-funcs-h comp-ctxt)) |
| 1728 | (comp-add-func-to-ctxt (comp-limplify-top-level nil)) | 1740 | (comp--add-func-to-ctxt (comp--limplify-top-level nil)) |
| 1729 | (when (comp-ctxt-with-late-load comp-ctxt) | 1741 | (when (comp-ctxt-with-late-load comp-ctxt) |
| 1730 | (comp-add-func-to-ctxt (comp-limplify-top-level t)))) | 1742 | (comp--add-func-to-ctxt (comp--limplify-top-level t)))) |
| 1731 | 1743 | ||
| 1732 | 1744 | ||
| 1733 | ;;; add-cstrs pass specific code. | 1745 | ;;; add-cstrs pass specific code. |
| @@ -1751,22 +1763,22 @@ into the C code forwarding the compilation unit." | |||
| 1751 | ;; type specifier. | 1763 | ;; type specifier. |
| 1752 | 1764 | ||
| 1753 | 1765 | ||
| 1754 | (defsubst comp-mvar-used-p (mvar) | 1766 | (defsubst comp--mvar-used-p (mvar) |
| 1755 | "Non-nil when MVAR is used as lhs in the current function." | 1767 | "Non-nil when MVAR is used as lhs in the current function." |
| 1756 | (declare (gv-setter (lambda (val) | 1768 | (declare (gv-setter (lambda (val) |
| 1757 | `(puthash ,mvar ,val comp-pass)))) | 1769 | `(puthash ,mvar ,val comp-pass)))) |
| 1758 | (gethash mvar comp-pass)) | 1770 | (gethash mvar comp-pass)) |
| 1759 | 1771 | ||
| 1760 | (defun comp-collect-mvars (form) | 1772 | (defun comp--collect-mvars (form) |
| 1761 | "Add rhs m-var present in FORM into `comp-pass'." | 1773 | "Add rhs m-var present in FORM into `comp-pass'." |
| 1762 | (cl-loop for x in form | 1774 | (cl-loop for x in form |
| 1763 | if (consp x) | 1775 | if (consp x) |
| 1764 | do (comp-collect-mvars x) | 1776 | do (comp--collect-mvars x) |
| 1765 | else | 1777 | else |
| 1766 | when (comp-mvar-p x) | 1778 | when (comp-mvar-p x) |
| 1767 | do (setf (comp-mvar-used-p x) t))) | 1779 | do (setf (comp--mvar-used-p x) t))) |
| 1768 | 1780 | ||
| 1769 | (defun comp-collect-rhs () | 1781 | (defun comp--collect-rhs () |
| 1770 | "Collect all lhs mvars into `comp-pass'." | 1782 | "Collect all lhs mvars into `comp-pass'." |
| 1771 | (cl-loop | 1783 | (cl-loop |
| 1772 | for b being each hash-value of (comp-func-blocks comp-func) | 1784 | for b being each hash-value of (comp-func-blocks comp-func) |
| @@ -1774,11 +1786,11 @@ into the C code forwarding the compilation unit." | |||
| 1774 | for insn in (comp-block-insns b) | 1786 | for insn in (comp-block-insns b) |
| 1775 | for (op . args) = insn | 1787 | for (op . args) = insn |
| 1776 | if (comp--assign-op-p op) | 1788 | if (comp--assign-op-p op) |
| 1777 | do (comp-collect-mvars (cdr args)) | 1789 | do (comp--collect-mvars (cdr args)) |
| 1778 | else | 1790 | else |
| 1779 | do (comp-collect-mvars args)))) | 1791 | do (comp--collect-mvars args)))) |
| 1780 | 1792 | ||
| 1781 | (defun comp-negate-arithm-cmp-fun (function) | 1793 | (defun comp--negate-arithm-cmp-fun (function) |
| 1782 | "Negate FUNCTION. | 1794 | "Negate FUNCTION. |
| 1783 | Return nil if we don't want to emit constraints for its negation." | 1795 | Return nil if we don't want to emit constraints for its negation." |
| 1784 | (cl-ecase function | 1796 | (cl-ecase function |
| @@ -1788,7 +1800,7 @@ Return nil if we don't want to emit constraints for its negation." | |||
| 1788 | (>= '<) | 1800 | (>= '<) |
| 1789 | (<= '>))) | 1801 | (<= '>))) |
| 1790 | 1802 | ||
| 1791 | (defun comp-reverse-arithm-fun (function) | 1803 | (defun comp--reverse-arithm-fun (function) |
| 1792 | "Reverse FUNCTION." | 1804 | "Reverse FUNCTION." |
| 1793 | (cl-case function | 1805 | (cl-case function |
| 1794 | (= '=) | 1806 | (= '=) |
| @@ -1798,7 +1810,7 @@ Return nil if we don't want to emit constraints for its negation." | |||
| 1798 | (<= '>=) | 1810 | (<= '>=) |
| 1799 | (t function))) | 1811 | (t function))) |
| 1800 | 1812 | ||
| 1801 | (defun comp-emit-assume (kind lhs rhs bb negated) | 1813 | (defun comp--emit-assume (kind lhs rhs bb negated) |
| 1802 | "Emit an assume of kind KIND for mvar LHS being RHS. | 1814 | "Emit an assume of kind KIND for mvar LHS being RHS. |
| 1803 | When NEGATED is non-nil, the assumption is negated. | 1815 | When NEGATED is non-nil, the assumption is negated. |
| 1804 | The assume is emitted at the beginning of the block BB." | 1816 | The assume is emitted at the beginning of the block BB." |
| @@ -1808,41 +1820,41 @@ The assume is emitted at the beginning of the block BB." | |||
| 1808 | ((or 'and 'and-nhc) | 1820 | ((or 'and 'and-nhc) |
| 1809 | (if (comp-mvar-p rhs) | 1821 | (if (comp-mvar-p rhs) |
| 1810 | (let ((tmp-mvar (if negated | 1822 | (let ((tmp-mvar (if negated |
| 1811 | (make-comp-mvar :slot (comp-mvar-slot rhs)) | 1823 | (make--comp-mvar :slot (comp-mvar-slot rhs)) |
| 1812 | rhs))) | 1824 | rhs))) |
| 1813 | (push `(assume ,(make-comp-mvar :slot lhs-slot) | 1825 | (push `(assume ,(make--comp-mvar :slot lhs-slot) |
| 1814 | (,kind ,lhs ,tmp-mvar)) | 1826 | (,kind ,lhs ,tmp-mvar)) |
| 1815 | (comp-block-insns bb)) | 1827 | (comp-block-insns bb)) |
| 1816 | (if negated | 1828 | (if negated |
| 1817 | (push `(assume ,tmp-mvar (not ,rhs)) | 1829 | (push `(assume ,tmp-mvar (not ,rhs)) |
| 1818 | (comp-block-insns bb)))) | 1830 | (comp-block-insns bb)))) |
| 1819 | ;; If is only a constraint we can negate it directly. | 1831 | ;; If is only a constraint we can negate it directly. |
| 1820 | (push `(assume ,(make-comp-mvar :slot lhs-slot) | 1832 | (push `(assume ,(make--comp-mvar :slot lhs-slot) |
| 1821 | (,kind ,lhs ,(if negated | 1833 | (,kind ,lhs ,(if negated |
| 1822 | (comp-cstr-negation-make rhs) | 1834 | (comp-cstr-negation-make rhs) |
| 1823 | rhs))) | 1835 | rhs))) |
| 1824 | (comp-block-insns bb)))) | 1836 | (comp-block-insns bb)))) |
| 1825 | ((pred comp--arithm-cmp-fun-p) | 1837 | ((pred comp--arithm-cmp-fun-p) |
| 1826 | (when-let ((kind (if negated | 1838 | (when-let ((kind (if negated |
| 1827 | (comp-negate-arithm-cmp-fun kind) | 1839 | (comp--negate-arithm-cmp-fun kind) |
| 1828 | kind))) | 1840 | kind))) |
| 1829 | (push `(assume ,(make-comp-mvar :slot lhs-slot) | 1841 | (push `(assume ,(make--comp-mvar :slot lhs-slot) |
| 1830 | (,kind ,lhs | 1842 | (,kind ,lhs |
| 1831 | ,(if-let* ((vld (comp-cstr-imm-vld-p rhs)) | 1843 | ,(if-let* ((vld (comp-cstr-imm-vld-p rhs)) |
| 1832 | (val (comp-cstr-imm rhs)) | 1844 | (val (comp-cstr-imm rhs)) |
| 1833 | (ok (and (integerp val) | 1845 | (ok (and (integerp val) |
| 1834 | (not (memq kind '(= !=)))))) | 1846 | (not (memq kind '(= !=)))))) |
| 1835 | val | 1847 | val |
| 1836 | (make-comp-mvar :slot (comp-mvar-slot rhs))))) | 1848 | (make--comp-mvar :slot (comp-mvar-slot rhs))))) |
| 1837 | (comp-block-insns bb)))) | 1849 | (comp-block-insns bb)))) |
| 1838 | (_ (cl-assert nil))) | 1850 | (_ (cl-assert nil))) |
| 1839 | (setf (comp-func-ssa-status comp-func) 'dirty))) | 1851 | (setf (comp-func-ssa-status comp-func) 'dirty))) |
| 1840 | 1852 | ||
| 1841 | (defun comp-maybe-add-vmvar (op cmp-res insns-seq) | 1853 | (defun comp--maybe-add-vmvar (op cmp-res insns-seq) |
| 1842 | "If CMP-RES is clobbering OP emit a new constrained mvar and return it. | 1854 | "If CMP-RES is clobbering OP emit a new constrained mvar and return it. |
| 1843 | Return OP otherwise." | 1855 | Return OP otherwise." |
| 1844 | (if-let ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res))) | 1856 | (if-let ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res))) |
| 1845 | (new-mvar (make-comp-mvar | 1857 | (new-mvar (make--comp-mvar |
| 1846 | :slot | 1858 | :slot |
| 1847 | (- (cl-incf (comp-func-vframe-size comp-func)))))) | 1859 | (- (cl-incf (comp-func-vframe-size comp-func)))))) |
| 1848 | (progn | 1860 | (progn |
| @@ -1850,7 +1862,7 @@ Return OP otherwise." | |||
| 1850 | new-mvar) | 1862 | new-mvar) |
| 1851 | op)) | 1863 | op)) |
| 1852 | 1864 | ||
| 1853 | (defun comp-add-new-block-between (bb-symbol bb-a bb-b) | 1865 | (defun comp--add-new-block-between (bb-symbol bb-a bb-b) |
| 1854 | "Create a new basic-block named BB-SYMBOL and add it between BB-A and BB-B." | 1866 | "Create a new basic-block named BB-SYMBOL and add it between BB-A and BB-B." |
| 1855 | (cl-loop | 1867 | (cl-loop |
| 1856 | with new-bb = (make-comp-block-cstr :name bb-symbol | 1868 | with new-bb = (make-comp-block-cstr :name bb-symbol |
| @@ -1873,7 +1885,7 @@ Return OP otherwise." | |||
| 1873 | finally (cl-assert nil))) | 1885 | finally (cl-assert nil))) |
| 1874 | 1886 | ||
| 1875 | ;; Cheap substitute to a copy propagation pass... | 1887 | ;; Cheap substitute to a copy propagation pass... |
| 1876 | (defun comp-cond-cstrs-target-mvar (mvar exit-insn bb) | 1888 | (defun comp--cond-cstrs-target-mvar (mvar exit-insn bb) |
| 1877 | "Given MVAR, search in BB the original mvar MVAR got assigned from. | 1889 | "Given MVAR, search in BB the original mvar MVAR got assigned from. |
| 1878 | Keep on searching till EXIT-INSN is encountered." | 1890 | Keep on searching till EXIT-INSN is encountered." |
| 1879 | (cl-flet ((targetp (x) | 1891 | (cl-flet ((targetp (x) |
| @@ -1890,7 +1902,7 @@ Keep on searching till EXIT-INSN is encountered." | |||
| 1890 | (setf res rhs))) | 1902 | (setf res rhs))) |
| 1891 | finally (cl-assert nil)))) | 1903 | finally (cl-assert nil)))) |
| 1892 | 1904 | ||
| 1893 | (defun comp-add-cond-cstrs-target-block (curr-bb target-bb-sym) | 1905 | (defun comp--add-cond-cstrs-target-block (curr-bb target-bb-sym) |
| 1894 | "Return the appropriate basic block to add constraint assumptions into. | 1906 | "Return the appropriate basic block to add constraint assumptions into. |
| 1895 | CURR-BB is the current basic block. | 1907 | CURR-BB is the current basic block. |
| 1896 | TARGET-BB-SYM is the symbol name of the target block." | 1908 | TARGET-BB-SYM is the symbol name of the target block." |
| @@ -1910,10 +1922,10 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 1910 | until (null (gethash new-name (comp-func-blocks comp-func))) | 1922 | until (null (gethash new-name (comp-func-blocks comp-func))) |
| 1911 | finally | 1923 | finally |
| 1912 | ;; Add it. | 1924 | ;; Add it. |
| 1913 | (cl-return (comp-add-new-block-between new-name curr-bb target-bb)))))) | 1925 | (cl-return (comp--add-new-block-between new-name curr-bb target-bb)))))) |
| 1914 | 1926 | ||
| 1915 | (defun comp-add-cond-cstrs-simple () | 1927 | (defun comp--add-cond-cstrs-simple () |
| 1916 | "`comp-add-cstrs' worker function for each selected function." | 1928 | "`comp--add-cstrs' worker function for each selected function." |
| 1917 | (cl-loop | 1929 | (cl-loop |
| 1918 | for b being each hash-value of (comp-func-blocks comp-func) | 1930 | for b being each hash-value of (comp-func-blocks comp-func) |
| 1919 | do | 1931 | do |
| @@ -1929,26 +1941,26 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 1929 | for branch-target-cell on blocks | 1941 | for branch-target-cell on blocks |
| 1930 | for branch-target = (car branch-target-cell) | 1942 | for branch-target = (car branch-target-cell) |
| 1931 | for negated in '(nil t) | 1943 | for negated in '(nil t) |
| 1932 | when (comp-mvar-used-p tmp-mvar) | 1944 | when (comp--mvar-used-p tmp-mvar) |
| 1933 | do | 1945 | do |
| 1934 | (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) | 1946 | (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) |
| 1935 | (setf (car branch-target-cell) (comp-block-name block-target)) | 1947 | (setf (car branch-target-cell) (comp-block-name block-target)) |
| 1936 | (comp-emit-assume 'and tmp-mvar obj2 block-target negated)) | 1948 | (comp--emit-assume 'and tmp-mvar obj2 block-target negated)) |
| 1937 | finally (cl-return-from in-the-basic-block))) | 1949 | finally (cl-return-from in-the-basic-block))) |
| 1938 | (`((cond-jump ,obj1 ,obj2 . ,blocks)) | 1950 | (`((cond-jump ,obj1 ,obj2 . ,blocks)) |
| 1939 | (cl-loop | 1951 | (cl-loop |
| 1940 | for branch-target-cell on blocks | 1952 | for branch-target-cell on blocks |
| 1941 | for branch-target = (car branch-target-cell) | 1953 | for branch-target = (car branch-target-cell) |
| 1942 | for negated in '(nil t) | 1954 | for negated in '(nil t) |
| 1943 | when (comp-mvar-used-p obj1) | 1955 | when (comp--mvar-used-p obj1) |
| 1944 | do | 1956 | do |
| 1945 | (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) | 1957 | (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) |
| 1946 | (setf (car branch-target-cell) (comp-block-name block-target)) | 1958 | (setf (car branch-target-cell) (comp-block-name block-target)) |
| 1947 | (comp-emit-assume 'and obj1 obj2 block-target negated)) | 1959 | (comp--emit-assume 'and obj1 obj2 block-target negated)) |
| 1948 | finally (cl-return-from in-the-basic-block))))))) | 1960 | finally (cl-return-from in-the-basic-block))))))) |
| 1949 | 1961 | ||
| 1950 | (defun comp-add-cond-cstrs () | 1962 | (defun comp--add-cond-cstrs () |
| 1951 | "`comp-add-cstrs' worker function for each selected function." | 1963 | "`comp--add-cstrs' worker function for each selected function." |
| 1952 | (cl-loop | 1964 | (cl-loop |
| 1953 | for b being each hash-value of (comp-func-blocks comp-func) | 1965 | for b being each hash-value of (comp-func-blocks comp-func) |
| 1954 | do | 1966 | do |
| @@ -1967,13 +1979,13 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 1967 | (set ,(and (pred comp-mvar-p) mvar-3) | 1979 | (set ,(and (pred comp-mvar-p) mvar-3) |
| 1968 | (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2))) | 1980 | (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2))) |
| 1969 | (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 ,bb2)) | 1981 | (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 ,bb2)) |
| 1970 | (comp-emit-assume 'and mvar-tested | 1982 | (comp--emit-assume 'and mvar-tested |
| 1971 | (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag)) | 1983 | (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag)) |
| 1972 | (comp-add-cond-cstrs-target-block b bb2) | 1984 | (comp--add-cond-cstrs-target-block b bb2) |
| 1973 | nil) | 1985 | nil) |
| 1974 | (comp-emit-assume 'and mvar-tested | 1986 | (comp--emit-assume 'and mvar-tested |
| 1975 | (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag)) | 1987 | (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag)) |
| 1976 | (comp-add-cond-cstrs-target-block b bb1) | 1988 | (comp--add-cond-cstrs-target-block b bb1) |
| 1977 | t)) | 1989 | t)) |
| 1978 | (`((set ,(and (pred comp-mvar-p) cmp-res) | 1990 | (`((set ,(and (pred comp-mvar-p) cmp-res) |
| 1979 | (,(pred comp--call-op-p) | 1991 | (,(pred comp--call-op-p) |
| @@ -1984,8 +1996,8 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 1984 | ;; (comment ,_comment-str) | 1996 | ;; (comment ,_comment-str) |
| 1985 | (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) | 1997 | (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) |
| 1986 | (cl-loop | 1998 | (cl-loop |
| 1987 | with target-mvar1 = (comp-cond-cstrs-target-mvar op1 (car insns-seq) b) | 1999 | with target-mvar1 = (comp--cond-cstrs-target-mvar op1 (car insns-seq) b) |
| 1988 | with target-mvar2 = (comp-cond-cstrs-target-mvar op2 (car insns-seq) b) | 2000 | with target-mvar2 = (comp--cond-cstrs-target-mvar op2 (car insns-seq) b) |
| 1989 | for branch-target-cell on blocks | 2001 | for branch-target-cell on blocks |
| 1990 | for branch-target = (car branch-target-cell) | 2002 | for branch-target = (car branch-target-cell) |
| 1991 | for negated in '(t nil) | 2003 | for negated in '(t nil) |
| @@ -1994,19 +2006,19 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 1994 | (eql 'and-nhc) | 2006 | (eql 'and-nhc) |
| 1995 | (eq 'and) | 2007 | (eq 'and) |
| 1996 | (t fun)) | 2008 | (t fun)) |
| 1997 | when (or (comp-mvar-used-p target-mvar1) | 2009 | when (or (comp--mvar-used-p target-mvar1) |
| 1998 | (comp-mvar-used-p target-mvar2)) | 2010 | (comp--mvar-used-p target-mvar2)) |
| 1999 | do | 2011 | do |
| 2000 | (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) | 2012 | (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) |
| 2001 | (setf (car branch-target-cell) (comp-block-name block-target)) | 2013 | (setf (car branch-target-cell) (comp-block-name block-target)) |
| 2002 | (when (comp-mvar-used-p target-mvar1) | 2014 | (when (comp--mvar-used-p target-mvar1) |
| 2003 | (comp-emit-assume kind target-mvar1 | 2015 | (comp--emit-assume kind target-mvar1 |
| 2004 | (comp-maybe-add-vmvar op2 cmp-res prev-insns-seq) | 2016 | (comp--maybe-add-vmvar op2 cmp-res prev-insns-seq) |
| 2005 | block-target negated)) | 2017 | block-target negated)) |
| 2006 | (when (comp-mvar-used-p target-mvar2) | 2018 | (when (comp--mvar-used-p target-mvar2) |
| 2007 | (comp-emit-assume (comp-reverse-arithm-fun kind) | 2019 | (comp--emit-assume (comp--reverse-arithm-fun kind) |
| 2008 | target-mvar2 | 2020 | target-mvar2 |
| 2009 | (comp-maybe-add-vmvar op1 cmp-res prev-insns-seq) | 2021 | (comp--maybe-add-vmvar op1 cmp-res prev-insns-seq) |
| 2010 | block-target negated))) | 2022 | block-target negated))) |
| 2011 | finally (cl-return-from in-the-basic-block))) | 2023 | finally (cl-return-from in-the-basic-block))) |
| 2012 | (`((set ,(and (pred comp-mvar-p) cmp-res) | 2024 | (`((set ,(and (pred comp-mvar-p) cmp-res) |
| @@ -2016,16 +2028,16 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 2016 | ;; (comment ,_comment-str) | 2028 | ;; (comment ,_comment-str) |
| 2017 | (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) | 2029 | (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) |
| 2018 | (cl-loop | 2030 | (cl-loop |
| 2019 | with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b) | 2031 | with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) |
| 2020 | with cstr = (comp--pred-to-cstr fun) | 2032 | with cstr = (comp--pred-to-cstr fun) |
| 2021 | for branch-target-cell on blocks | 2033 | for branch-target-cell on blocks |
| 2022 | for branch-target = (car branch-target-cell) | 2034 | for branch-target = (car branch-target-cell) |
| 2023 | for negated in '(t nil) | 2035 | for negated in '(t nil) |
| 2024 | when (comp-mvar-used-p target-mvar) | 2036 | when (comp--mvar-used-p target-mvar) |
| 2025 | do | 2037 | do |
| 2026 | (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) | 2038 | (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) |
| 2027 | (setf (car branch-target-cell) (comp-block-name block-target)) | 2039 | (setf (car branch-target-cell) (comp-block-name block-target)) |
| 2028 | (comp-emit-assume 'and target-mvar cstr block-target negated)) | 2040 | (comp--emit-assume 'and target-mvar cstr block-target negated)) |
| 2029 | finally (cl-return-from in-the-basic-block))) | 2041 | finally (cl-return-from in-the-basic-block))) |
| 2030 | ;; Match predicate on the negated branch (unless). | 2042 | ;; Match predicate on the negated branch (unless). |
| 2031 | (`((set ,(and (pred comp-mvar-p) cmp-res) | 2043 | (`((set ,(and (pred comp-mvar-p) cmp-res) |
| @@ -2035,20 +2047,20 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 2035 | (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p))) | 2047 | (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p))) |
| 2036 | (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) | 2048 | (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) |
| 2037 | (cl-loop | 2049 | (cl-loop |
| 2038 | with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b) | 2050 | with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) |
| 2039 | with cstr = (comp--pred-to-cstr fun) | 2051 | with cstr = (comp--pred-to-cstr fun) |
| 2040 | for branch-target-cell on blocks | 2052 | for branch-target-cell on blocks |
| 2041 | for branch-target = (car branch-target-cell) | 2053 | for branch-target = (car branch-target-cell) |
| 2042 | for negated in '(nil t) | 2054 | for negated in '(nil t) |
| 2043 | when (comp-mvar-used-p target-mvar) | 2055 | when (comp--mvar-used-p target-mvar) |
| 2044 | do | 2056 | do |
| 2045 | (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) | 2057 | (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) |
| 2046 | (setf (car branch-target-cell) (comp-block-name block-target)) | 2058 | (setf (car branch-target-cell) (comp-block-name block-target)) |
| 2047 | (comp-emit-assume 'and target-mvar cstr block-target negated)) | 2059 | (comp--emit-assume 'and target-mvar cstr block-target negated)) |
| 2048 | finally (cl-return-from in-the-basic-block)))) | 2060 | finally (cl-return-from in-the-basic-block)))) |
| 2049 | (setf prev-insns-seq insns-seq)))) | 2061 | (setf prev-insns-seq insns-seq)))) |
| 2050 | 2062 | ||
| 2051 | (defsubst comp-insert-insn (insn insn-cell) | 2063 | (defsubst comp--insert-insn (insn insn-cell) |
| 2052 | "Insert INSN as second insn of INSN-CELL." | 2064 | "Insert INSN as second insn of INSN-CELL." |
| 2053 | (let ((next-cell (cdr insn-cell)) | 2065 | (let ((next-cell (cdr insn-cell)) |
| 2054 | (new-cell `(,insn))) | 2066 | (new-cell `(,insn))) |
| @@ -2056,15 +2068,15 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 2056 | (cdr new-cell) next-cell | 2068 | (cdr new-cell) next-cell |
| 2057 | (comp-func-ssa-status comp-func) 'dirty))) | 2069 | (comp-func-ssa-status comp-func) 'dirty))) |
| 2058 | 2070 | ||
| 2059 | (defun comp-emit-call-cstr (mvar call-cell cstr) | 2071 | (defun comp--emit-call-cstr (mvar call-cell cstr) |
| 2060 | "Emit a constraint CSTR for MVAR after CALL-CELL." | 2072 | "Emit a constraint CSTR for MVAR after CALL-CELL." |
| 2061 | (let* ((new-mvar (make-comp-mvar :slot (comp-mvar-slot mvar))) | 2073 | (let* ((new-mvar (make--comp-mvar :slot (comp-mvar-slot mvar))) |
| 2062 | ;; Have new-mvar as LHS *and* RHS to ensure monotonicity and | 2074 | ;; Have new-mvar as LHS *and* RHS to ensure monotonicity and |
| 2063 | ;; fwprop convergence!! | 2075 | ;; fwprop convergence!! |
| 2064 | (insn `(assume ,new-mvar (and ,new-mvar ,mvar ,cstr)))) | 2076 | (insn `(assume ,new-mvar (and ,new-mvar ,mvar ,cstr)))) |
| 2065 | (comp-insert-insn insn call-cell))) | 2077 | (comp--insert-insn insn call-cell))) |
| 2066 | 2078 | ||
| 2067 | (defun comp-lambda-list-gen (lambda-list) | 2079 | (defun comp--lambda-list-gen (lambda-list) |
| 2068 | "Return a generator to iterate over LAMBDA-LIST." | 2080 | "Return a generator to iterate over LAMBDA-LIST." |
| 2069 | (lambda () | 2081 | (lambda () |
| 2070 | (cl-case (car lambda-list) | 2082 | (cl-case (car lambda-list) |
| @@ -2080,12 +2092,12 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 2080 | (car lambda-list) | 2092 | (car lambda-list) |
| 2081 | (setf lambda-list (cdr lambda-list))))))) | 2093 | (setf lambda-list (cdr lambda-list))))))) |
| 2082 | 2094 | ||
| 2083 | (defun comp-add-call-cstr () | 2095 | (defun comp--add-call-cstr () |
| 2084 | "Add args assumptions for each function of which the type specifier is known." | 2096 | "Add args assumptions for each function of which the type specifier is known." |
| 2085 | (cl-loop | 2097 | (cl-loop |
| 2086 | for bb being each hash-value of (comp-func-blocks comp-func) | 2098 | for bb being each hash-value of (comp-func-blocks comp-func) |
| 2087 | do | 2099 | do |
| 2088 | (comp-loop-insn-in-block bb | 2100 | (comp--loop-insn-in-block bb |
| 2089 | (when-let ((match | 2101 | (when-let ((match |
| 2090 | (pcase insn | 2102 | (pcase insn |
| 2091 | (`(set ,lhs (,(pred comp--call-op-p) ,f . ,args)) | 2103 | (`(set ,lhs (,(pred comp--call-op-p) ,f . ,args)) |
| @@ -2096,10 +2108,10 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 2096 | (cl-values f cstr-f nil args)))))) | 2108 | (cl-values f cstr-f nil args)))))) |
| 2097 | (cl-multiple-value-bind (f cstr-f lhs args) match | 2109 | (cl-multiple-value-bind (f cstr-f lhs args) match |
| 2098 | (cl-loop | 2110 | (cl-loop |
| 2099 | with gen = (comp-lambda-list-gen (comp-cstr-f-args cstr-f)) | 2111 | with gen = (comp--lambda-list-gen (comp-cstr-f-args cstr-f)) |
| 2100 | for arg in args | 2112 | for arg in args |
| 2101 | for cstr = (funcall gen) | 2113 | for cstr = (funcall gen) |
| 2102 | for target = (comp-cond-cstrs-target-mvar arg insn bb) | 2114 | for target = (comp--cond-cstrs-target-mvar arg insn bb) |
| 2103 | unless (comp-cstr-p cstr) | 2115 | unless (comp-cstr-p cstr) |
| 2104 | do (signal 'native-ice | 2116 | do (signal 'native-ice |
| 2105 | (list "Incoherent type specifier for function" f)) | 2117 | (list "Incoherent type specifier for function" f)) |
| @@ -2110,9 +2122,9 @@ TARGET-BB-SYM is the symbol name of the target block." | |||
| 2110 | (or (null lhs) | 2122 | (or (null lhs) |
| 2111 | (not (eql (comp-mvar-slot lhs) | 2123 | (not (eql (comp-mvar-slot lhs) |
| 2112 | (comp-mvar-slot target))))) | 2124 | (comp-mvar-slot target))))) |
| 2113 | do (comp-emit-call-cstr target insn-cell cstr))))))) | 2125 | do (comp--emit-call-cstr target insn-cell cstr))))))) |
| 2114 | 2126 | ||
| 2115 | (defun comp-add-cstrs (_) | 2127 | (defun comp--add-cstrs (_) |
| 2116 | "Rewrite conditional branches adding appropriate `assume' insns. | 2128 | "Rewrite conditional branches adding appropriate `assume' insns. |
| 2117 | This is introducing and placing `assume' insns in use by fwprop | 2129 | This is introducing and placing `assume' insns in use by fwprop |
| 2118 | to propagate conditional branch test information on target basic | 2130 | to propagate conditional branch test information on target basic |
| @@ -2126,10 +2138,10 @@ blocks." | |||
| 2126 | (not (comp-func-has-non-local f))) | 2138 | (not (comp-func-has-non-local f))) |
| 2127 | (let ((comp-func f) | 2139 | (let ((comp-func f) |
| 2128 | (comp-pass (make-hash-table :test #'eq))) | 2140 | (comp-pass (make-hash-table :test #'eq))) |
| 2129 | (comp-collect-rhs) | 2141 | (comp--collect-rhs) |
| 2130 | (comp-add-cond-cstrs-simple) | 2142 | (comp--add-cond-cstrs-simple) |
| 2131 | (comp-add-cond-cstrs) | 2143 | (comp--add-cond-cstrs) |
| 2132 | (comp-add-call-cstr) | 2144 | (comp--add-call-cstr) |
| 2133 | (comp--log-func comp-func 3)))) | 2145 | (comp--log-func comp-func 3)))) |
| 2134 | (comp-ctxt-funcs-h comp-ctxt))) | 2146 | (comp-ctxt-funcs-h comp-ctxt))) |
| 2135 | 2147 | ||
| @@ -2141,7 +2153,7 @@ blocks." | |||
| 2141 | ;; avoid optimizing-out functions and preventing their redefinition | 2153 | ;; avoid optimizing-out functions and preventing their redefinition |
| 2142 | ;; being effective. | 2154 | ;; being effective. |
| 2143 | 2155 | ||
| 2144 | (defun comp-collect-calls (f) | 2156 | (defun comp--collect-calls (f) |
| 2145 | "Return a list with all the functions called by F." | 2157 | "Return a list with all the functions called by F." |
| 2146 | (cl-loop | 2158 | (cl-loop |
| 2147 | with h = (make-hash-table :test #'eq) | 2159 | with h = (make-hash-table :test #'eq) |
| @@ -2161,17 +2173,17 @@ blocks." | |||
| 2161 | (comp-ctxt-funcs-h comp-ctxt))) | 2173 | (comp-ctxt-funcs-h comp-ctxt))) |
| 2162 | f)))) | 2174 | f)))) |
| 2163 | 2175 | ||
| 2164 | (defun comp-pure-infer-func (f) | 2176 | (defun comp--pure-infer-func (f) |
| 2165 | "If all functions called by F are pure then F is pure too." | 2177 | "If all functions called by F are pure then F is pure too." |
| 2166 | (when (and (cl-every (lambda (x) | 2178 | (when (and (cl-every (lambda (x) |
| 2167 | (or (comp--function-pure-p x) | 2179 | (or (comp--function-pure-p x) |
| 2168 | (eq x (comp-func-name f)))) | 2180 | (eq x (comp-func-name f)))) |
| 2169 | (comp-collect-calls f)) | 2181 | (comp--collect-calls f)) |
| 2170 | (not (eq (comp-func-pure f) t))) | 2182 | (not (eq (comp-func-pure f) t))) |
| 2171 | (comp-log (format "%s inferred to be pure" (comp-func-name f))) | 2183 | (comp-log (format "%s inferred to be pure" (comp-func-name f))) |
| 2172 | (setf (comp-func-pure f) t))) | 2184 | (setf (comp-func-pure f) t))) |
| 2173 | 2185 | ||
| 2174 | (defun comp-ipa-pure (_) | 2186 | (defun comp--ipa-pure (_) |
| 2175 | "Infer function purity." | 2187 | "Infer function purity." |
| 2176 | (cl-loop | 2188 | (cl-loop |
| 2177 | with pure-n = 0 | 2189 | with pure-n = 0 |
| @@ -2184,7 +2196,7 @@ blocks." | |||
| 2184 | when (and (>= (comp-func-speed f) 3) | 2196 | when (and (>= (comp-func-speed f) 3) |
| 2185 | (comp-func-l-p f) | 2197 | (comp-func-l-p f) |
| 2186 | (not (comp-func-pure f))) | 2198 | (not (comp-func-pure f))) |
| 2187 | do (comp-pure-infer-func f) | 2199 | do (comp--pure-infer-func f) |
| 2188 | count (comp-func-pure f)))) | 2200 | count (comp-func-pure f)))) |
| 2189 | finally (comp-log (format "ipa-pure iterated %d times" n)))) | 2201 | finally (comp-log (format "ipa-pure iterated %d times" n)))) |
| 2190 | 2202 | ||
| @@ -2198,13 +2210,13 @@ blocks." | |||
| 2198 | ;; this form is called 'minimal SSA form'. | 2210 | ;; this form is called 'minimal SSA form'. |
| 2199 | ;; This pass should be run every time basic blocks or m-var are shuffled. | 2211 | ;; This pass should be run every time basic blocks or m-var are shuffled. |
| 2200 | 2212 | ||
| 2201 | (cl-defun make-comp-ssa-mvar (&rest rest &key _slot _constant _type) | 2213 | (cl-defun make--comp--ssa-mvar (&rest rest &key _slot _constant _type) |
| 2202 | "Same as `make-comp-mvar' but set the `id' slot." | 2214 | "Same as `make--comp-mvar' but set the `id' slot." |
| 2203 | (let ((mvar (apply #'make-comp-mvar rest))) | 2215 | (let ((mvar (apply #'make--comp-mvar rest))) |
| 2204 | (setf (comp-mvar-id mvar) (sxhash-eq mvar)) | 2216 | (setf (comp-mvar-id mvar) (sxhash-eq mvar)) |
| 2205 | mvar)) | 2217 | mvar)) |
| 2206 | 2218 | ||
| 2207 | (defun comp-clean-ssa (f) | 2219 | (defun comp--clean-ssa (f) |
| 2208 | "Clean-up SSA for function F." | 2220 | "Clean-up SSA for function F." |
| 2209 | (setf (comp-func-edges-h f) (make-hash-table)) | 2221 | (setf (comp-func-edges-h f) (make-hash-table)) |
| 2210 | (cl-loop | 2222 | (cl-loop |
| @@ -2220,7 +2232,7 @@ blocks." | |||
| 2220 | unless (eq 'phi (car insn)) | 2232 | unless (eq 'phi (car insn)) |
| 2221 | collect insn)))) | 2233 | collect insn)))) |
| 2222 | 2234 | ||
| 2223 | (defun comp-compute-edges () | 2235 | (defun comp--compute-edges () |
| 2224 | "Compute the basic block edges for the current function." | 2236 | "Compute the basic block edges for the current function." |
| 2225 | (cl-loop with blocks = (comp-func-blocks comp-func) | 2237 | (cl-loop with blocks = (comp-func-blocks comp-func) |
| 2226 | for bb being each hash-value of blocks | 2238 | for bb being each hash-value of blocks |
| @@ -2256,7 +2268,7 @@ blocks." | |||
| 2256 | (comp-block-in-edges (comp-edge-dst edge)))) | 2268 | (comp-block-in-edges (comp-edge-dst edge)))) |
| 2257 | (comp--log-edges comp-func))) | 2269 | (comp--log-edges comp-func))) |
| 2258 | 2270 | ||
| 2259 | (defun comp-collect-rev-post-order (basic-block) | 2271 | (defun comp--collect-rev-post-order (basic-block) |
| 2260 | "Walk BASIC-BLOCK children and return their name in reversed post-order." | 2272 | "Walk BASIC-BLOCK children and return their name in reversed post-order." |
| 2261 | (let ((visited (make-hash-table)) | 2273 | (let ((visited (make-hash-table)) |
| 2262 | (acc ())) | 2274 | (acc ())) |
| @@ -2271,7 +2283,7 @@ blocks." | |||
| 2271 | (collect-rec basic-block) | 2283 | (collect-rec basic-block) |
| 2272 | acc))) | 2284 | acc))) |
| 2273 | 2285 | ||
| 2274 | (defun comp-compute-dominator-tree () | 2286 | (defun comp--compute-dominator-tree () |
| 2275 | "Compute immediate dominators for each basic block in current function." | 2287 | "Compute immediate dominators for each basic block in current function." |
| 2276 | ;; Originally based on: "A Simple, Fast Dominance Algorithm" | 2288 | ;; Originally based on: "A Simple, Fast Dominance Algorithm" |
| 2277 | ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001). | 2289 | ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001). |
| @@ -2296,7 +2308,7 @@ blocks." | |||
| 2296 | ;; No point to go on if the only bb is 'entry'. | 2308 | ;; No point to go on if the only bb is 'entry'. |
| 2297 | (bb0 (gethash 'bb_0 blocks))) | 2309 | (bb0 (gethash 'bb_0 blocks))) |
| 2298 | (cl-loop | 2310 | (cl-loop |
| 2299 | with rev-bb-list = (comp-collect-rev-post-order entry) | 2311 | with rev-bb-list = (comp--collect-rev-post-order entry) |
| 2300 | with changed = t | 2312 | with changed = t |
| 2301 | while changed | 2313 | while changed |
| 2302 | initially (progn | 2314 | initially (progn |
| @@ -2323,7 +2335,7 @@ blocks." | |||
| 2323 | new-idom) | 2335 | new-idom) |
| 2324 | changed t)))))) | 2336 | changed t)))))) |
| 2325 | 2337 | ||
| 2326 | (defun comp-compute-dominator-frontiers () | 2338 | (defun comp--compute-dominator-frontiers () |
| 2327 | "Compute the dominator frontier for each basic block in `comp-func'." | 2339 | "Compute the dominator frontier for each basic block in `comp-func'." |
| 2328 | ;; Originally based on: "A Simple, Fast Dominance Algorithm" | 2340 | ;; Originally based on: "A Simple, Fast Dominance Algorithm" |
| 2329 | ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001). | 2341 | ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001). |
| @@ -2338,7 +2350,7 @@ blocks." | |||
| 2338 | (puthash b-name b (comp-block-df runner)) | 2350 | (puthash b-name b (comp-block-df runner)) |
| 2339 | (setf runner (comp-block-idom runner)))))) | 2351 | (setf runner (comp-block-idom runner)))))) |
| 2340 | 2352 | ||
| 2341 | (defun comp-log-block-info () | 2353 | (defun comp--log-block-info () |
| 2342 | "Log basic blocks info for the current function." | 2354 | "Log basic blocks info for the current function." |
| 2343 | (maphash (lambda (name bb) | 2355 | (maphash (lambda (name bb) |
| 2344 | (let ((dom (comp-block-idom bb)) | 2356 | (let ((dom (comp-block-idom bb)) |
| @@ -2351,7 +2363,7 @@ blocks." | |||
| 2351 | 3))) | 2363 | 3))) |
| 2352 | (comp-func-blocks comp-func))) | 2364 | (comp-func-blocks comp-func))) |
| 2353 | 2365 | ||
| 2354 | (defun comp-place-phis () | 2366 | (defun comp--place-phis () |
| 2355 | "Place phi insns into the current function." | 2367 | "Place phi insns into the current function." |
| 2356 | ;; Originally based on: Static Single Assignment Book | 2368 | ;; Originally based on: Static Single Assignment Book |
| 2357 | ;; Algorithm 3.1: Standard algorithm for inserting phi-functions | 2369 | ;; Algorithm 3.1: Standard algorithm for inserting phi-functions |
| @@ -2392,7 +2404,7 @@ blocks." | |||
| 2392 | (unless (cl-find y defs-v) | 2404 | (unless (cl-find y defs-v) |
| 2393 | (push y w)))))))) | 2405 | (push y w)))))))) |
| 2394 | 2406 | ||
| 2395 | (defun comp-dom-tree-walker (bb pre-lambda post-lambda) | 2407 | (defun comp--dom-tree-walker (bb pre-lambda post-lambda) |
| 2396 | "Dominator tree walker function starting from basic block BB. | 2408 | "Dominator tree walker function starting from basic block BB. |
| 2397 | PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." | 2409 | PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." |
| 2398 | (when pre-lambda | 2410 | (when pre-lambda |
| @@ -2402,18 +2414,18 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." | |||
| 2402 | for child = (comp-edge-dst ed) | 2414 | for child = (comp-edge-dst ed) |
| 2403 | when (eq bb (comp-block-idom child)) | 2415 | when (eq bb (comp-block-idom child)) |
| 2404 | ;; Current block is the immediate dominator then recur. | 2416 | ;; Current block is the immediate dominator then recur. |
| 2405 | do (comp-dom-tree-walker child pre-lambda post-lambda))) | 2417 | do (comp--dom-tree-walker child pre-lambda post-lambda))) |
| 2406 | (when post-lambda | 2418 | (when post-lambda |
| 2407 | (funcall post-lambda bb))) | 2419 | (funcall post-lambda bb))) |
| 2408 | 2420 | ||
| 2409 | (cl-defstruct (comp-ssa (:copier nil)) | 2421 | (cl-defstruct (comp--ssa (:copier nil)) |
| 2410 | "Support structure used while SSA renaming." | 2422 | "Support structure used while SSA renaming." |
| 2411 | (frame (comp-new-frame (comp-func-frame-size comp-func) | 2423 | (frame (comp--new-frame (comp-func-frame-size comp-func) |
| 2412 | (comp-func-vframe-size comp-func) t) | 2424 | (comp-func-vframe-size comp-func) t) |
| 2413 | :type comp-vec | 2425 | :type comp-vec |
| 2414 | :documentation "`comp-vec' of m-vars.")) | 2426 | :documentation "`comp-vec' of m-vars.")) |
| 2415 | 2427 | ||
| 2416 | (defun comp-ssa-rename-insn (insn frame) | 2428 | (defun comp--ssa-rename-insn (insn frame) |
| 2417 | (cl-loop | 2429 | (cl-loop |
| 2418 | for slot-n from (- (comp-func-vframe-size comp-func)) | 2430 | for slot-n from (- (comp-func-vframe-size comp-func)) |
| 2419 | below (comp-func-frame-size comp-func) | 2431 | below (comp-func-frame-size comp-func) |
| @@ -2424,7 +2436,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." | |||
| 2424 | (eql slot-n (comp-mvar-slot x)))) | 2436 | (eql slot-n (comp-mvar-slot x)))) |
| 2425 | (new-lvalue () | 2437 | (new-lvalue () |
| 2426 | ;; If is an assignment make a new mvar and put it as l-value. | 2438 | ;; If is an assignment make a new mvar and put it as l-value. |
| 2427 | (let ((mvar (make-comp-ssa-mvar :slot slot-n))) | 2439 | (let ((mvar (make--comp--ssa-mvar :slot slot-n))) |
| 2428 | (setf (comp-vec-aref frame slot-n) mvar | 2440 | (setf (comp-vec-aref frame slot-n) mvar |
| 2429 | (cadr insn) mvar)))) | 2441 | (cadr insn) mvar)))) |
| 2430 | (pcase insn | 2442 | (pcase insn |
| @@ -2434,7 +2446,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." | |||
| 2434 | (new-lvalue)) | 2446 | (new-lvalue)) |
| 2435 | (`(fetch-handler . ,_) | 2447 | (`(fetch-handler . ,_) |
| 2436 | ;; Clobber all no matter what! | 2448 | ;; Clobber all no matter what! |
| 2437 | (setf (comp-vec-aref frame slot-n) (make-comp-ssa-mvar :slot slot-n))) | 2449 | (setf (comp-vec-aref frame slot-n) (make--comp--ssa-mvar :slot slot-n))) |
| 2438 | (`(phi ,n) | 2450 | (`(phi ,n) |
| 2439 | (when (equal n slot-n) | 2451 | (when (equal n slot-n) |
| 2440 | (new-lvalue))) | 2452 | (new-lvalue))) |
| @@ -2442,7 +2454,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." | |||
| 2442 | (let ((mvar (comp-vec-aref frame slot-n))) | 2454 | (let ((mvar (comp-vec-aref frame slot-n))) |
| 2443 | (setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn))))))))) | 2455 | (setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn))))))))) |
| 2444 | 2456 | ||
| 2445 | (defun comp-ssa-rename () | 2457 | (defun comp--ssa-rename () |
| 2446 | "Entry point to rename into SSA within the current function." | 2458 | "Entry point to rename into SSA within the current function." |
| 2447 | (comp-log "Renaming\n" 2) | 2459 | (comp-log "Renaming\n" 2) |
| 2448 | (let ((visited (make-hash-table))) | 2460 | (let ((visited (make-hash-table))) |
| @@ -2450,7 +2462,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." | |||
| 2450 | (unless (gethash bb visited) | 2462 | (unless (gethash bb visited) |
| 2451 | (puthash bb t visited) | 2463 | (puthash bb t visited) |
| 2452 | (cl-loop for insn in (comp-block-insns bb) | 2464 | (cl-loop for insn in (comp-block-insns bb) |
| 2453 | do (comp-ssa-rename-insn insn in-frame)) | 2465 | do (comp--ssa-rename-insn insn in-frame)) |
| 2454 | (setf (comp-block-final-frame bb) | 2466 | (setf (comp-block-final-frame bb) |
| 2455 | (copy-sequence in-frame)) | 2467 | (copy-sequence in-frame)) |
| 2456 | (when-let ((out-edges (comp-block-out-edges bb))) | 2468 | (when-let ((out-edges (comp-block-out-edges bb))) |
| @@ -2461,11 +2473,11 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." | |||
| 2461 | do (ssa-rename-rec child (comp-vec-copy in-frame))))))) | 2473 | do (ssa-rename-rec child (comp-vec-copy in-frame))))))) |
| 2462 | 2474 | ||
| 2463 | (ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func)) | 2475 | (ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func)) |
| 2464 | (comp-new-frame (comp-func-frame-size comp-func) | 2476 | (comp--new-frame (comp-func-frame-size comp-func) |
| 2465 | (comp-func-vframe-size comp-func) | 2477 | (comp-func-vframe-size comp-func) |
| 2466 | t))))) | 2478 | t))))) |
| 2467 | 2479 | ||
| 2468 | (defun comp-finalize-phis () | 2480 | (defun comp--finalize-phis () |
| 2469 | "Fixup r-values into phis in all basic blocks." | 2481 | "Fixup r-values into phis in all basic blocks." |
| 2470 | (cl-flet ((finalize-phi (args b) | 2482 | (cl-flet ((finalize-phi (args b) |
| 2471 | ;; Concatenate into args all incoming m-vars for this phi. | 2483 | ;; Concatenate into args all incoming m-vars for this phi. |
| @@ -2482,7 +2494,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." | |||
| 2482 | when (eq op 'phi) | 2494 | when (eq op 'phi) |
| 2483 | do (finalize-phi args b))))) | 2495 | do (finalize-phi args b))))) |
| 2484 | 2496 | ||
| 2485 | (defun comp-remove-unreachable-blocks () | 2497 | (defun comp--remove-unreachable-blocks () |
| 2486 | "Remove unreachable basic blocks. | 2498 | "Remove unreachable basic blocks. |
| 2487 | Return t when one or more block was removed, nil otherwise." | 2499 | Return t when one or more block was removed, nil otherwise." |
| 2488 | (cl-loop | 2500 | (cl-loop |
| @@ -2498,7 +2510,7 @@ Return t when one or more block was removed, nil otherwise." | |||
| 2498 | ret t) | 2510 | ret t) |
| 2499 | finally return ret)) | 2511 | finally return ret)) |
| 2500 | 2512 | ||
| 2501 | (defun comp-ssa () | 2513 | (defun comp--ssa () |
| 2502 | "Port all functions into minimal SSA form." | 2514 | "Port all functions into minimal SSA form." |
| 2503 | (maphash (lambda (_ f) | 2515 | (maphash (lambda (_ f) |
| 2504 | (let* ((comp-func f) | 2516 | (let* ((comp-func f) |
| @@ -2506,15 +2518,15 @@ Return t when one or more block was removed, nil otherwise." | |||
| 2506 | (unless (eq ssa-status t) | 2518 | (unless (eq ssa-status t) |
| 2507 | (cl-loop | 2519 | (cl-loop |
| 2508 | when (eq ssa-status 'dirty) | 2520 | when (eq ssa-status 'dirty) |
| 2509 | do (comp-clean-ssa f) | 2521 | do (comp--clean-ssa f) |
| 2510 | do (comp-compute-edges) | 2522 | do (comp--compute-edges) |
| 2511 | (comp-compute-dominator-tree) | 2523 | (comp--compute-dominator-tree) |
| 2512 | until (null (comp-remove-unreachable-blocks))) | 2524 | until (null (comp--remove-unreachable-blocks))) |
| 2513 | (comp-compute-dominator-frontiers) | 2525 | (comp--compute-dominator-frontiers) |
| 2514 | (comp-log-block-info) | 2526 | (comp--log-block-info) |
| 2515 | (comp-place-phis) | 2527 | (comp--place-phis) |
| 2516 | (comp-ssa-rename) | 2528 | (comp--ssa-rename) |
| 2517 | (comp-finalize-phis) | 2529 | (comp--finalize-phis) |
| 2518 | (comp--log-func comp-func 3) | 2530 | (comp--log-func comp-func 3) |
| 2519 | (setf (comp-func-ssa-status f) t)))) | 2531 | (setf (comp-func-ssa-status f) t)))) |
| 2520 | (comp-ctxt-funcs-h comp-ctxt))) | 2532 | (comp-ctxt-funcs-h comp-ctxt))) |
| @@ -2526,12 +2538,12 @@ Return t when one or more block was removed, nil otherwise." | |||
| 2526 | ;; This is also responsible for removing function calls to pure functions if | 2538 | ;; This is also responsible for removing function calls to pure functions if |
| 2527 | ;; possible. | 2539 | ;; possible. |
| 2528 | 2540 | ||
| 2529 | (defconst comp-fwprop-max-insns-scan 4500 | 2541 | (defconst comp--fwprop-max-insns-scan 4500 |
| 2530 | ;; Chosen as ~ the greatest required value for full convergence | 2542 | ;; Chosen as ~ the greatest required value for full convergence |
| 2531 | ;; native compiling all Emacs code-base. | 2543 | ;; native compiling all Emacs code-base. |
| 2532 | "Max number of scanned insn before giving-up.") | 2544 | "Max number of scanned insn before giving-up.") |
| 2533 | 2545 | ||
| 2534 | (defun comp-copy-insn (insn) | 2546 | (defun comp--copy-insn (insn) |
| 2535 | "Deep copy INSN." | 2547 | "Deep copy INSN." |
| 2536 | ;; Adapted from `copy-tree'. | 2548 | ;; Adapted from `copy-tree'. |
| 2537 | (if (consp insn) | 2549 | (if (consp insn) |
| @@ -2539,16 +2551,16 @@ Return t when one or more block was removed, nil otherwise." | |||
| 2539 | (while (consp insn) | 2551 | (while (consp insn) |
| 2540 | (let ((newcar (car insn))) | 2552 | (let ((newcar (car insn))) |
| 2541 | (if (or (consp (car insn)) (comp-mvar-p (car insn))) | 2553 | (if (or (consp (car insn)) (comp-mvar-p (car insn))) |
| 2542 | (setf newcar (comp-copy-insn (car insn)))) | 2554 | (setf newcar (comp--copy-insn (car insn)))) |
| 2543 | (push newcar result)) | 2555 | (push newcar result)) |
| 2544 | (setf insn (cdr insn))) | 2556 | (setf insn (cdr insn))) |
| 2545 | (nconc (nreverse result) | 2557 | (nconc (nreverse result) |
| 2546 | (if (comp-mvar-p insn) (comp-copy-insn insn) insn))) | 2558 | (if (comp-mvar-p insn) (comp--copy-insn insn) insn))) |
| 2547 | (if (comp-mvar-p insn) | 2559 | (if (comp-mvar-p insn) |
| 2548 | (copy-comp-mvar insn) | 2560 | (copy-comp-mvar insn) |
| 2549 | insn))) | 2561 | insn))) |
| 2550 | 2562 | ||
| 2551 | (defmacro comp-apply-in-env (func &rest args) | 2563 | (defmacro comp--apply-in-env (func &rest args) |
| 2552 | "Apply FUNC to ARGS in the current compilation environment." | 2564 | "Apply FUNC to ARGS in the current compilation environment." |
| 2553 | `(let ((env (cl-loop | 2565 | `(let ((env (cl-loop |
| 2554 | for f being the hash-value in (comp-ctxt-funcs-h comp-ctxt) | 2566 | for f being the hash-value in (comp-ctxt-funcs-h comp-ctxt) |
| @@ -2564,7 +2576,7 @@ Return t when one or more block was removed, nil otherwise." | |||
| 2564 | for (func-name . def) in env | 2576 | for (func-name . def) in env |
| 2565 | do (setf (symbol-function func-name) def))))) | 2577 | do (setf (symbol-function func-name) def))))) |
| 2566 | 2578 | ||
| 2567 | (defun comp-fwprop-prologue () | 2579 | (defun comp--fwprop-prologue () |
| 2568 | "Prologue for the propagate pass. | 2580 | "Prologue for the propagate pass. |
| 2569 | Here goes everything that can be done not iteratively (read once). | 2581 | Here goes everything that can be done not iteratively (read once). |
| 2570 | Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or invoked? | 2582 | Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or invoked? |
| @@ -2576,16 +2588,16 @@ Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or | |||
| 2576 | (`(setimm ,lval ,v) | 2588 | (`(setimm ,lval ,v) |
| 2577 | (setf (comp-cstr-imm lval) v)))))) | 2589 | (setf (comp-cstr-imm lval) v)))))) |
| 2578 | 2590 | ||
| 2579 | (defun comp-function-foldable-p (f args) | 2591 | (defun comp--function-foldable-p (f args) |
| 2580 | "Given function F called with ARGS, return non-nil when optimizable." | 2592 | "Given function F called with ARGS, return non-nil when optimizable." |
| 2581 | (and (comp--function-pure-p f) | 2593 | (and (comp--function-pure-p f) |
| 2582 | (cl-every #'comp-cstr-imm-vld-p args))) | 2594 | (cl-every #'comp-cstr-imm-vld-p args))) |
| 2583 | 2595 | ||
| 2584 | (defun comp-function-call-maybe-fold (insn f args) | 2596 | (defun comp--function-call-maybe-fold (insn f args) |
| 2585 | "Given INSN, when F is pure if all ARGS are known, remove the function call. | 2597 | "Given INSN, when F is pure if all ARGS are known, remove the function call. |
| 2586 | Return non-nil if the function is folded successfully." | 2598 | Return non-nil if the function is folded successfully." |
| 2587 | (cl-flet ((rewrite-insn-as-setimm (insn value) | 2599 | (cl-flet ((rewrite-insn-as-setimm (insn value) |
| 2588 | ;; See `comp-emit-setimm'. | 2600 | ;; See `comp--emit-setimm'. |
| 2589 | (comp--add-const-to-relocs value) | 2601 | (comp--add-const-to-relocs value) |
| 2590 | (setf (car insn) 'setimm | 2602 | (setf (car insn) 'setimm |
| 2591 | (cddr insn) `(,value)))) | 2603 | (cddr insn) `(,value)))) |
| @@ -2597,7 +2609,7 @@ Return non-nil if the function is folded successfully." | |||
| 2597 | comp-symbol-values-optimizable))) | 2609 | comp-symbol-values-optimizable))) |
| 2598 | (rewrite-insn-as-setimm insn (symbol-value (comp-cstr-imm | 2610 | (rewrite-insn-as-setimm insn (symbol-value (comp-cstr-imm |
| 2599 | (car args)))))) | 2611 | (car args)))))) |
| 2600 | ((comp-function-foldable-p f args) | 2612 | ((comp--function-foldable-p f args) |
| 2601 | (ignore-errors | 2613 | (ignore-errors |
| 2602 | ;; No point to complain here in case of error because we | 2614 | ;; No point to complain here in case of error because we |
| 2603 | ;; should do basic block pruning in order to be sure that this | 2615 | ;; should do basic block pruning in order to be sure that this |
| @@ -2608,14 +2620,14 @@ Return non-nil if the function is folded successfully." | |||
| 2608 | ;; and know to be pure. | 2620 | ;; and know to be pure. |
| 2609 | (comp-func-byte-func f-in-ctxt) | 2621 | (comp-func-byte-func f-in-ctxt) |
| 2610 | f)) | 2622 | f)) |
| 2611 | (value (comp-apply-in-env f (mapcar #'comp-cstr-imm args)))) | 2623 | (value (comp--apply-in-env f (mapcar #'comp-cstr-imm args)))) |
| 2612 | (rewrite-insn-as-setimm insn value))))))) | 2624 | (rewrite-insn-as-setimm insn value))))))) |
| 2613 | 2625 | ||
| 2614 | (defun comp-fwprop-call (insn lval f args) | 2626 | (defun comp--fwprop-call (insn lval f args) |
| 2615 | "Propagate on a call INSN into LVAL. | 2627 | "Propagate on a call INSN into LVAL. |
| 2616 | F is the function being called with arguments ARGS. | 2628 | F is the function being called with arguments ARGS. |
| 2617 | Fold the call in case." | 2629 | Fold the call in case." |
| 2618 | (unless (comp-function-call-maybe-fold insn f args) | 2630 | (unless (comp--function-call-maybe-fold insn f args) |
| 2619 | (when (and (eq 'funcall f) | 2631 | (when (and (eq 'funcall f) |
| 2620 | (comp-cstr-imm-vld-p (car args))) | 2632 | (comp-cstr-imm-vld-p (car args))) |
| 2621 | (setf f (comp-cstr-imm (car args)) | 2633 | (setf f (comp-cstr-imm (car args)) |
| @@ -2636,16 +2648,16 @@ Fold the call in case." | |||
| 2636 | (comp-type-spec-to-cstr | 2648 | (comp-type-spec-to-cstr |
| 2637 | (comp-cstr-imm (car args))))))))) | 2649 | (comp-cstr-imm (car args))))))))) |
| 2638 | 2650 | ||
| 2639 | (defun comp-fwprop-insn (insn) | 2651 | (defun comp--fwprop-insn (insn) |
| 2640 | "Propagate within INSN." | 2652 | "Propagate within INSN." |
| 2641 | (pcase insn | 2653 | (pcase insn |
| 2642 | (`(set ,lval ,rval) | 2654 | (`(set ,lval ,rval) |
| 2643 | (pcase rval | 2655 | (pcase rval |
| 2644 | (`(,(or 'call 'callref) ,f . ,args) | 2656 | (`(,(or 'call 'callref) ,f . ,args) |
| 2645 | (comp-fwprop-call insn lval f args)) | 2657 | (comp--fwprop-call insn lval f args)) |
| 2646 | (`(,(or 'direct-call 'direct-callref) ,f . ,args) | 2658 | (`(,(or 'direct-call 'direct-callref) ,f . ,args) |
| 2647 | (let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt))))) | 2659 | (let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt))))) |
| 2648 | (comp-fwprop-call insn lval f args))) | 2660 | (comp--fwprop-call insn lval f args))) |
| 2649 | (_ | 2661 | (_ |
| 2650 | (comp-cstr-shallow-copy lval rval)))) | 2662 | (comp-cstr-shallow-copy lval rval)))) |
| 2651 | (`(assume ,lval ,(and (pred comp-mvar-p) rval)) | 2663 | (`(assume ,lval ,(and (pred comp-mvar-p) rval)) |
| @@ -2690,7 +2702,7 @@ Fold the call in case." | |||
| 2690 | (rvals (mapcar #'car rest))) | 2702 | (rvals (mapcar #'car rest))) |
| 2691 | (apply prop-fn lval rvals))))) | 2703 | (apply prop-fn lval rvals))))) |
| 2692 | 2704 | ||
| 2693 | (defun comp-fwprop* () | 2705 | (defun comp--fwprop* () |
| 2694 | "Propagate for set* and phi operands. | 2706 | "Propagate for set* and phi operands. |
| 2695 | Return t if something was changed." | 2707 | Return t if something was changed." |
| 2696 | (cl-loop named outer | 2708 | (cl-loop named outer |
| @@ -2702,17 +2714,17 @@ Return t if something was changed." | |||
| 2702 | for insn in (comp-block-insns b) | 2714 | for insn in (comp-block-insns b) |
| 2703 | for orig-insn = (unless modified | 2715 | for orig-insn = (unless modified |
| 2704 | ;; Save consing after 1st change. | 2716 | ;; Save consing after 1st change. |
| 2705 | (comp-copy-insn insn)) | 2717 | (comp--copy-insn insn)) |
| 2706 | do | 2718 | do |
| 2707 | (comp-fwprop-insn insn) | 2719 | (comp--fwprop-insn insn) |
| 2708 | (cl-incf i) | 2720 | (cl-incf i) |
| 2709 | when (and (null modified) (not (equal insn orig-insn))) | 2721 | when (and (null modified) (not (equal insn orig-insn))) |
| 2710 | do (setf modified t)) | 2722 | do (setf modified t)) |
| 2711 | when (> i comp-fwprop-max-insns-scan) | 2723 | when (> i comp--fwprop-max-insns-scan) |
| 2712 | do (cl-return-from outer nil) | 2724 | do (cl-return-from outer nil) |
| 2713 | finally return modified)) | 2725 | finally return modified)) |
| 2714 | 2726 | ||
| 2715 | (defun comp-rewrite-non-locals () | 2727 | (defun comp--rewrite-non-locals () |
| 2716 | "Make explicit in LIMPLE non-local exits if identified." | 2728 | "Make explicit in LIMPLE non-local exits if identified." |
| 2717 | (cl-loop | 2729 | (cl-loop |
| 2718 | for bb being each hash-value of (comp-func-blocks comp-func) | 2730 | for bb being each hash-value of (comp-func-blocks comp-func) |
| @@ -2729,26 +2741,26 @@ Return t if something was changed." | |||
| 2729 | (cdr insn-seq) '((unreachable)) | 2741 | (cdr insn-seq) '((unreachable)) |
| 2730 | (comp-func-ssa-status comp-func) 'dirty)))) | 2742 | (comp-func-ssa-status comp-func) 'dirty)))) |
| 2731 | 2743 | ||
| 2732 | (defun comp-fwprop (_) | 2744 | (defun comp--fwprop (_) |
| 2733 | "Forward propagate types and consts within the lattice." | 2745 | "Forward propagate types and consts within the lattice." |
| 2734 | (comp-ssa) | 2746 | (comp--ssa) |
| 2735 | (comp-dead-code) | 2747 | (comp--dead-code) |
| 2736 | (maphash (lambda (_ f) | 2748 | (maphash (lambda (_ f) |
| 2737 | (when (and (>= (comp-func-speed f) 2) | 2749 | (when (and (>= (comp-func-speed f) 2) |
| 2738 | ;; FIXME remove the following condition when tested. | 2750 | ;; FIXME remove the following condition when tested. |
| 2739 | (not (comp-func-has-non-local f))) | 2751 | (not (comp-func-has-non-local f))) |
| 2740 | (let ((comp-func f)) | 2752 | (let ((comp-func f)) |
| 2741 | (comp-fwprop-prologue) | 2753 | (comp--fwprop-prologue) |
| 2742 | (cl-loop | 2754 | (cl-loop |
| 2743 | for i from 1 to 100 | 2755 | for i from 1 to 100 |
| 2744 | while (comp-fwprop*) | 2756 | while (comp--fwprop*) |
| 2745 | finally | 2757 | finally |
| 2746 | (when (= i 100) | 2758 | (when (= i 100) |
| 2747 | (display-warning | 2759 | (display-warning |
| 2748 | 'comp | 2760 | 'comp |
| 2749 | (format "fwprop pass jammed into %s?" (comp-func-name f)))) | 2761 | (format "fwprop pass jammed into %s?" (comp-func-name f)))) |
| 2750 | (comp-log (format "Propagation run %d times\n" i) 2)) | 2762 | (comp-log (format "Propagation run %d times\n" i) 2)) |
| 2751 | (comp-rewrite-non-locals) | 2763 | (comp--rewrite-non-locals) |
| 2752 | (comp--log-func comp-func 3)))) | 2764 | (comp--log-func comp-func 3)))) |
| 2753 | (comp-ctxt-funcs-h comp-ctxt))) | 2765 | (comp-ctxt-funcs-h comp-ctxt))) |
| 2754 | 2766 | ||
| @@ -2768,7 +2780,7 @@ Return t if something was changed." | |||
| 2768 | ;; the full compilation unit. | 2780 | ;; the full compilation unit. |
| 2769 | ;; For this reason this is triggered only at native-comp-speed == 3. | 2781 | ;; For this reason this is triggered only at native-comp-speed == 3. |
| 2770 | 2782 | ||
| 2771 | (defun comp-func-in-unit (func) | 2783 | (defun comp--func-in-unit (func) |
| 2772 | "Given FUNC return the `comp-fun' definition in the current context. | 2784 | "Given FUNC return the `comp-fun' definition in the current context. |
| 2773 | FUNCTION can be a function-name or byte compiled function." | 2785 | FUNCTION can be a function-name or byte compiled function." |
| 2774 | (if (symbolp func) | 2786 | (if (symbolp func) |
| @@ -2776,11 +2788,11 @@ FUNCTION can be a function-name or byte compiled function." | |||
| 2776 | (cl-assert (byte-code-function-p func)) | 2788 | (cl-assert (byte-code-function-p func)) |
| 2777 | (gethash func (comp-ctxt-byte-func-to-func-h comp-ctxt)))) | 2789 | (gethash func (comp-ctxt-byte-func-to-func-h comp-ctxt)))) |
| 2778 | 2790 | ||
| 2779 | (defun comp-call-optim-form-call (callee args) | 2791 | (defun comp--call-optim-form-call (callee args) |
| 2780 | (cl-flet ((fill-args (args total) | 2792 | (cl-flet ((fill-args (args total) |
| 2781 | ;; Fill missing args to reach TOTAL | 2793 | ;; Fill missing args to reach TOTAL |
| 2782 | (append args (cl-loop repeat (- total (length args)) | 2794 | (append args (cl-loop repeat (- total (length args)) |
| 2783 | collect (make-comp-mvar :constant nil))))) | 2795 | collect (make--comp-mvar :constant nil))))) |
| 2784 | (when (and callee | 2796 | (when (and callee |
| 2785 | (or (symbolp callee) | 2797 | (or (symbolp callee) |
| 2786 | (gethash callee (comp-ctxt-byte-func-to-func-h comp-ctxt))) | 2798 | (gethash callee (comp-ctxt-byte-func-to-func-h comp-ctxt))) |
| @@ -2798,7 +2810,7 @@ FUNCTION can be a function-name or byte compiled function." | |||
| 2798 | ;; actually cheaper since it avoids the call to the | 2810 | ;; actually cheaper since it avoids the call to the |
| 2799 | ;; intermediate native trampoline (bug#67005). | 2811 | ;; intermediate native trampoline (bug#67005). |
| 2800 | (subrp (subrp f)) | 2812 | (subrp (subrp f)) |
| 2801 | (comp-func-callee (comp-func-in-unit callee))) | 2813 | (comp-func-callee (comp--func-in-unit callee))) |
| 2802 | (cond | 2814 | (cond |
| 2803 | ((and subrp (not (subr-native-elisp-p f))) | 2815 | ((and subrp (not (subr-native-elisp-p f))) |
| 2804 | ;; Trampoline removal. | 2816 | ;; Trampoline removal. |
| @@ -2833,30 +2845,30 @@ FUNCTION can be a function-name or byte compiled function." | |||
| 2833 | ((comp--type-hint-p callee) | 2845 | ((comp--type-hint-p callee) |
| 2834 | `(call ,callee ,@args))))))) | 2846 | `(call ,callee ,@args))))))) |
| 2835 | 2847 | ||
| 2836 | (defun comp-call-optim-func () | 2848 | (defun comp--call-optim-func () |
| 2837 | "Perform the trampoline call optimization for the current function." | 2849 | "Perform the trampoline call optimization for the current function." |
| 2838 | (cl-loop | 2850 | (cl-loop |
| 2839 | for b being each hash-value of (comp-func-blocks comp-func) | 2851 | for b being each hash-value of (comp-func-blocks comp-func) |
| 2840 | do (comp-loop-insn-in-block b | 2852 | do (comp--loop-insn-in-block b |
| 2841 | (pcase insn | 2853 | (pcase insn |
| 2842 | (`(set ,lval (callref funcall ,f . ,rest)) | 2854 | (`(set ,lval (callref funcall ,f . ,rest)) |
| 2843 | (when-let ((ok (comp-cstr-imm-vld-p f)) | 2855 | (when-let ((ok (comp-cstr-imm-vld-p f)) |
| 2844 | (new-form (comp-call-optim-form-call | 2856 | (new-form (comp--call-optim-form-call |
| 2845 | (comp-cstr-imm f) rest))) | 2857 | (comp-cstr-imm f) rest))) |
| 2846 | (setf insn `(set ,lval ,new-form)))) | 2858 | (setf insn `(set ,lval ,new-form)))) |
| 2847 | (`(callref funcall ,f . ,rest) | 2859 | (`(callref funcall ,f . ,rest) |
| 2848 | (when-let ((ok (comp-cstr-imm-vld-p f)) | 2860 | (when-let ((ok (comp-cstr-imm-vld-p f)) |
| 2849 | (new-form (comp-call-optim-form-call | 2861 | (new-form (comp--call-optim-form-call |
| 2850 | (comp-cstr-imm f) rest))) | 2862 | (comp-cstr-imm f) rest))) |
| 2851 | (setf insn new-form))))))) | 2863 | (setf insn new-form))))))) |
| 2852 | 2864 | ||
| 2853 | (defun comp-call-optim (_) | 2865 | (defun comp--call-optim (_) |
| 2854 | "Try to optimize out funcall trampoline usage when possible." | 2866 | "Try to optimize out funcall trampoline usage when possible." |
| 2855 | (maphash (lambda (_ f) | 2867 | (maphash (lambda (_ f) |
| 2856 | (when (and (>= (comp-func-speed f) 2) | 2868 | (when (and (>= (comp-func-speed f) 2) |
| 2857 | (comp-func-l-p f)) | 2869 | (comp-func-l-p f)) |
| 2858 | (let ((comp-func f)) | 2870 | (let ((comp-func f)) |
| 2859 | (comp-call-optim-func)))) | 2871 | (comp--call-optim-func)))) |
| 2860 | (comp-ctxt-funcs-h comp-ctxt))) | 2872 | (comp-ctxt-funcs-h comp-ctxt))) |
| 2861 | 2873 | ||
| 2862 | 2874 | ||
| @@ -2867,16 +2879,16 @@ FUNCTION can be a function-name or byte compiled function." | |||
| 2867 | ;; | 2879 | ;; |
| 2868 | ;; This pass can be run as last optim. | 2880 | ;; This pass can be run as last optim. |
| 2869 | 2881 | ||
| 2870 | (defun comp-collect-mvar-ids (insn) | 2882 | (defun comp--collect-mvar-ids (insn) |
| 2871 | "Collect the m-var unique identifiers into INSN." | 2883 | "Collect the m-var unique identifiers into INSN." |
| 2872 | (cl-loop for x in insn | 2884 | (cl-loop for x in insn |
| 2873 | if (consp x) | 2885 | if (consp x) |
| 2874 | append (comp-collect-mvar-ids x) | 2886 | append (comp--collect-mvar-ids x) |
| 2875 | else | 2887 | else |
| 2876 | when (comp-mvar-p x) | 2888 | when (comp-mvar-p x) |
| 2877 | collect (comp-mvar-id x))) | 2889 | collect (comp-mvar-id x))) |
| 2878 | 2890 | ||
| 2879 | (defun comp-dead-assignments-func () | 2891 | (defun comp--dead-assignments-func () |
| 2880 | "Clean-up dead assignments into current function. | 2892 | "Clean-up dead assignments into current function. |
| 2881 | Return the list of m-var ids nuked." | 2893 | Return the list of m-var ids nuked." |
| 2882 | (let ((l-vals ()) | 2894 | (let ((l-vals ()) |
| @@ -2889,9 +2901,9 @@ Return the list of m-var ids nuked." | |||
| 2889 | for (op arg0 . rest) = insn | 2901 | for (op arg0 . rest) = insn |
| 2890 | if (comp--assign-op-p op) | 2902 | if (comp--assign-op-p op) |
| 2891 | do (push (comp-mvar-id arg0) l-vals) | 2903 | do (push (comp-mvar-id arg0) l-vals) |
| 2892 | (setf r-vals (nconc (comp-collect-mvar-ids rest) r-vals)) | 2904 | (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals)) |
| 2893 | else | 2905 | else |
| 2894 | do (setf r-vals (nconc (comp-collect-mvar-ids insn) r-vals)))) | 2906 | do (setf r-vals (nconc (comp--collect-mvar-ids insn) r-vals)))) |
| 2895 | ;; Every l-value appearing that does not appear as r-value has no right to | 2907 | ;; Every l-value appearing that does not appear as r-value has no right to |
| 2896 | ;; exist and gets nuked. | 2908 | ;; exist and gets nuked. |
| 2897 | (let ((nuke-list (cl-set-difference l-vals r-vals))) | 2909 | (let ((nuke-list (cl-set-difference l-vals r-vals))) |
| @@ -2903,7 +2915,7 @@ Return the list of m-var ids nuked." | |||
| 2903 | 3) | 2915 | 3) |
| 2904 | (cl-loop | 2916 | (cl-loop |
| 2905 | for b being each hash-value of (comp-func-blocks comp-func) | 2917 | for b being each hash-value of (comp-func-blocks comp-func) |
| 2906 | do (comp-loop-insn-in-block b | 2918 | do (comp--loop-insn-in-block b |
| 2907 | (cl-destructuring-bind (op &optional arg0 arg1 &rest rest) insn | 2919 | (cl-destructuring-bind (op &optional arg0 arg1 &rest rest) insn |
| 2908 | (when (and (comp--assign-op-p op) | 2920 | (when (and (comp--assign-op-p op) |
| 2909 | (memq (comp-mvar-id arg0) nuke-list)) | 2921 | (memq (comp-mvar-id arg0) nuke-list)) |
| @@ -2914,7 +2926,7 @@ Return the list of m-var ids nuked." | |||
| 2914 | insn)))))))) | 2926 | insn)))))))) |
| 2915 | nuke-list))) | 2927 | nuke-list))) |
| 2916 | 2928 | ||
| 2917 | (defun comp-dead-code () | 2929 | (defun comp--dead-code () |
| 2918 | "Dead code elimination." | 2930 | "Dead code elimination." |
| 2919 | (maphash (lambda (_ f) | 2931 | (maphash (lambda (_ f) |
| 2920 | (when (and (>= (comp-func-speed f) 2) | 2932 | (when (and (>= (comp-func-speed f) 2) |
| @@ -2923,7 +2935,7 @@ Return the list of m-var ids nuked." | |||
| 2923 | (cl-loop | 2935 | (cl-loop |
| 2924 | for comp-func = f | 2936 | for comp-func = f |
| 2925 | for i from 1 | 2937 | for i from 1 |
| 2926 | while (comp-dead-assignments-func) | 2938 | while (comp--dead-assignments-func) |
| 2927 | finally (comp-log (format "dead code rm run %d times\n" i) 2) | 2939 | finally (comp-log (format "dead code rm run %d times\n" i) 2) |
| 2928 | (comp--log-func comp-func 3)))) | 2940 | (comp--log-func comp-func 3)))) |
| 2929 | (comp-ctxt-funcs-h comp-ctxt))) | 2941 | (comp-ctxt-funcs-h comp-ctxt))) |
| @@ -2931,14 +2943,14 @@ Return the list of m-var ids nuked." | |||
| 2931 | 2943 | ||
| 2932 | ;;; Tail Call Optimization pass specific code. | 2944 | ;;; Tail Call Optimization pass specific code. |
| 2933 | 2945 | ||
| 2934 | (defun comp-form-tco-call-seq (args) | 2946 | (defun comp--form-tco-call-seq (args) |
| 2935 | "Generate a TCO sequence for ARGS." | 2947 | "Generate a TCO sequence for ARGS." |
| 2936 | `(,@(cl-loop for arg in args | 2948 | `(,@(cl-loop for arg in args |
| 2937 | for i from 0 | 2949 | for i from 0 |
| 2938 | collect `(set ,(make-comp-mvar :slot i) ,arg)) | 2950 | collect `(set ,(make--comp-mvar :slot i) ,arg)) |
| 2939 | (jump bb_0))) | 2951 | (jump bb_0))) |
| 2940 | 2952 | ||
| 2941 | (defun comp-tco-func () | 2953 | (defun comp--tco-func () |
| 2942 | "Try to pattern match and perform TCO within the current function." | 2954 | "Try to pattern match and perform TCO within the current function." |
| 2943 | (cl-loop | 2955 | (cl-loop |
| 2944 | for b being each hash-value of (comp-func-blocks comp-func) | 2956 | for b being each hash-value of (comp-func-blocks comp-func) |
| @@ -2951,20 +2963,20 @@ Return the list of m-var ids nuked." | |||
| 2951 | (return ,ret-val)) | 2963 | (return ,ret-val)) |
| 2952 | (when (and (string= func (comp-func-c-name comp-func)) | 2964 | (when (and (string= func (comp-func-c-name comp-func)) |
| 2953 | (eq l-val ret-val)) | 2965 | (eq l-val ret-val)) |
| 2954 | (let ((tco-seq (comp-form-tco-call-seq args))) | 2966 | (let ((tco-seq (comp--form-tco-call-seq args))) |
| 2955 | (setf (car insns-seq) (car tco-seq) | 2967 | (setf (car insns-seq) (car tco-seq) |
| 2956 | (cdr insns-seq) (cdr tco-seq) | 2968 | (cdr insns-seq) (cdr tco-seq) |
| 2957 | (comp-func-ssa-status comp-func) 'dirty) | 2969 | (comp-func-ssa-status comp-func) 'dirty) |
| 2958 | (cl-return-from in-the-basic-block)))))))) | 2970 | (cl-return-from in-the-basic-block)))))))) |
| 2959 | 2971 | ||
| 2960 | (defun comp-tco (_) | 2972 | (defun comp--tco (_) |
| 2961 | "Simple peephole pass performing self TCO." | 2973 | "Simple peephole pass performing self TCO." |
| 2962 | (maphash (lambda (_ f) | 2974 | (maphash (lambda (_ f) |
| 2963 | (when (and (>= (comp-func-speed f) 3) | 2975 | (when (and (>= (comp-func-speed f) 3) |
| 2964 | (comp-func-l-p f) | 2976 | (comp-func-l-p f) |
| 2965 | (not (comp-func-has-non-local f))) | 2977 | (not (comp-func-has-non-local f))) |
| 2966 | (let ((comp-func f)) | 2978 | (let ((comp-func f)) |
| 2967 | (comp-tco-func) | 2979 | (comp--tco-func) |
| 2968 | (comp--log-func comp-func 3)))) | 2980 | (comp--log-func comp-func 3)))) |
| 2969 | (comp-ctxt-funcs-h comp-ctxt))) | 2981 | (comp-ctxt-funcs-h comp-ctxt))) |
| 2970 | 2982 | ||
| @@ -2974,29 +2986,62 @@ Return the list of m-var ids nuked." | |||
| 2974 | ;; This must run after all SSA prop not to have the type hint | 2986 | ;; This must run after all SSA prop not to have the type hint |
| 2975 | ;; information overwritten. | 2987 | ;; information overwritten. |
| 2976 | 2988 | ||
| 2977 | (defun comp-remove-type-hints-func () | 2989 | (defun comp--remove-type-hints-func () |
| 2978 | "Remove type hints from the current function. | 2990 | "Remove type hints from the current function. |
| 2979 | These are substituted with a normal `set' op." | 2991 | These are substituted with a normal `set' op." |
| 2980 | (cl-loop | 2992 | (cl-loop |
| 2981 | for b being each hash-value of (comp-func-blocks comp-func) | 2993 | for b being each hash-value of (comp-func-blocks comp-func) |
| 2982 | do (comp-loop-insn-in-block b | 2994 | do (comp--loop-insn-in-block b |
| 2983 | (pcase insn | 2995 | (pcase insn |
| 2984 | (`(set ,l-val (call ,(pred comp--type-hint-p) ,r-val)) | 2996 | (`(set ,l-val (call ,(pred comp--type-hint-p) ,r-val)) |
| 2985 | (setf insn `(set ,l-val ,r-val))))))) | 2997 | (setf insn `(set ,l-val ,r-val))))))) |
| 2986 | 2998 | ||
| 2987 | (defun comp-remove-type-hints (_) | 2999 | (defun comp--remove-type-hints (_) |
| 2988 | "Dead code elimination." | 3000 | "Dead code elimination." |
| 2989 | (maphash (lambda (_ f) | 3001 | (maphash (lambda (_ f) |
| 2990 | (when (>= (comp-func-speed f) 2) | 3002 | (when (>= (comp-func-speed f) 2) |
| 2991 | (let ((comp-func f)) | 3003 | (let ((comp-func f)) |
| 2992 | (comp-remove-type-hints-func) | 3004 | (comp--remove-type-hints-func) |
| 2993 | (comp--log-func comp-func 3)))) | 3005 | (comp--log-func comp-func 3)))) |
| 2994 | (comp-ctxt-funcs-h comp-ctxt))) | 3006 | (comp-ctxt-funcs-h comp-ctxt))) |
| 2995 | 3007 | ||
| 2996 | 3008 | ||
| 3009 | ;;; Function types pass specific code. | ||
| 3010 | |||
| 3011 | (defun comp--compute-function-type (_ func) | ||
| 3012 | "Compute type specifier for `comp-func' FUNC. | ||
| 3013 | Set it into the `type' slot." | ||
| 3014 | (when (and (comp-func-l-p func) | ||
| 3015 | (comp-mvar-p (comp-func-type func))) | ||
| 3016 | (let* ((comp-func (make-comp-func)) | ||
| 3017 | (res-mvar (apply #'comp-cstr-union | ||
| 3018 | (make-comp-cstr) | ||
| 3019 | (cl-loop | ||
| 3020 | with res = nil | ||
| 3021 | for bb being the hash-value in (comp-func-blocks | ||
| 3022 | func) | ||
| 3023 | do (cl-loop | ||
| 3024 | for insn in (comp-block-insns bb) | ||
| 3025 | ;; Collect over every exit point the returned | ||
| 3026 | ;; mvars and union results. | ||
| 3027 | do (pcase insn | ||
| 3028 | (`(return ,mvar) | ||
| 3029 | (push mvar res)))) | ||
| 3030 | finally return res))) | ||
| 3031 | (type `(function ,(comp--args-to-lambda-list (comp-func-l-args func)) | ||
| 3032 | ,(comp-cstr-to-type-spec res-mvar)))) | ||
| 3033 | (comp--add-const-to-relocs type) | ||
| 3034 | ;; Fix it up. | ||
| 3035 | (setf (comp-cstr-imm (comp-func-type func)) type)))) | ||
| 3036 | |||
| 3037 | (defun comp--compute-function-types (_) | ||
| 3038 | "Compute and store the type specifier for all functions." | ||
| 3039 | (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt))) | ||
| 3040 | |||
| 3041 | |||
| 2997 | ;;; Final pass specific code. | 3042 | ;;; Final pass specific code. |
| 2998 | 3043 | ||
| 2999 | (defun comp-args-to-lambda-list (args) | 3044 | (defun comp--args-to-lambda-list (args) |
| 3000 | "Return a lambda list for ARGS." | 3045 | "Return a lambda list for ARGS." |
| 3001 | (cl-loop | 3046 | (cl-loop |
| 3002 | with res | 3047 | with res |
| @@ -3021,33 +3066,7 @@ These are substituted with a normal `set' op." | |||
| 3021 | (push 't res)))) | 3066 | (push 't res)))) |
| 3022 | (cl-return (reverse res)))) | 3067 | (cl-return (reverse res)))) |
| 3023 | 3068 | ||
| 3024 | (defun comp-compute-function-type (_ func) | 3069 | (defun comp--finalize-container (cont) |
| 3025 | "Compute type specifier for `comp-func' FUNC. | ||
| 3026 | Set it into the `type' slot." | ||
| 3027 | (when (and (comp-func-l-p func) | ||
| 3028 | (comp-mvar-p (comp-func-type func))) | ||
| 3029 | (let* ((comp-func (make-comp-func)) | ||
| 3030 | (res-mvar (apply #'comp-cstr-union | ||
| 3031 | (make-comp-cstr) | ||
| 3032 | (cl-loop | ||
| 3033 | with res = nil | ||
| 3034 | for bb being the hash-value in (comp-func-blocks | ||
| 3035 | func) | ||
| 3036 | do (cl-loop | ||
| 3037 | for insn in (comp-block-insns bb) | ||
| 3038 | ;; Collect over every exit point the returned | ||
| 3039 | ;; mvars and union results. | ||
| 3040 | do (pcase insn | ||
| 3041 | (`(return ,mvar) | ||
| 3042 | (push mvar res)))) | ||
| 3043 | finally return res))) | ||
| 3044 | (type `(function ,(comp-args-to-lambda-list (comp-func-l-args func)) | ||
| 3045 | ,(comp-cstr-to-type-spec res-mvar)))) | ||
| 3046 | (comp--add-const-to-relocs type) | ||
| 3047 | ;; Fix it up. | ||
| 3048 | (setf (comp-cstr-imm (comp-func-type func)) type)))) | ||
| 3049 | |||
| 3050 | (defun comp-finalize-container (cont) | ||
| 3051 | "Finalize data container CONT." | 3070 | "Finalize data container CONT." |
| 3052 | (setf (comp-data-container-l cont) | 3071 | (setf (comp-data-container-l cont) |
| 3053 | (cl-loop with h = (comp-data-container-idx cont) | 3072 | (cl-loop with h = (comp-data-container-idx cont) |
| @@ -3065,7 +3084,7 @@ Set it into the `type' slot." | |||
| 3065 | 'lambda-fixup | 3084 | 'lambda-fixup |
| 3066 | obj)))) | 3085 | obj)))) |
| 3067 | 3086 | ||
| 3068 | (defun comp-finalize-relocs () | 3087 | (defun comp--finalize-relocs () |
| 3069 | "Finalize data containers for each relocation class. | 3088 | "Finalize data containers for each relocation class. |
| 3070 | Remove immediate duplicates within relocation classes. | 3089 | Remove immediate duplicates within relocation classes. |
| 3071 | Update all insn accordingly." | 3090 | Update all insn accordingly." |
| @@ -3081,7 +3100,7 @@ Update all insn accordingly." | |||
| 3081 | (d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt)) | 3100 | (d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt)) |
| 3082 | (d-ephemeral-idx (comp-data-container-idx d-ephemeral))) | 3101 | (d-ephemeral-idx (comp-data-container-idx d-ephemeral))) |
| 3083 | ;; We never want compiled lambdas ending up in pure space. A copy must | 3102 | ;; We never want compiled lambdas ending up in pure space. A copy must |
| 3084 | ;; be already present in impure (see `comp-emit-lambda-for-top-level'). | 3103 | ;; be already present in impure (see `comp--emit-lambda-for-top-level'). |
| 3085 | (cl-loop for obj being each hash-keys of d-default-idx | 3104 | (cl-loop for obj being each hash-keys of d-default-idx |
| 3086 | when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt)) | 3105 | when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt)) |
| 3087 | do (cl-assert (gethash obj d-impure-idx)) | 3106 | do (cl-assert (gethash obj d-impure-idx)) |
| @@ -3097,7 +3116,7 @@ Update all insn accordingly." | |||
| 3097 | do (remhash obj d-ephemeral-idx)) | 3116 | do (remhash obj d-ephemeral-idx)) |
| 3098 | ;; Fix-up indexes in each relocation class and fill corresponding | 3117 | ;; Fix-up indexes in each relocation class and fill corresponding |
| 3099 | ;; reloc lists. | 3118 | ;; reloc lists. |
| 3100 | (mapc #'comp-finalize-container (list d-default d-impure d-ephemeral)) | 3119 | (mapc #'comp--finalize-container (list d-default d-impure d-ephemeral)) |
| 3101 | ;; Make a vector from the function documentation hash table. | 3120 | ;; Make a vector from the function documentation hash table. |
| 3102 | (cl-loop with h = (comp-ctxt-function-docs comp-ctxt) | 3121 | (cl-loop with h = (comp-ctxt-function-docs comp-ctxt) |
| 3103 | with v = (make-vector (hash-table-count h) nil) | 3122 | with v = (make-vector (hash-table-count h) nil) |
| @@ -3121,11 +3140,11 @@ Update all insn accordingly." | |||
| 3121 | (comp-mvar-range mvar) (list (cons idx idx))) | 3140 | (comp-mvar-range mvar) (list (cons idx idx))) |
| 3122 | (puthash idx t reverse-h)))) | 3141 | (puthash idx t reverse-h)))) |
| 3123 | 3142 | ||
| 3124 | (defun comp-compile-ctxt-to-file (name) | 3143 | (defun comp--compile-ctxt-to-file (name) |
| 3125 | "Compile as native code the current context naming it NAME. | 3144 | "Compile as native code the current context naming it NAME. |
| 3126 | Prepare every function for final compilation and drive the C back-end." | 3145 | Prepare every function for final compilation and drive the C back-end." |
| 3127 | (let ((dir (file-name-directory name))) | 3146 | (let ((dir (file-name-directory name))) |
| 3128 | (comp-finalize-relocs) | 3147 | (comp--finalize-relocs) |
| 3129 | (maphash (lambda (_ f) | 3148 | (maphash (lambda (_ f) |
| 3130 | (comp--log-func f 1)) | 3149 | (comp--log-func f 1)) |
| 3131 | (comp-ctxt-funcs-h comp-ctxt)) | 3150 | (comp-ctxt-funcs-h comp-ctxt)) |
| @@ -3133,12 +3152,12 @@ Prepare every function for final compilation and drive the C back-end." | |||
| 3133 | ;; In case it's created in the meanwhile. | 3152 | ;; In case it's created in the meanwhile. |
| 3134 | (ignore-error file-already-exists | 3153 | (ignore-error file-already-exists |
| 3135 | (make-directory dir t))) | 3154 | (make-directory dir t))) |
| 3136 | (comp--compile-ctxt-to-file name))) | 3155 | (comp--compile-ctxt-to-file0 name))) |
| 3137 | 3156 | ||
| 3138 | (defun comp-final1 () | 3157 | (defun comp--final1 () |
| 3139 | (comp--init-ctxt) | 3158 | (comp--init-ctxt) |
| 3140 | (unwind-protect | 3159 | (unwind-protect |
| 3141 | (comp-compile-ctxt-to-file (comp-ctxt-output comp-ctxt)) | 3160 | (comp--compile-ctxt-to-file (comp-ctxt-output comp-ctxt)) |
| 3142 | (comp--release-ctxt))) | 3161 | (comp--release-ctxt))) |
| 3143 | 3162 | ||
| 3144 | (defvar comp-async-compilation nil | 3163 | (defvar comp-async-compilation nil |
| @@ -3147,17 +3166,16 @@ Prepare every function for final compilation and drive the C back-end." | |||
| 3147 | (defvar comp-running-batch-compilation nil | 3166 | (defvar comp-running-batch-compilation nil |
| 3148 | "Non-nil when compilation is driven by any `batch-*-compile' function.") | 3167 | "Non-nil when compilation is driven by any `batch-*-compile' function.") |
| 3149 | 3168 | ||
| 3150 | (defun comp-final (_) | 3169 | (defun comp--final (_) |
| 3151 | "Final pass driving the C back-end for code emission." | 3170 | "Final pass driving the C back-end for code emission." |
| 3152 | (maphash #'comp-compute-function-type (comp-ctxt-funcs-h comp-ctxt)) | ||
| 3153 | (unless comp-dry-run | 3171 | (unless comp-dry-run |
| 3154 | ;; Always run the C side of the compilation as a sub-process | 3172 | ;; Always run the C side of the compilation as a sub-process |
| 3155 | ;; unless during bootstrap or async compilation (bug#45056). GCC | 3173 | ;; unless during bootstrap or async compilation (bug#45056). GCC |
| 3156 | ;; leaks memory but also interfere with the ability of Emacs to | 3174 | ;; leaks memory but also interfere with the ability of Emacs to |
| 3157 | ;; detect when a sub-process completes (TODO understand why). | 3175 | ;; detect when a sub-process completes (TODO understand why). |
| 3158 | (if (or comp-running-batch-compilation comp-async-compilation) | 3176 | (if (or comp-running-batch-compilation comp-async-compilation) |
| 3159 | (comp-final1) | 3177 | (comp--final1) |
| 3160 | ;; Call comp-final1 in a child process. | 3178 | ;; Call comp--final1 in a child process. |
| 3161 | (let* ((output (comp-ctxt-output comp-ctxt)) | 3179 | (let* ((output (comp-ctxt-output comp-ctxt)) |
| 3162 | (print-escape-newlines t) | 3180 | (print-escape-newlines t) |
| 3163 | (print-length nil) | 3181 | (print-length nil) |
| @@ -3179,7 +3197,7 @@ Prepare every function for final compilation and drive the C back-end." | |||
| 3179 | load-path ',load-path) | 3197 | load-path ',load-path) |
| 3180 | ,native-comp-async-env-modifier-form | 3198 | ,native-comp-async-env-modifier-form |
| 3181 | (message "Compiling %s..." ',output) | 3199 | (message "Compiling %s..." ',output) |
| 3182 | (comp-final1))) | 3200 | (comp--final1))) |
| 3183 | (temp-file (make-temp-file | 3201 | (temp-file (make-temp-file |
| 3184 | (concat "emacs-int-comp-" | 3202 | (concat "emacs-int-comp-" |
| 3185 | (file-name-base output) "-") | 3203 | (file-name-base output) "-") |
| @@ -3223,7 +3241,7 @@ Prepare every function for final compilation and drive the C back-end." | |||
| 3223 | 3241 | ||
| 3224 | ;; Primitive function advice machinery | 3242 | ;; Primitive function advice machinery |
| 3225 | 3243 | ||
| 3226 | (defun comp-make-lambda-list-from-subr (subr) | 3244 | (defun comp--make-lambda-list-from-subr (subr) |
| 3227 | "Given SUBR return the equivalent lambda-list." | 3245 | "Given SUBR return the equivalent lambda-list." |
| 3228 | (pcase-let ((`(,min . ,max) (subr-arity subr)) | 3246 | (pcase-let ((`(,min . ,max) (subr-arity subr)) |
| 3229 | (lambda-list '())) | 3247 | (lambda-list '())) |
| @@ -3267,7 +3285,7 @@ Prepare every function for final compilation and drive the C back-end." | |||
| 3267 | ;;;###autoload | 3285 | ;;;###autoload |
| 3268 | (defun comp-trampoline-compile (subr-name) | 3286 | (defun comp-trampoline-compile (subr-name) |
| 3269 | "Synthesize compile and return a trampoline for SUBR-NAME." | 3287 | "Synthesize compile and return a trampoline for SUBR-NAME." |
| 3270 | (let* ((lambda-list (comp-make-lambda-list-from-subr | 3288 | (let* ((lambda-list (comp--make-lambda-list-from-subr |
| 3271 | (symbol-function subr-name))) | 3289 | (symbol-function subr-name))) |
| 3272 | ;; The synthesized trampoline must expose the exact same ABI of | 3290 | ;; The synthesized trampoline must expose the exact same ABI of |
| 3273 | ;; the primitive we are replacing in the function reloc table. | 3291 | ;; the primitive we are replacing in the function reloc table. |
| @@ -3311,6 +3329,7 @@ filename (including FILE)." | |||
| 3311 | do (ignore-error file-error | 3329 | do (ignore-error file-error |
| 3312 | (comp-delete-or-replace-file f)))))) | 3330 | (comp-delete-or-replace-file f)))))) |
| 3313 | 3331 | ||
| 3332 | ;; In use by comp.c. | ||
| 3314 | (defun comp-delete-or-replace-file (oldfile &optional newfile) | 3333 | (defun comp-delete-or-replace-file (oldfile &optional newfile) |
| 3315 | "Replace OLDFILE with NEWFILE. | 3334 | "Replace OLDFILE with NEWFILE. |
| 3316 | When NEWFILE is nil just delete OLDFILE. | 3335 | When NEWFILE is nil just delete OLDFILE. |
| @@ -3399,16 +3418,18 @@ the deferred compilation mechanism." | |||
| 3399 | (if (and comp-async-compilation | 3418 | (if (and comp-async-compilation |
| 3400 | (not (eq (car err) 'native-compiler-error))) | 3419 | (not (eq (car err) 'native-compiler-error))) |
| 3401 | (progn | 3420 | (progn |
| 3402 | (message (if err-val | 3421 | (message "%s: Error %s" |
| 3403 | "%s: Error: %s %s" | ||
| 3404 | "%s: Error %s") | ||
| 3405 | function-or-file | 3422 | function-or-file |
| 3406 | (get (car err) 'error-message) | 3423 | (error-message-string err)) |
| 3407 | (car-safe err-val)) | ||
| 3408 | (kill-emacs -1)) | 3424 | (kill-emacs -1)) |
| 3409 | ;; Otherwise re-signal it adding the compilation input. | 3425 | ;; Otherwise re-signal it adding the compilation input. |
| 3426 | ;; FIXME: We can't just insert arbitrary info in the | ||
| 3427 | ;; error-data part of an error: the handler may expect | ||
| 3428 | ;; specific data at specific positions! | ||
| 3410 | (signal (car err) (if (consp err-val) | 3429 | (signal (car err) (if (consp err-val) |
| 3411 | (cons function-or-file err-val) | 3430 | (cons function-or-file err-val) |
| 3431 | ;; FIXME: `err-val' is supposed to be | ||
| 3432 | ;; a list, so it can only be nil here! | ||
| 3412 | (list function-or-file err-val))))))) | 3433 | (list function-or-file err-val))))))) |
| 3413 | (if (stringp function-or-file) | 3434 | (if (stringp function-or-file) |
| 3414 | data | 3435 | data |
| @@ -3492,7 +3513,8 @@ last directory in `native-comp-eln-load-path')." | |||
| 3492 | else | 3513 | else |
| 3493 | collect (byte-compile-file file)))) | 3514 | collect (byte-compile-file file)))) |
| 3494 | 3515 | ||
| 3495 | (defun comp-write-bytecode-file (eln-file) | 3516 | ;; In use by elisp-mode.el |
| 3517 | (defun comp--write-bytecode-file (eln-file) | ||
| 3496 | "After native compilation write the bytecode file for ELN-FILE. | 3518 | "After native compilation write the bytecode file for ELN-FILE. |
| 3497 | Make sure that eln file is younger than byte-compiled one and | 3519 | Make sure that eln file is younger than byte-compiled one and |
| 3498 | return the filename of this last. | 3520 | return the filename of this last. |
| @@ -3529,7 +3551,7 @@ variable \"NATIVE_DISABLED\" is set, only byte compile." | |||
| 3529 | (car (last native-comp-eln-load-path))) | 3551 | (car (last native-comp-eln-load-path))) |
| 3530 | (byte-to-native-output-buffer-file nil) | 3552 | (byte-to-native-output-buffer-file nil) |
| 3531 | (eln-file (car (batch-native-compile)))) | 3553 | (eln-file (car (batch-native-compile)))) |
| 3532 | (comp-write-bytecode-file eln-file) | 3554 | (comp--write-bytecode-file eln-file) |
| 3533 | (setq command-line-args-left (cdr command-line-args-left))))) | 3555 | (setq command-line-args-left (cdr command-line-args-left))))) |
| 3534 | 3556 | ||
| 3535 | (defun native-compile-prune-cache () | 3557 | (defun native-compile-prune-cache () |
diff --git a/lisp/emacs-lisp/compat.el b/lisp/emacs-lisp/compat.el new file mode 100644 index 00000000000..f7037dc4101 --- /dev/null +++ b/lisp/emacs-lisp/compat.el | |||
| @@ -0,0 +1,92 @@ | |||
| 1 | ;;; compat.el --- Stub of the Compatibility Library -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: \ | ||
| 6 | ;; Philip Kaludercic <philipk@posteo.net>, \ | ||
| 7 | ;; Daniel Mendler <mail@daniel-mendler.de> | ||
| 8 | ;; Maintainer: \ | ||
| 9 | ;; Daniel Mendler <mail@daniel-mendler.de>, \ | ||
| 10 | ;; Compat Development <~pkal/compat-devel@lists.sr.ht>, | ||
| 11 | ;; emacs-devel@gnu.org | ||
| 12 | ;; URL: https://github.com/emacs-compat/compat | ||
| 13 | ;; Keywords: lisp, maint | ||
| 14 | |||
| 15 | ;; This program is free software; you can redistribute it and/or modify | ||
| 16 | ;; it under the terms of the GNU General Public License as published by | ||
| 17 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 18 | ;; (at your option) any later version. | ||
| 19 | |||
| 20 | ;; This program is distributed in the hope that it will be useful, | ||
| 21 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 22 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 23 | ;; GNU General Public License for more details. | ||
| 24 | |||
| 25 | ;; You should have received a copy of the GNU General Public License | ||
| 26 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 27 | |||
| 28 | ;;; Commentary: | ||
| 29 | |||
| 30 | ;; The Compat package on ELPA provides forward-compatibility | ||
| 31 | ;; definitions for other packages. While mostly transparent, a | ||
| 32 | ;; minimal API is necessary whenever core definitions change calling | ||
| 33 | ;; conventions (e.g. `plist-get' can be invoked with a predicate from | ||
| 34 | ;; Emacs 29.1 onward). For core packages on ELPA to be able to take | ||
| 35 | ;; advantage of this functionality, the macros `compat-function' and | ||
| 36 | ;; `compat-call' have to be available in the core, usable even if | ||
| 37 | ;; users do not have the Compat package installed, which this file | ||
| 38 | ;; ensures. | ||
| 39 | |||
| 40 | ;; A basic introduction to Compat is given in the Info node `(elisp) | ||
| 41 | ;; Forwards Compatibility'. Further details on Compat are documented | ||
| 42 | ;; in the Info node `(compat) Top' (installed along with the Compat | ||
| 43 | ;; package) or read the same manual online: | ||
| 44 | ;; https://elpa.gnu.org/packages/doc/compat.html. | ||
| 45 | |||
| 46 | ;;; Code: | ||
| 47 | |||
| 48 | (defmacro compat-function (fun) | ||
| 49 | "Return compatibility function symbol for FUN. | ||
| 50 | This is a pseudo-compatibility stub for core packages on ELPA, | ||
| 51 | that depend on the Compat package, whenever the user doesn't have | ||
| 52 | the package installed on their current system." | ||
| 53 | `#',fun) | ||
| 54 | |||
| 55 | (defmacro compat-call (fun &rest args) | ||
| 56 | "Call compatibility function or macro FUN with ARGS. | ||
| 57 | This is a pseudo-compatibility stub for core packages on ELPA, | ||
| 58 | that depend on the Compat package, whenever the user doesn't have | ||
| 59 | the package installed on their current system." | ||
| 60 | (cons fun args)) | ||
| 61 | |||
| 62 | ;;;; Clever trick to avoid installing Compat if not necessary | ||
| 63 | |||
| 64 | ;; The versioning scheme of the Compat package follows that of Emacs, | ||
| 65 | ;; to indicate the version of Emacs, that functionality is being | ||
| 66 | ;; provided for. For example, the Compat version number 29.2.3.9 | ||
| 67 | ;; would attempt to provide compatibility definitions up to Emacs | ||
| 68 | ;; 29.2, while also designating that this is the third major release | ||
| 69 | ;; and ninth minor release of Compat, for the specific Emacs release. | ||
| 70 | |||
| 71 | ;; The package version of this file is specified programmatically, | ||
| 72 | ;; instead of giving a fixed version in the header of this file. This | ||
| 73 | ;; is done to ensure that the version of compat.el provided by Emacs | ||
| 74 | ;; always corresponds to the current version of Emacs. In addition to | ||
| 75 | ;; the major-minor version, a large "major release" makes sure that | ||
| 76 | ;; the built-in version of Compat is always preferred over an external | ||
| 77 | ;; installation. This means that if a package specifies a dependency | ||
| 78 | ;; on Compat which matches the current or an older version of Emacs | ||
| 79 | ;; that is being used, no additional dependencies have to be | ||
| 80 | ;; downloaded. | ||
| 81 | ;; | ||
| 82 | ;; Further details and background on this file can be found in the | ||
| 83 | ;; bug#66554 discussion. | ||
| 84 | |||
| 85 | ;;;###autoload (push (list 'compat | ||
| 86 | ;;;###autoload emacs-major-version | ||
| 87 | ;;;###autoload emacs-minor-version | ||
| 88 | ;;;###autoload 9999) | ||
| 89 | ;;;###autoload package--builtin-versions) | ||
| 90 | |||
| 91 | (provide 'compat) | ||
| 92 | ;;; compat.el ends here | ||
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 726f96a25f7..2423426dca0 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el | |||
| @@ -365,137 +365,6 @@ which more-or-less shadow%s %s's corresponding table%s." | |||
| 365 | docstring)) | 365 | docstring)) |
| 366 | 366 | ||
| 367 | 367 | ||
| 368 | ;;; OBSOLETE | ||
| 369 | ;; The functions below are only provided for backward compatibility with | ||
| 370 | ;; code byte-compiled with versions of derived.el prior to Emacs-21. | ||
| 371 | |||
| 372 | (defsubst derived-mode-setup-function-name (mode) | ||
| 373 | "Construct a setup-function name based on a MODE name." | ||
| 374 | (declare (obsolete nil "28.1")) | ||
| 375 | (intern (concat (symbol-name mode) "-setup"))) | ||
| 376 | |||
| 377 | |||
| 378 | ;; Utility functions for defining a derived mode. | ||
| 379 | |||
| 380 | ;;;###autoload | ||
| 381 | (defun derived-mode-init-mode-variables (mode) | ||
| 382 | "Initialize variables for a new MODE. | ||
| 383 | Right now, if they don't already exist, set up a blank keymap, an | ||
| 384 | empty syntax table, and an empty abbrev table -- these will be merged | ||
| 385 | the first time the mode is used." | ||
| 386 | |||
| 387 | (if (boundp (derived-mode-map-name mode)) | ||
| 388 | t | ||
| 389 | (eval `(defvar ,(derived-mode-map-name mode) | ||
| 390 | (make-sparse-keymap) | ||
| 391 | ,(format "Keymap for %s." mode))) | ||
| 392 | (put (derived-mode-map-name mode) 'derived-mode-unmerged t)) | ||
| 393 | |||
| 394 | (if (boundp (derived-mode-syntax-table-name mode)) | ||
| 395 | t | ||
| 396 | (eval `(defvar ,(derived-mode-syntax-table-name mode) | ||
| 397 | ;; Make a syntax table which doesn't specify anything | ||
| 398 | ;; for any char. Valid data will be merged in by | ||
| 399 | ;; derived-mode-merge-syntax-tables. | ||
| 400 | (make-char-table 'syntax-table nil) | ||
| 401 | ,(format "Syntax table for %s." mode))) | ||
| 402 | (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t)) | ||
| 403 | |||
| 404 | (if (boundp (derived-mode-abbrev-table-name mode)) | ||
| 405 | t | ||
| 406 | (eval `(defvar ,(derived-mode-abbrev-table-name mode) | ||
| 407 | (progn | ||
| 408 | (define-abbrev-table (derived-mode-abbrev-table-name ',mode) nil) | ||
| 409 | (make-abbrev-table)) | ||
| 410 | ,(format "Abbrev table for %s." mode))))) | ||
| 411 | |||
| 412 | ;; Utility functions for running a derived mode. | ||
| 413 | |||
| 414 | (defun derived-mode-set-keymap (mode) | ||
| 415 | "Set the keymap of the new MODE, maybe merging with the parent." | ||
| 416 | (let* ((map-name (derived-mode-map-name mode)) | ||
| 417 | (new-map (eval map-name)) | ||
| 418 | (old-map (current-local-map))) | ||
| 419 | (and old-map | ||
| 420 | (get map-name 'derived-mode-unmerged) | ||
| 421 | (derived-mode-merge-keymaps old-map new-map)) | ||
| 422 | (put map-name 'derived-mode-unmerged nil) | ||
| 423 | (use-local-map new-map))) | ||
| 424 | |||
| 425 | (defun derived-mode-set-syntax-table (mode) | ||
| 426 | "Set the syntax table of the new MODE, maybe merging with the parent." | ||
| 427 | (let* ((table-name (derived-mode-syntax-table-name mode)) | ||
| 428 | (old-table (syntax-table)) | ||
| 429 | (new-table (eval table-name))) | ||
| 430 | (if (get table-name 'derived-mode-unmerged) | ||
| 431 | (derived-mode-merge-syntax-tables old-table new-table)) | ||
| 432 | (put table-name 'derived-mode-unmerged nil) | ||
| 433 | (set-syntax-table new-table))) | ||
| 434 | |||
| 435 | (defun derived-mode-set-abbrev-table (mode) | ||
| 436 | "Set the abbrev table for MODE if it exists. | ||
| 437 | Always merge its parent into it, since the merge is non-destructive." | ||
| 438 | (let* ((table-name (derived-mode-abbrev-table-name mode)) | ||
| 439 | (old-table local-abbrev-table) | ||
| 440 | (new-table (eval table-name))) | ||
| 441 | (derived-mode-merge-abbrev-tables old-table new-table) | ||
| 442 | (setq local-abbrev-table new-table))) | ||
| 443 | |||
| 444 | (defun derived-mode-run-hooks (mode) | ||
| 445 | "Run the mode hook for MODE." | ||
| 446 | (let ((hooks-name (derived-mode-hook-name mode))) | ||
| 447 | (if (boundp hooks-name) | ||
| 448 | (run-hooks hooks-name)))) | ||
| 449 | |||
| 450 | ;; Functions to merge maps and tables. | ||
| 451 | |||
| 452 | (defun derived-mode-merge-keymaps (old new) | ||
| 453 | "Merge an OLD keymap into a NEW one. | ||
| 454 | The old keymap is set to be the last cdr of the new one, so that there will | ||
| 455 | be automatic inheritance." | ||
| 456 | ;; ?? Can this just use `set-keymap-parent'? | ||
| 457 | (let ((tail new)) | ||
| 458 | ;; Scan the NEW map for prefix keys. | ||
| 459 | (while (consp tail) | ||
| 460 | (and (consp (car tail)) | ||
| 461 | (let* ((key (vector (car (car tail)))) | ||
| 462 | (subnew (lookup-key new key)) | ||
| 463 | (subold (lookup-key old key))) | ||
| 464 | ;; If KEY is a prefix key in both OLD and NEW, merge them. | ||
| 465 | (and (keymapp subnew) (keymapp subold) | ||
| 466 | (derived-mode-merge-keymaps subold subnew)))) | ||
| 467 | (and (vectorp (car tail)) | ||
| 468 | ;; Search a vector of ASCII char bindings for prefix keys. | ||
| 469 | (let ((i (1- (length (car tail))))) | ||
| 470 | (while (>= i 0) | ||
| 471 | (let* ((key (vector i)) | ||
| 472 | (subnew (lookup-key new key)) | ||
| 473 | (subold (lookup-key old key))) | ||
| 474 | ;; If KEY is a prefix key in both OLD and NEW, merge them. | ||
| 475 | (and (keymapp subnew) (keymapp subold) | ||
| 476 | (derived-mode-merge-keymaps subold subnew))) | ||
| 477 | (setq i (1- i))))) | ||
| 478 | (setq tail (cdr tail)))) | ||
| 479 | (setcdr (nthcdr (1- (length new)) new) old)) | ||
| 480 | |||
| 481 | (defun derived-mode-merge-syntax-tables (old new) | ||
| 482 | "Merge an OLD syntax table into a NEW one. | ||
| 483 | Where the new table already has an entry, nothing is copied from the old one." | ||
| 484 | (set-char-table-parent new old)) | ||
| 485 | |||
| 486 | ;; Merge an old abbrev table into a new one. | ||
| 487 | ;; This function requires internal knowledge of how abbrev tables work, | ||
| 488 | ;; presuming that they are obarrays with the abbrev as the symbol, the expansion | ||
| 489 | ;; as the value of the symbol, and the hook as the function definition. | ||
| 490 | (defun derived-mode-merge-abbrev-tables (old new) | ||
| 491 | (if old | ||
| 492 | (mapatoms | ||
| 493 | (lambda (symbol) | ||
| 494 | (or (intern-soft (symbol-name symbol) new) | ||
| 495 | (define-abbrev new (symbol-name symbol) | ||
| 496 | (symbol-value symbol) (symbol-function symbol)))) | ||
| 497 | old))) | ||
| 498 | |||
| 499 | (provide 'derived) | 368 | (provide 'derived) |
| 500 | 369 | ||
| 501 | ;;; derived.el ends here | 370 | ;;; derived.el ends here |
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index a876e6b5744..b7db2adde59 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el | |||
| @@ -191,8 +191,6 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." | |||
| 191 | (if (consp obj) | 191 | (if (consp obj) |
| 192 | (setq bytes (car (cdr obj)) ;the byte code | 192 | (setq bytes (car (cdr obj)) ;the byte code |
| 193 | constvec (car (cdr (cdr obj)))) ;constant vector | 193 | constvec (car (cdr (cdr obj)))) ;constant vector |
| 194 | ;; If it is lazy-loaded, load it now | ||
| 195 | (fetch-bytecode obj) | ||
| 196 | (setq bytes (aref obj 1) | 194 | (setq bytes (aref obj 1) |
| 197 | constvec (aref obj 2))) | 195 | constvec (aref obj 2))) |
| 198 | (cl-assert (not (multibyte-string-p bytes))) | 196 | (cl-assert (not (multibyte-string-p bytes))) |
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 05b23a86fc0..4fa05008dd8 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el | |||
| @@ -132,7 +132,7 @@ it is disabled.") | |||
| 132 | (string-replace "'" "\\='" (format "%S" getter))))) | 132 | (string-replace "'" "\\='" (format "%S" getter))))) |
| 133 | (let ((start (point))) | 133 | (let ((start (point))) |
| 134 | (insert argdoc) | 134 | (insert argdoc) |
| 135 | (when (fboundp 'fill-region) | 135 | (when (fboundp 'fill-region) ;Don't break bootstrap! |
| 136 | (fill-region start (point) 'left t)))) | 136 | (fill-region start (point) 'left t)))) |
| 137 | ;; Finally, insert the keymap. | 137 | ;; Finally, insert the keymap. |
| 138 | (when (and (boundp keymap-sym) | 138 | (when (and (boundp keymap-sym) |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index a8a51502503..4c7dbb4ef8c 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -481,7 +481,7 @@ just FUNCTION is printed." | |||
| 481 | (edebug--eval-defun #'eval-defun edebug-it))) | 481 | (edebug--eval-defun #'eval-defun edebug-it))) |
| 482 | 482 | ||
| 483 | ;;;###autoload | 483 | ;;;###autoload |
| 484 | (defalias 'edebug-defun 'edebug-eval-top-level-form) | 484 | (defalias 'edebug-defun #'edebug-eval-top-level-form) |
| 485 | 485 | ||
| 486 | ;;;###autoload | 486 | ;;;###autoload |
| 487 | (defun edebug-eval-top-level-form () | 487 | (defun edebug-eval-top-level-form () |
| @@ -1729,7 +1729,7 @@ contains a circular object." | |||
| 1729 | (defun edebug-match-form (cursor) | 1729 | (defun edebug-match-form (cursor) |
| 1730 | (list (edebug-form cursor))) | 1730 | (list (edebug-form cursor))) |
| 1731 | 1731 | ||
| 1732 | (defalias 'edebug-match-place 'edebug-match-form) | 1732 | (defalias 'edebug-match-place #'edebug-match-form) |
| 1733 | ;; Currently identical to edebug-match-form. | 1733 | ;; Currently identical to edebug-match-form. |
| 1734 | ;; This is for common lisp setf-style place arguments. | 1734 | ;; This is for common lisp setf-style place arguments. |
| 1735 | 1735 | ||
| @@ -2277,12 +2277,7 @@ only be active while Edebug is. It checks `debug-on-error' to see | |||
| 2277 | whether it should call the debugger. When execution is resumed, the | 2277 | whether it should call the debugger. When execution is resumed, the |
| 2278 | error is signaled again." | 2278 | error is signaled again." |
| 2279 | (if (and (listp debug-on-error) (memq signal-name debug-on-error)) | 2279 | (if (and (listp debug-on-error) (memq signal-name debug-on-error)) |
| 2280 | (edebug 'error (cons signal-name signal-data))) | 2280 | (edebug 'error (cons signal-name signal-data)))) |
| 2281 | ;; If we reach here without another non-local exit, then send signal again. | ||
| 2282 | ;; i.e. the signal is not continuable, yet. | ||
| 2283 | ;; Avoid infinite recursion. | ||
| 2284 | (let ((signal-hook-function nil)) | ||
| 2285 | (signal signal-name signal-data))) | ||
| 2286 | 2281 | ||
| 2287 | ;;; Entering Edebug | 2282 | ;;; Entering Edebug |
| 2288 | 2283 | ||
| @@ -2326,6 +2321,12 @@ and run its entry function, and set up `edebug-before' and | |||
| 2326 | (debug-on-error (or debug-on-error edebug-on-error)) | 2321 | (debug-on-error (or debug-on-error edebug-on-error)) |
| 2327 | (debug-on-quit edebug-on-quit)) | 2322 | (debug-on-quit edebug-on-quit)) |
| 2328 | (unwind-protect | 2323 | (unwind-protect |
| 2324 | ;; FIXME: We could replace this `signal-hook-function' with | ||
| 2325 | ;; a cleaner `handler-bind' but then we wouldn't be able to | ||
| 2326 | ;; install it here (i.e. once and for all when entering | ||
| 2327 | ;; an Edebugged function), but instead it would have to | ||
| 2328 | ;; be installed into a modified `edebug-after' which wraps | ||
| 2329 | ;; the `handler-bind' around its argument(s). :-( | ||
| 2329 | (let ((signal-hook-function #'edebug-signal)) | 2330 | (let ((signal-hook-function #'edebug-signal)) |
| 2330 | (setq edebug-execution-mode (or edebug-next-execution-mode | 2331 | (setq edebug-execution-mode (or edebug-next-execution-mode |
| 2331 | edebug-initial-mode | 2332 | edebug-initial-mode |
| @@ -3348,7 +3349,7 @@ With prefix argument, make it a temporary breakpoint." | |||
| 3348 | (message "%s" msg))) | 3349 | (message "%s" msg))) |
| 3349 | 3350 | ||
| 3350 | 3351 | ||
| 3351 | (defalias 'edebug-step-through-mode 'edebug-step-mode) | 3352 | (defalias 'edebug-step-through-mode #'edebug-step-mode) |
| 3352 | 3353 | ||
| 3353 | (defun edebug-step-mode () | 3354 | (defun edebug-step-mode () |
| 3354 | "Proceed to next stop point." | 3355 | "Proceed to next stop point." |
| @@ -3836,12 +3837,12 @@ be installed in `emacs-lisp-mode-map'.") | |||
| 3836 | 3837 | ||
| 3837 | ;; Global GUD bindings for all emacs-lisp-mode buffers. | 3838 | ;; Global GUD bindings for all emacs-lisp-mode buffers. |
| 3838 | (unless edebug-inhibit-emacs-lisp-mode-bindings | 3839 | (unless edebug-inhibit-emacs-lisp-mode-bindings |
| 3839 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode) | 3840 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" #'edebug-step-mode) |
| 3840 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode) | 3841 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" #'edebug-next-mode) |
| 3841 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode) | 3842 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" #'edebug-go-mode) |
| 3842 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where) | 3843 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" #'edebug-where) |
| 3843 | ;; The following isn't a GUD binding. | 3844 | ;; The following isn't a GUD binding. |
| 3844 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" 'edebug-set-initial-mode)) | 3845 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" #'edebug-set-initial-mode)) |
| 3845 | 3846 | ||
| 3846 | (defvar-keymap edebug-mode-map | 3847 | (defvar-keymap edebug-mode-map |
| 3847 | :parent emacs-lisp-mode-map | 3848 | :parent emacs-lisp-mode-map |
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index df85a64baf3..fba69a36a97 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el | |||
| @@ -387,9 +387,9 @@ contents of field NAME is matched against PAT, or they can be of | |||
| 387 | ,@(mapcar (lambda (field) | 387 | ,@(mapcar (lambda (field) |
| 388 | (pcase-exhaustive field | 388 | (pcase-exhaustive field |
| 389 | (`(,name ,pat) | 389 | (`(,name ,pat) |
| 390 | `(app (pcase--flip eieio-oref ',name) ,pat)) | 390 | `(app (eieio-oref _ ',name) ,pat)) |
| 391 | ((pred symbolp) | 391 | ((pred symbolp) |
| 392 | `(app (pcase--flip eieio-oref ',field) ,field)))) | 392 | `(app (eieio-oref _ ',field) ,field)))) |
| 393 | fields))) | 393 | fields))) |
| 394 | 394 | ||
| 395 | ;;; Simple generators, and query functions. None of these would do | 395 | ;;; Simple generators, and query functions. None of these would do |
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 912a7357ca7..24afd03fbe6 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el | |||
| @@ -155,7 +155,7 @@ Remember to keep it a prime number to improve hash performance.") | |||
| 155 | 155 | ||
| 156 | (defvar eldoc-message-commands | 156 | (defvar eldoc-message-commands |
| 157 | ;; Don't define as `defconst' since it would then go to (read-only) purespace. | 157 | ;; Don't define as `defconst' since it would then go to (read-only) purespace. |
| 158 | (make-vector eldoc-message-commands-table-size 0) | 158 | (obarray-make eldoc-message-commands-table-size) |
| 159 | "Commands after which it is appropriate to print in the echo area. | 159 | "Commands after which it is appropriate to print in the echo area. |
| 160 | ElDoc does not try to print function arglists, etc., after just any command, | 160 | ElDoc does not try to print function arglists, etc., after just any command, |
| 161 | because some commands print their own messages in the echo area and these | 161 | because some commands print their own messages in the echo area and these |
| @@ -191,7 +191,7 @@ It should receive the same arguments as `message'.") | |||
| 191 | 191 | ||
| 192 | When `eldoc-print-after-edit' is non-nil, ElDoc messages are only | 192 | When `eldoc-print-after-edit' is non-nil, ElDoc messages are only |
| 193 | printed after commands contained in this obarray." | 193 | printed after commands contained in this obarray." |
| 194 | (let ((cmds (make-vector 31 0)) | 194 | (let ((cmds (obarray-make 31)) |
| 195 | (re (regexp-opt '("delete" "insert" "edit" "electric" "newline")))) | 195 | (re (regexp-opt '("delete" "insert" "edit" "electric" "newline")))) |
| 196 | (mapatoms (lambda (s) | 196 | (mapatoms (lambda (s) |
| 197 | (and (commandp s) | 197 | (and (commandp s) |
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index a8bc4bdd1e0..27c169cc657 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el | |||
| @@ -266,6 +266,7 @@ This environment can be passed to `macroexpand'." | |||
| 266 | (insert-file-contents file) | 266 | (insert-file-contents file) |
| 267 | (let ((buffer-file-name file) | 267 | (let ((buffer-file-name file) |
| 268 | (max-lisp-eval-depth (max 1000 max-lisp-eval-depth))) | 268 | (max-lisp-eval-depth (max 1000 max-lisp-eval-depth))) |
| 269 | (hack-local-variables) | ||
| 269 | (with-syntax-table emacs-lisp-mode-syntax-table | 270 | (with-syntax-table emacs-lisp-mode-syntax-table |
| 270 | (mapc 'elint-top-form (elint-update-env))))) | 271 | (mapc 'elint-top-form (elint-update-env))))) |
| 271 | (elint-set-mode-line) | 272 | (elint-set-mode-line) |
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 63f547ebeb8..411602ef166 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el | |||
| @@ -60,6 +60,7 @@ | |||
| 60 | ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ | 60 | ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ |
| 61 | foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ | 61 | foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ |
| 62 | cl-\\(?:defun\\|defmethod\\|defgeneric\\)\\|\ | 62 | cl-\\(?:defun\\|defmethod\\|defgeneric\\)\\|\ |
| 63 | transient-define-\\(?:prefix\\|suffix\\|infix\\|argument\\)\\|\ | ||
| 63 | menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)" | 64 | menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)" |
| 64 | find-function-space-re | 65 | find-function-space-re |
| 65 | "\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)") | 66 | "\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)") |
diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index c774296084e..ddbd6fdc017 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el | |||
| @@ -80,7 +80,9 @@ | |||
| 80 | (error "inline-const-p can only be used within define-inline")) | 80 | (error "inline-const-p can only be used within define-inline")) |
| 81 | 81 | ||
| 82 | (defmacro inline-const-val (_exp) | 82 | (defmacro inline-const-val (_exp) |
| 83 | "Return the value of EXP." | 83 | "Return the value of EXP. |
| 84 | During inlining, if the value of EXP is not yet known, this aborts the | ||
| 85 | inlining and makes us revert to a non-inlined function call." | ||
| 84 | (declare (debug t)) | 86 | (declare (debug t)) |
| 85 | (error "inline-const-val can only be used within define-inline")) | 87 | (error "inline-const-val can only be used within define-inline")) |
| 86 | 88 | ||
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index ca207ff548d..3475d944337 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el | |||
| @@ -1347,7 +1347,6 @@ Lisp function does not specify a special indentation." | |||
| 1347 | (put 'condition-case 'lisp-indent-function 2) | 1347 | (put 'condition-case 'lisp-indent-function 2) |
| 1348 | (put 'handler-case 'lisp-indent-function 1) ;CL | 1348 | (put 'handler-case 'lisp-indent-function 1) ;CL |
| 1349 | (put 'unwind-protect 'lisp-indent-function 1) | 1349 | (put 'unwind-protect 'lisp-indent-function 1) |
| 1350 | (put 'with-output-to-temp-buffer 'lisp-indent-function 1) | ||
| 1351 | (put 'closure 'lisp-indent-function 2) | 1350 | (put 'closure 'lisp-indent-function 2) |
| 1352 | 1351 | ||
| 1353 | (defun indent-sexp (&optional endpos) | 1352 | (defun indent-sexp (&optional endpos) |
| @@ -1420,14 +1419,15 @@ A prefix argument specifies pretty-printing." | |||
| 1420 | 1419 | ||
| 1421 | ;;;; Lisp paragraph filling commands. | 1420 | ;;;; Lisp paragraph filling commands. |
| 1422 | 1421 | ||
| 1423 | (defcustom emacs-lisp-docstring-fill-column 65 | 1422 | (defcustom emacs-lisp-docstring-fill-column 72 |
| 1424 | "Value of `fill-column' to use when filling a docstring. | 1423 | "Value of `fill-column' to use when filling a docstring. |
| 1425 | Any non-integer value means do not use a different value of | 1424 | Any non-integer value means do not use a different value of |
| 1426 | `fill-column' when filling docstrings." | 1425 | `fill-column' when filling docstrings." |
| 1427 | :type '(choice (integer) | 1426 | :type '(choice (integer) |
| 1428 | (const :tag "Use the current `fill-column'" t)) | 1427 | (const :tag "Use the current `fill-column'" t)) |
| 1429 | :safe (lambda (x) (or (eq x t) (integerp x))) | 1428 | :safe (lambda (x) (or (eq x t) (integerp x))) |
| 1430 | :group 'lisp) | 1429 | :group 'lisp |
| 1430 | :version "30.1") | ||
| 1431 | 1431 | ||
| 1432 | (defun lisp-fill-paragraph (&optional justify) | 1432 | (defun lisp-fill-paragraph (&optional justify) |
| 1433 | "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings. | 1433 | "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings. |
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 5f152d3b509..581053f6304 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el | |||
| @@ -183,7 +183,9 @@ expression, in which case we want to handle forms differently." | |||
| 183 | (loaddefs-generate--shorten-autoload | 183 | (loaddefs-generate--shorten-autoload |
| 184 | `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))) | 184 | `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))) |
| 185 | 185 | ||
| 186 | ((and expansion (memq car '(progn prog1))) | 186 | ;; Look inside `progn', and `eval-and-compile', since these |
| 187 | ;; are often used in the expansion of things like `pcase-defmacro'. | ||
| 188 | ((and expansion (memq car '(progn prog1 eval-and-compile))) | ||
| 187 | (let ((end (memq :autoload-end form))) | 189 | (let ((end (memq :autoload-end form))) |
| 188 | (when end ;Cut-off anything after the :autoload-end marker. | 190 | (when end ;Cut-off anything after the :autoload-end marker. |
| 189 | (setq form (copy-sequence form)) | 191 | (setq form (copy-sequence form)) |
| @@ -199,8 +201,7 @@ expression, in which case we want to handle forms differently." | |||
| 199 | define-globalized-minor-mode defun defmacro | 201 | define-globalized-minor-mode defun defmacro |
| 200 | easy-mmode-define-minor-mode define-minor-mode | 202 | easy-mmode-define-minor-mode define-minor-mode |
| 201 | define-inline cl-defun cl-defmacro cl-defgeneric | 203 | define-inline cl-defun cl-defmacro cl-defgeneric |
| 202 | cl-defstruct pcase-defmacro iter-defun cl-iter-defun | 204 | cl-defstruct pcase-defmacro iter-defun cl-iter-defun)) |
| 203 | transient-define-prefix)) | ||
| 204 | (macrop car) | 205 | (macrop car) |
| 205 | (setq expand (let ((load-true-file-name file) | 206 | (setq expand (let ((load-true-file-name file) |
| 206 | (load-file-name file)) | 207 | (load-file-name file)) |
| @@ -216,13 +217,17 @@ expression, in which case we want to handle forms differently." | |||
| 216 | define-globalized-minor-mode | 217 | define-globalized-minor-mode |
| 217 | easy-mmode-define-minor-mode define-minor-mode | 218 | easy-mmode-define-minor-mode define-minor-mode |
| 218 | cl-defun defun* cl-defmacro defmacro* | 219 | cl-defun defun* cl-defmacro defmacro* |
| 219 | define-overloadable-function)) | 220 | define-overloadable-function |
| 221 | transient-define-prefix transient-define-suffix | ||
| 222 | transient-define-infix transient-define-argument)) | ||
| 220 | (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*))) | 223 | (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*))) |
| 221 | (name (nth 1 form)) | 224 | (name (nth 1 form)) |
| 222 | (args (pcase car | 225 | (args (pcase car |
| 223 | ((or 'defun 'defmacro | 226 | ((or 'defun 'defmacro |
| 224 | 'defun* 'defmacro* 'cl-defun 'cl-defmacro | 227 | 'defun* 'defmacro* 'cl-defun 'cl-defmacro |
| 225 | 'define-overloadable-function) | 228 | 'define-overloadable-function |
| 229 | 'transient-define-prefix 'transient-define-suffix | ||
| 230 | 'transient-define-infix 'transient-define-argument) | ||
| 226 | (nth 2 form)) | 231 | (nth 2 form)) |
| 227 | ('define-skeleton '(&optional str arg)) | 232 | ('define-skeleton '(&optional str arg)) |
| 228 | ((or 'define-generic-mode 'define-derived-mode | 233 | ((or 'define-generic-mode 'define-derived-mode |
| @@ -244,7 +249,11 @@ expression, in which case we want to handle forms differently." | |||
| 244 | define-global-minor-mode | 249 | define-global-minor-mode |
| 245 | define-globalized-minor-mode | 250 | define-globalized-minor-mode |
| 246 | easy-mmode-define-minor-mode | 251 | easy-mmode-define-minor-mode |
| 247 | define-minor-mode)) | 252 | define-minor-mode |
| 253 | transient-define-prefix | ||
| 254 | transient-define-suffix | ||
| 255 | transient-define-infix | ||
| 256 | transient-define-argument)) | ||
| 248 | t) | 257 | t) |
| 249 | (and (eq (car-safe (car body)) 'interactive) | 258 | (and (eq (car-safe (car body)) 'interactive) |
| 250 | ;; List of modes or just t. | 259 | ;; List of modes or just t. |
| @@ -378,6 +387,7 @@ don't include." | |||
| 378 | (let ((defs nil) | 387 | (let ((defs nil) |
| 379 | (load-name (loaddefs-generate--file-load-name file main-outfile)) | 388 | (load-name (loaddefs-generate--file-load-name file main-outfile)) |
| 380 | (compute-prefixes t) | 389 | (compute-prefixes t) |
| 390 | read-symbol-shorthands | ||
| 381 | local-outfile inhibit-autoloads) | 391 | local-outfile inhibit-autoloads) |
| 382 | (with-temp-buffer | 392 | (with-temp-buffer |
| 383 | (insert-file-contents file) | 393 | (insert-file-contents file) |
| @@ -399,7 +409,22 @@ don't include." | |||
| 399 | (setq inhibit-autoloads (read (current-buffer))))) | 409 | (setq inhibit-autoloads (read (current-buffer))))) |
| 400 | (save-excursion | 410 | (save-excursion |
| 401 | (when (re-search-forward "autoload-compute-prefixes: *" nil t) | 411 | (when (re-search-forward "autoload-compute-prefixes: *" nil t) |
| 402 | (setq compute-prefixes (read (current-buffer)))))) | 412 | (setq compute-prefixes (read (current-buffer))))) |
| 413 | (save-excursion | ||
| 414 | ;; Since we're "open-coding", we have to repeat more | ||
| 415 | ;; complicated logic in `hack-local-variables'. | ||
| 416 | (when-let ((beg | ||
| 417 | (re-search-forward "read-symbol-shorthands: *" nil t))) | ||
| 418 | ;; `read-symbol-shorthands' alist ends with two parens. | ||
| 419 | (let* ((end (re-search-forward ")[;\n\s]*)")) | ||
| 420 | (commentless (replace-regexp-in-string | ||
| 421 | "\n\\s-*;+" "" | ||
| 422 | (buffer-substring beg end))) | ||
| 423 | (unsorted-shorthands (car (read-from-string commentless)))) | ||
| 424 | (setq read-symbol-shorthands | ||
| 425 | (sort unsorted-shorthands | ||
| 426 | (lambda (sh1 sh2) | ||
| 427 | (> (length (car sh1)) (length (car sh2)))))))))) | ||
| 403 | 428 | ||
| 404 | ;; We always return the package version (even for pre-dumped | 429 | ;; We always return the package version (even for pre-dumped |
| 405 | ;; files). | 430 | ;; files). |
| @@ -473,27 +498,35 @@ don't include." | |||
| 473 | 498 | ||
| 474 | (when (and autoload-compute-prefixes | 499 | (when (and autoload-compute-prefixes |
| 475 | compute-prefixes) | 500 | compute-prefixes) |
| 476 | (when-let ((form (loaddefs-generate--compute-prefixes load-name))) | 501 | (with-demoted-errors "%S" |
| 477 | ;; This output needs to always go in the main loaddefs.el, | 502 | (when-let |
| 478 | ;; regardless of `generated-autoload-file'. | 503 | ((form (loaddefs-generate--compute-prefixes load-name))) |
| 479 | (push (list main-outfile file form) defs))))) | 504 | ;; This output needs to always go in the main loaddefs.el, |
| 505 | ;; regardless of `generated-autoload-file'. | ||
| 506 | (push (list main-outfile file form) defs)))))) | ||
| 480 | defs)) | 507 | defs)) |
| 481 | 508 | ||
| 482 | (defun loaddefs-generate--compute-prefixes (load-name) | 509 | (defun loaddefs-generate--compute-prefixes (load-name) |
| 483 | (goto-char (point-min)) | 510 | (goto-char (point-min)) |
| 484 | (let ((prefs nil)) | 511 | (let ((prefs nil) |
| 512 | (temp-obarray (obarray-make))) | ||
| 485 | ;; Avoid (defvar <foo>) by requiring a trailing space. | 513 | ;; Avoid (defvar <foo>) by requiring a trailing space. |
| 486 | (while (re-search-forward | 514 | (while (re-search-forward |
| 487 | "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) | 515 | "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) |
| 488 | (unless (member (match-string 1) autoload-ignored-definitions) | 516 | (unless (member (match-string 1) autoload-ignored-definitions) |
| 489 | (let ((name (match-string-no-properties 2))) | 517 | (let* ((name (match-string-no-properties 2)) |
| 490 | (when (save-excursion | 518 | ;; Consider `read-symbol-shorthands'. |
| 491 | (goto-char (match-beginning 0)) | 519 | (probe (let ((obarray temp-obarray)) |
| 492 | (or (bobp) | 520 | (car (read-from-string name))))) |
| 493 | (progn | 521 | (when (symbolp probe) |
| 494 | (forward-line -1) | 522 | (setq name (symbol-name probe)) |
| 495 | (not (looking-at ";;;###autoload"))))) | 523 | (when (save-excursion |
| 496 | (push name prefs))))) | 524 | (goto-char (match-beginning 0)) |
| 525 | (or (bobp) | ||
| 526 | (progn | ||
| 527 | (forward-line -1) | ||
| 528 | (not (looking-at ";;;###autoload"))))) | ||
| 529 | (push name prefs)))))) | ||
| 497 | (loaddefs-generate--make-prefixes prefs load-name))) | 530 | (loaddefs-generate--make-prefixes prefs load-name))) |
| 498 | 531 | ||
| 499 | (defun loaddefs-generate--rubric (file &optional type feature compile) | 532 | (defun loaddefs-generate--rubric (file &optional type feature compile) |
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index ffbb29615da..d3d71a36ee4 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el | |||
| @@ -608,18 +608,30 @@ This allows using default values for `map-elt', which can't be | |||
| 608 | done using `pcase--flip'. | 608 | done using `pcase--flip'. |
| 609 | 609 | ||
| 610 | KEY is the key sought in the map. DEFAULT is the default value." | 610 | KEY is the key sought in the map. DEFAULT is the default value." |
| 611 | ;; It's obsolete in Emacs>29, but `map.el' is distributed via GNU ELPA | ||
| 612 | ;; for earlier Emacsen. | ||
| 613 | (declare (obsolete _ "30.1")) | ||
| 611 | `(map-elt ,map ,key ,default)) | 614 | `(map-elt ,map ,key ,default)) |
| 612 | 615 | ||
| 613 | (defun map--make-pcase-bindings (args) | 616 | (defun map--make-pcase-bindings (args) |
| 614 | "Return a list of pcase bindings from ARGS to the elements of a map." | 617 | "Return a list of pcase bindings from ARGS to the elements of a map." |
| 615 | (mapcar (lambda (elt) | 618 | (mapcar (if (< emacs-major-version 30) |
| 616 | (cond ((consp elt) | 619 | (lambda (elt) |
| 617 | `(app (map--pcase-map-elt ,(car elt) ,(caddr elt)) | 620 | (cond ((consp elt) |
| 618 | ,(cadr elt))) | 621 | `(app (map--pcase-map-elt ,(car elt) ,(caddr elt)) |
| 619 | ((keywordp elt) | 622 | ,(cadr elt))) |
| 620 | (let ((var (intern (substring (symbol-name elt) 1)))) | 623 | ((keywordp elt) |
| 621 | `(app (pcase--flip map-elt ,elt) ,var))) | 624 | (let ((var (intern (substring (symbol-name elt) 1)))) |
| 622 | (t `(app (pcase--flip map-elt ',elt) ,elt)))) | 625 | `(app (pcase--flip map-elt ,elt) ,var))) |
| 626 | (t `(app (pcase--flip map-elt ',elt) ,elt)))) | ||
| 627 | (lambda (elt) | ||
| 628 | (cond ((consp elt) | ||
| 629 | `(app (map-elt _ ,(car elt) ,(caddr elt)) | ||
| 630 | ,(cadr elt))) | ||
| 631 | ((keywordp elt) | ||
| 632 | (let ((var (intern (substring (symbol-name elt) 1)))) | ||
| 633 | `(app (map-elt _ ,elt) ,var))) | ||
| 634 | (t `(app (map-elt _ ',elt) ,elt))))) | ||
| 623 | args)) | 635 | args)) |
| 624 | 636 | ||
| 625 | (defun map--make-pcase-patterns (args) | 637 | (defun map--make-pcase-patterns (args) |
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index db0cc515e46..ef056c7909b 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el | |||
| @@ -501,8 +501,10 @@ This includes downloading missing dependencies, generating | |||
| 501 | autoloads, generating a package description file (used to | 501 | autoloads, generating a package description file (used to |
| 502 | identify a package as a VC package later on), building | 502 | identify a package as a VC package later on), building |
| 503 | documentation and marking the package as installed." | 503 | documentation and marking the package as installed." |
| 504 | (let ((pkg-spec (package-vc--desc->spec pkg-desc)) | 504 | (let* ((pkg-spec (package-vc--desc->spec pkg-desc)) |
| 505 | missing) | 505 | (lisp-dir (plist-get pkg-spec :lisp-dir)) |
| 506 | (lisp-path (file-name-concat pkg-dir lisp-dir)) | ||
| 507 | missing) | ||
| 506 | 508 | ||
| 507 | ;; In case the package was installed directly from source, the | 509 | ;; In case the package was installed directly from source, the |
| 508 | ;; dependency list wasn't know beforehand, and they might have | 510 | ;; dependency list wasn't know beforehand, and they might have |
| @@ -519,7 +521,7 @@ documentation and marking the package as installed." | |||
| 519 | "\\|") | 521 | "\\|") |
| 520 | regexp-unmatchable)) | 522 | regexp-unmatchable)) |
| 521 | (deps '())) | 523 | (deps '())) |
| 522 | (dolist (file (directory-files pkg-dir t "\\.el\\'" t)) | 524 | (dolist (file (directory-files lisp-path t "\\.el\\'" t)) |
| 523 | (unless (string-match-p ignored-files file) | 525 | (unless (string-match-p ignored-files file) |
| 524 | (with-temp-buffer | 526 | (with-temp-buffer |
| 525 | (insert-file-contents file) | 527 | (insert-file-contents file) |
| @@ -532,6 +534,7 @@ documentation and marking the package as installed." | |||
| 532 | (setq deps)))))) | 534 | (setq deps)))))) |
| 533 | (dolist (dep deps) | 535 | (dolist (dep deps) |
| 534 | (cl-callf version-to-list (cadr dep))) | 536 | (cl-callf version-to-list (cadr dep))) |
| 537 | (setf (package-desc-reqs pkg-desc) deps) | ||
| 535 | (setf missing (package-vc-install-dependencies (delete-dups deps))) | 538 | (setf missing (package-vc-install-dependencies (delete-dups deps))) |
| 536 | (setf missing (delq (assq (package-desc-name pkg-desc) | 539 | (setf missing (delq (assq (package-desc-name pkg-desc) |
| 537 | missing) | 540 | missing) |
| @@ -541,10 +544,8 @@ documentation and marking the package as installed." | |||
| 541 | (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) | 544 | (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) |
| 542 | ;; Generate autoloads | 545 | ;; Generate autoloads |
| 543 | (let* ((name (package-desc-name pkg-desc)) | 546 | (let* ((name (package-desc-name pkg-desc)) |
| 544 | (auto-name (format "%s-autoloads.el" name)) | 547 | (auto-name (format "%s-autoloads.el" name))) |
| 545 | (lisp-dir (plist-get pkg-spec :lisp-dir))) | 548 | (package-generate-autoloads name lisp-path) |
| 546 | (package-generate-autoloads | ||
| 547 | name (file-name-concat pkg-dir lisp-dir)) | ||
| 548 | (when lisp-dir | 549 | (when lisp-dir |
| 549 | (write-region | 550 | (write-region |
| 550 | (with-temp-buffer | 551 | (with-temp-buffer |
| @@ -938,8 +939,8 @@ for the last released version of the package." | |||
| 938 | (interactive | 939 | (interactive |
| 939 | (let* ((name (package-vc--read-package-name "Fetch package source: "))) | 940 | (let* ((name (package-vc--read-package-name "Fetch package source: "))) |
| 940 | (list (cadr (assoc name package-archive-contents #'string=)) | 941 | (list (cadr (assoc name package-archive-contents #'string=)) |
| 941 | (read-file-name "Clone into new or empty directory: " nil nil t nil | 942 | (read-directory-name "Clone into new or empty directory: " nil nil |
| 942 | (lambda (dir) (or (not (file-exists-p dir)) | 943 | (lambda (dir) (or (not (file-exists-p dir)) |
| 943 | (directory-empty-p dir)))) | 944 | (directory-empty-p dir)))) |
| 944 | (and current-prefix-arg :last-release)))) | 945 | (and current-prefix-arg :last-release)))) |
| 945 | (package-vc--archives-initialize) | 946 | (package-vc--archives-initialize) |
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 868373f46c2..fe7b10f569a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -2610,7 +2610,8 @@ This is meant to be used only in the case the byte-compiled files | |||
| 2610 | are invalid due to changed byte-code, macros or the like." | 2610 | are invalid due to changed byte-code, macros or the like." |
| 2611 | (interactive) | 2611 | (interactive) |
| 2612 | (pcase-dolist (`(_ ,pkg-desc) package-alist) | 2612 | (pcase-dolist (`(_ ,pkg-desc) package-alist) |
| 2613 | (package-recompile pkg-desc))) | 2613 | (with-demoted-errors "Error while recompiling: %S" |
| 2614 | (package-recompile pkg-desc)))) | ||
| 2614 | 2615 | ||
| 2615 | ;;;###autoload | 2616 | ;;;###autoload |
| 2616 | (defun package-autoremove () | 2617 | (defun package-autoremove () |
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 4754d4e720d..40d917795e3 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el | |||
| @@ -131,6 +131,8 @@ FUN in `pred' and `app' can take one of the forms: | |||
| 131 | call it with one argument | 131 | call it with one argument |
| 132 | (F ARG1 .. ARGn) | 132 | (F ARG1 .. ARGn) |
| 133 | call F with ARG1..ARGn and EXPVAL as n+1'th argument | 133 | call F with ARG1..ARGn and EXPVAL as n+1'th argument |
| 134 | (F ARG1 .. _ .. ARGn) | ||
| 135 | call F, passing EXPVAL at the _ position. | ||
| 134 | 136 | ||
| 135 | FUN, BOOLEXP, and subsequent PAT can refer to variables | 137 | FUN, BOOLEXP, and subsequent PAT can refer to variables |
| 136 | bound earlier in the pattern by a SYMBOL pattern. | 138 | bound earlier in the pattern by a SYMBOL pattern. |
| @@ -163,8 +165,12 @@ Emacs Lisp manual for more information and examples." | |||
| 163 | ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2) | 165 | ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2) |
| 164 | expansion)))) | 166 | expansion)))) |
| 165 | 167 | ||
| 166 | (declare-function help-fns--signature "help-fns" | 168 | (defconst pcase--find-macro-def-regexp "(pcase-defmacro[\s\t\n]+%s[\s\t\n]*(") |
| 167 | (function doc real-def real-function buffer)) | 169 | |
| 170 | (with-eval-after-load 'find-func | ||
| 171 | (defvar find-function-regexp-alist) | ||
| 172 | (add-to-list 'find-function-regexp-alist | ||
| 173 | `(pcase-macro . pcase--find-macro-def-regexp))) | ||
| 168 | 174 | ||
| 169 | ;; FIXME: Obviously, this will collide with nadvice's use of | 175 | ;; FIXME: Obviously, this will collide with nadvice's use of |
| 170 | ;; function-documentation if we happen to advise `pcase'. | 176 | ;; function-documentation if we happen to advise `pcase'. |
| @@ -174,9 +180,10 @@ Emacs Lisp manual for more information and examples." | |||
| 174 | (defun pcase--make-docstring () | 180 | (defun pcase--make-docstring () |
| 175 | (let* ((main (documentation (symbol-function 'pcase) 'raw)) | 181 | (let* ((main (documentation (symbol-function 'pcase) 'raw)) |
| 176 | (ud (help-split-fundoc main 'pcase))) | 182 | (ud (help-split-fundoc main 'pcase))) |
| 177 | ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works, | ||
| 178 | ;; where cl-lib is anything using pcase-defmacro. | ||
| 179 | (require 'help-fns) | 183 | (require 'help-fns) |
| 184 | (declare-function help-fns-short-filename "help-fns" (filename)) | ||
| 185 | (declare-function help-fns--signature "help-fns" | ||
| 186 | (function doc real-def real-function buffer)) | ||
| 180 | (with-temp-buffer | 187 | (with-temp-buffer |
| 181 | (insert (or (cdr ud) main)) | 188 | (insert (or (cdr ud) main)) |
| 182 | ;; Presentation Note: For conceptual continuity, we guarantee | 189 | ;; Presentation Note: For conceptual continuity, we guarantee |
| @@ -197,11 +204,20 @@ Emacs Lisp manual for more information and examples." | |||
| 197 | (let* ((pair (pop more)) | 204 | (let* ((pair (pop more)) |
| 198 | (symbol (car pair)) | 205 | (symbol (car pair)) |
| 199 | (me (cdr pair)) | 206 | (me (cdr pair)) |
| 200 | (doc (documentation me 'raw))) | 207 | (doc (documentation me 'raw)) |
| 208 | (filename (find-lisp-object-file-name me 'defun))) | ||
| 201 | (insert "\n\n-- ") | 209 | (insert "\n\n-- ") |
| 202 | (setq doc (help-fns--signature symbol doc me | 210 | (setq doc (help-fns--signature symbol doc me |
| 203 | (indirect-function me) | 211 | (indirect-function me) |
| 204 | nil)) | 212 | nil)) |
| 213 | (when filename | ||
| 214 | (save-excursion | ||
| 215 | (forward-char -1) | ||
| 216 | (insert (format-message " in `")) | ||
| 217 | (help-insert-xref-button (help-fns-short-filename filename) | ||
| 218 | 'help-function-def symbol filename | ||
| 219 | 'pcase-macro) | ||
| 220 | (insert (format-message "'.")))) | ||
| 205 | (insert "\n" (or doc "Not documented."))))) | 221 | (insert "\n" (or doc "Not documented."))))) |
| 206 | (let ((combined-doc (buffer-string))) | 222 | (let ((combined-doc (buffer-string))) |
| 207 | (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) | 223 | (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) |
| @@ -269,8 +285,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the | |||
| 269 | EXP in each binding in BINDINGS can use the results of the destructuring | 285 | EXP in each binding in BINDINGS can use the results of the destructuring |
| 270 | bindings that precede it in BINDINGS' order. | 286 | bindings that precede it in BINDINGS' order. |
| 271 | 287 | ||
| 272 | Each EXP should match (i.e. be of compatible structure) to its | 288 | Each EXP should match its respective PATTERN (i.e. be of structure |
| 273 | respective PATTERN; a mismatch may signal an error or may go | 289 | compatible to PATTERN); a mismatch may signal an error or may go |
| 274 | undetected, binding variables to arbitrary values, such as nil." | 290 | undetected, binding variables to arbitrary values, such as nil." |
| 275 | (declare (indent 1) | 291 | (declare (indent 1) |
| 276 | (debug ((&rest (pcase-PAT &optional form)) body))) | 292 | (debug ((&rest (pcase-PAT &optional form)) body))) |
| @@ -291,8 +307,8 @@ All EXPs are evaluated first, and then used to perform destructuring | |||
| 291 | bindings by matching each EXP against its respective PATTERN. Then | 307 | bindings by matching each EXP against its respective PATTERN. Then |
| 292 | BODY is evaluated with those bindings in effect. | 308 | BODY is evaluated with those bindings in effect. |
| 293 | 309 | ||
| 294 | Each EXP should match (i.e. be of compatible structure) to its | 310 | Each EXP should match its respective PATTERN (i.e. be of structure |
| 295 | respective PATTERN; a mismatch may signal an error or may go | 311 | compatible to PATTERN); a mismatch may signal an error or may go |
| 296 | undetected, binding variables to arbitrary values, such as nil." | 312 | undetected, binding variables to arbitrary values, such as nil." |
| 297 | (declare (indent 1) (debug pcase-let*)) | 313 | (declare (indent 1) (debug pcase-let*)) |
| 298 | (if (null (cdr bindings)) | 314 | (if (null (cdr bindings)) |
| @@ -800,10 +816,10 @@ A and B can be one of: | |||
| 800 | #'compiled-function-p)))) | 816 | #'compiled-function-p)))) |
| 801 | (pcase--mutually-exclusive-p (cadr upat) otherpred)) | 817 | (pcase--mutually-exclusive-p (cadr upat) otherpred)) |
| 802 | '(:pcase--fail . nil)) | 818 | '(:pcase--fail . nil)) |
| 803 | ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c)))) | 819 | ;; Since we turn (or 'a 'b 'c) into (pred (memq _ '(a b c))) |
| 804 | ;; try and preserve the info we get from that memq test. | 820 | ;; try and preserve the info we get from that memq test. |
| 805 | ((and (eq 'pcase--flip (car-safe (cadr upat))) | 821 | ((and (memq (car-safe (cadr upat)) '(memq member memql)) |
| 806 | (memq (cadr (cadr upat)) '(memq member memql)) | 822 | (eq (cadr (cadr upat)) '_) |
| 807 | (eq 'quote (car-safe (nth 2 (cadr upat)))) | 823 | (eq 'quote (car-safe (nth 2 (cadr upat)))) |
| 808 | (eq 'quote (car-safe pat))) | 824 | (eq 'quote (car-safe pat))) |
| 809 | (let ((set (cadr (nth 2 (cadr upat))))) | 825 | (let ((set (cadr (nth 2 (cadr upat))))) |
| @@ -851,7 +867,7 @@ A and B can be one of: | |||
| 851 | 867 | ||
| 852 | (defmacro pcase--flip (fun arg1 arg2) | 868 | (defmacro pcase--flip (fun arg1 arg2) |
| 853 | "Helper function, used internally to avoid (funcall (lambda ...) ...)." | 869 | "Helper function, used internally to avoid (funcall (lambda ...) ...)." |
| 854 | (declare (debug (sexp body))) | 870 | (declare (debug (sexp body)) (obsolete _ "30.1")) |
| 855 | `(,fun ,arg2 ,arg1)) | 871 | `(,fun ,arg2 ,arg1)) |
| 856 | 872 | ||
| 857 | (defun pcase--funcall (fun arg vars) | 873 | (defun pcase--funcall (fun arg vars) |
| @@ -872,9 +888,13 @@ A and B can be one of: | |||
| 872 | (let ((newsym (gensym "x"))) | 888 | (let ((newsym (gensym "x"))) |
| 873 | (push (list newsym arg) env) | 889 | (push (list newsym arg) env) |
| 874 | (setq arg newsym))) | 890 | (setq arg newsym))) |
| 875 | (if (or (functionp fun) (not (consp fun))) | 891 | (cond |
| 876 | `(funcall #',fun ,arg) | 892 | ((or (functionp fun) (not (consp fun))) |
| 877 | `(,@fun ,arg))))) | 893 | `(funcall #',fun ,arg)) |
| 894 | ((memq '_ fun) | ||
| 895 | (mapcar (lambda (x) (if (eq '_ x) arg x)) fun)) | ||
| 896 | (t | ||
| 897 | `(,@fun ,arg)))))) | ||
| 878 | (if (null env) | 898 | (if (null env) |
| 879 | call | 899 | call |
| 880 | ;; Let's not replace `vars' in `fun' since it's | 900 | ;; Let's not replace `vars' in `fun' since it's |
| @@ -935,7 +955,7 @@ Otherwise, it defers to REST which is a list of branches of the form | |||
| 935 | ;; Yes, we can use `memql' (or `member')! | 955 | ;; Yes, we can use `memql' (or `member')! |
| 936 | ((> (length simples) 1) | 956 | ((> (length simples) 1) |
| 937 | (pcase--u1 (cons `(match ,var | 957 | (pcase--u1 (cons `(match ,var |
| 938 | . (pred (pcase--flip ,mem-fun ',simples))) | 958 | . (pred (,mem-fun _ ',simples))) |
| 939 | (cdr matches)) | 959 | (cdr matches)) |
| 940 | code vars | 960 | code vars |
| 941 | (if (null others) rest | 961 | (if (null others) rest |
| @@ -1082,12 +1102,13 @@ The predicate is the logical-AND of: | |||
| 1082 | (declare (debug (pcase-QPAT))) | 1102 | (declare (debug (pcase-QPAT))) |
| 1083 | (cond | 1103 | (cond |
| 1084 | ((eq (car-safe qpat) '\,) (cadr qpat)) | 1104 | ((eq (car-safe qpat) '\,) (cadr qpat)) |
| 1105 | ((eq (car-safe qpat) '\,@) (error "Unsupported QPAT: %S" qpat)) | ||
| 1085 | ((vectorp qpat) | 1106 | ((vectorp qpat) |
| 1086 | `(and (pred vectorp) | 1107 | `(and (pred vectorp) |
| 1087 | (app length ,(length qpat)) | 1108 | (app length ,(length qpat)) |
| 1088 | ,@(let ((upats nil)) | 1109 | ,@(let ((upats nil)) |
| 1089 | (dotimes (i (length qpat)) | 1110 | (dotimes (i (length qpat)) |
| 1090 | (push `(app (pcase--flip aref ,i) ,(list '\` (aref qpat i))) | 1111 | (push `(app (aref _ ,i) ,(list '\` (aref qpat i))) |
| 1091 | upats)) | 1112 | upats)) |
| 1092 | (nreverse upats)))) | 1113 | (nreverse upats)))) |
| 1093 | ((consp qpat) | 1114 | ((consp qpat) |
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 4c6553972c2..20077db9e60 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el | |||
| @@ -619,12 +619,12 @@ SEQUENCE must be a sequence of numbers or markers." | |||
| 619 | (unless rest-marker | 619 | (unless rest-marker |
| 620 | (pcase name | 620 | (pcase name |
| 621 | (`&rest | 621 | (`&rest |
| 622 | (progn (push `(app (pcase--flip seq-drop ,index) | 622 | (progn (push `(app (seq-drop _ ,index) |
| 623 | ,(seq--elt-safe args (1+ index))) | 623 | ,(seq--elt-safe args (1+ index))) |
| 624 | bindings) | 624 | bindings) |
| 625 | (setq rest-marker t))) | 625 | (setq rest-marker t))) |
| 626 | (_ | 626 | (_ |
| 627 | (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings)))) | 627 | (push `(app (seq--elt-safe _ ,index) ,name) bindings)))) |
| 628 | (setq index (1+ index))) | 628 | (setq index (1+ index))) |
| 629 | bindings)) | 629 | bindings)) |
| 630 | 630 | ||
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index a6a49c72f74..cbb5618ffce 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el | |||
| @@ -51,6 +51,17 @@ | |||
| 51 | "Face used for a section.") | 51 | "Face used for a section.") |
| 52 | 52 | ||
| 53 | ;;;###autoload | 53 | ;;;###autoload |
| 54 | (defun shortdoc--check (group functions) | ||
| 55 | (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* | ||
| 56 | :result :result-string :eg-result :eg-result-string :doc))) | ||
| 57 | (dolist (f functions) | ||
| 58 | (when (consp f) | ||
| 59 | (dolist (x f) | ||
| 60 | (when (and (keywordp x) (not (memq x keywords))) | ||
| 61 | (error "Shortdoc %s function `%s': bad keyword `%s'" | ||
| 62 | group (car f) x))))))) | ||
| 63 | |||
| 64 | ;;;###autoload | ||
| 54 | (progn | 65 | (progn |
| 55 | (defvar shortdoc--groups nil) | 66 | (defvar shortdoc--groups nil) |
| 56 | 67 | ||
| @@ -118,6 +129,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), | |||
| 118 | `:no-eval*', `:result', `:result-string', `:eg-result' and | 129 | `:no-eval*', `:result', `:result-string', `:eg-result' and |
| 119 | `:eg-result-string' properties." | 130 | `:eg-result-string' properties." |
| 120 | (declare (indent defun)) | 131 | (declare (indent defun)) |
| 132 | (shortdoc--check group functions) | ||
| 121 | `(progn | 133 | `(progn |
| 122 | (setq shortdoc--groups (delq (assq ',group shortdoc--groups) | 134 | (setq shortdoc--groups (delq (assq ',group shortdoc--groups) |
| 123 | shortdoc--groups)) | 135 | shortdoc--groups)) |
| @@ -715,7 +727,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), | |||
| 715 | :eval (plist-get '(a 1 b 2 c 3) 'b)) | 727 | :eval (plist-get '(a 1 b 2 c 3) 'b)) |
| 716 | (plist-put | 728 | (plist-put |
| 717 | :no-eval (setq plist (plist-put plist 'd 4)) | 729 | :no-eval (setq plist (plist-put plist 'd 4)) |
| 718 | :eq-result (a 1 b 2 c 3 d 4)) | 730 | :eg-result (a 1 b 2 c 3 d 4)) |
| 719 | (plist-member | 731 | (plist-member |
| 720 | :eval (plist-member '(a 1 b 2 c 3) 'b)) | 732 | :eval (plist-member '(a 1 b 2 c 3) 'b)) |
| 721 | "Data About Lists" | 733 | "Data About Lists" |
| @@ -735,9 +747,13 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), | |||
| 735 | (intern | 747 | (intern |
| 736 | :eval (intern "abc")) | 748 | :eval (intern "abc")) |
| 737 | (intern-soft | 749 | (intern-soft |
| 750 | :eval (intern-soft "list") | ||
| 738 | :eval (intern-soft "Phooey!")) | 751 | :eval (intern-soft "Phooey!")) |
| 739 | (make-symbol | 752 | (make-symbol |
| 740 | :eval (make-symbol "abc")) | 753 | :eval (make-symbol "abc")) |
| 754 | (gensym | ||
| 755 | :no-eval (gensym) | ||
| 756 | :eg-result g37) | ||
| 741 | "Comparing symbols" | 757 | "Comparing symbols" |
| 742 | (eq | 758 | (eq |
| 743 | :eval (eq 'abc 'abc) | 759 | :eval (eq 'abc 'abc) |
| @@ -748,7 +764,20 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), | |||
| 748 | :eval (equal 'abc 'abc)) | 764 | :eval (equal 'abc 'abc)) |
| 749 | "Name" | 765 | "Name" |
| 750 | (symbol-name | 766 | (symbol-name |
| 751 | :eval (symbol-name 'abc))) | 767 | :eval (symbol-name 'abc)) |
| 768 | "Obarrays" | ||
| 769 | (obarray-make | ||
| 770 | :eval (obarray-make)) | ||
| 771 | (obarrayp | ||
| 772 | :eval (obarrayp (obarray-make)) | ||
| 773 | :eval (obarrayp nil)) | ||
| 774 | (unintern | ||
| 775 | :no-eval (unintern "abc" my-obarray) | ||
| 776 | :eg-result t) | ||
| 777 | (mapatoms | ||
| 778 | :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) | ||
| 779 | (obarray-clear | ||
| 780 | :no-eval (obarray-clear my-obarray))) | ||
| 752 | 781 | ||
| 753 | (define-short-documentation-group comparison | 782 | (define-short-documentation-group comparison |
| 754 | "General-purpose" | 783 | "General-purpose" |
diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el index 6348aaccf93..379fb0baec9 100644 --- a/lisp/emacs-lisp/shorthands.el +++ b/lisp/emacs-lisp/shorthands.el | |||
| @@ -52,38 +52,26 @@ | |||
| 52 | :version "28.1" | 52 | :version "28.1" |
| 53 | :group 'font-lock-faces) | 53 | :group 'font-lock-faces) |
| 54 | 54 | ||
| 55 | (defun shorthands--mismatch-from-end (str1 str2) | ||
| 56 | "Tell index of first mismatch in STR1 and STR2, from end. | ||
| 57 | The index is a valid 0-based index on STR1. Returns nil if STR1 | ||
| 58 | equals STR2. Return 0 if STR1 is a suffix of STR2." | ||
| 59 | (cl-loop with l1 = (length str1) with l2 = (length str2) | ||
| 60 | for i from 1 | ||
| 61 | for i1 = (- l1 i) for i2 = (- l2 i) | ||
| 62 | while (eq (aref str1 i1) (aref str2 i2)) | ||
| 63 | if (zerop i2) return (if (zerop i1) nil i1) | ||
| 64 | if (zerop i1) return 0 | ||
| 65 | finally (return i1))) | ||
| 66 | |||
| 67 | (defun shorthands-font-lock-shorthands (limit) | 55 | (defun shorthands-font-lock-shorthands (limit) |
| 56 | "Font lock until LIMIT considering `read-symbol-shorthands'." | ||
| 68 | (when read-symbol-shorthands | 57 | (when read-symbol-shorthands |
| 69 | (while (re-search-forward | 58 | (while (re-search-forward |
| 70 | (concat "\\_<\\(" (rx lisp-mode-symbol) "\\)\\_>") | 59 | (concat "\\_<\\(" (rx lisp-mode-symbol) "\\)\\_>") |
| 71 | limit t) | 60 | limit t) |
| 72 | (let* ((existing (get-text-property (match-beginning 1) 'face)) | 61 | (let* ((existing (get-text-property (match-beginning 1) 'face)) |
| 62 | (print-name (match-string 1)) | ||
| 73 | (probe (and (not (memq existing '(font-lock-comment-face | 63 | (probe (and (not (memq existing '(font-lock-comment-face |
| 74 | font-lock-string-face))) | 64 | font-lock-string-face))) |
| 75 | (intern-soft (match-string 1)))) | 65 | (intern-soft print-name))) |
| 76 | (sname (and probe (symbol-name probe))) | 66 | (symbol-name (and probe (symbol-name probe))) |
| 77 | (mismatch (and sname (shorthands--mismatch-from-end | 67 | (prefix (and symbol-name |
| 78 | (match-string 1) sname))) | 68 | (not (string-equal print-name symbol-name)) |
| 79 | (guess (and mismatch (1+ mismatch)))) | 69 | (car (assoc print-name |
| 80 | (when guess | 70 | read-symbol-shorthands |
| 81 | (when (and (< guess (1- (length (match-string 1)))) | 71 | #'string-prefix-p))))) |
| 82 | ;; In bug#67390 we allow other separators | 72 | (when prefix |
| 83 | (eq (char-syntax (aref (match-string 1) guess)) ?_)) | ||
| 84 | (setq guess (1+ guess))) | ||
| 85 | (add-face-text-property (match-beginning 1) | 73 | (add-face-text-property (match-beginning 1) |
| 86 | (+ (match-beginning 1) guess) | 74 | (+ (match-beginning 1) (length prefix)) |
| 87 | 'elisp-shorthand-font-lock-face)))))) | 75 | 'elisp-shorthand-font-lock-face)))))) |
| 88 | 76 | ||
| 89 | (font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands)) t) | 77 | (font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands)) t) |
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 29775e77716..1ed1528c6d5 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el | |||
| @@ -193,7 +193,7 @@ LEVEL is the trace level, VALUE value returned by FUNCTION." | |||
| 193 | ;; Do this so we'll see strings: | 193 | ;; Do this so we'll see strings: |
| 194 | (cl-prin1-to-string value) | 194 | (cl-prin1-to-string value) |
| 195 | ctx))))) | 195 | ctx))))) |
| 196 | 196 | ||
| 197 | (defvar trace--timer nil) | 197 | (defvar trace--timer nil) |
| 198 | 198 | ||
| 199 | (defun trace--display-buffer (buf) | 199 | (defun trace--display-buffer (buf) |
diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index c3c11bb0b0b..13840da0bd9 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el | |||
| @@ -47,11 +47,8 @@ This is used by `epa-search-keys', for looking up public keys." | |||
| 47 | (repeat :tag "Random pool" | 47 | (repeat :tag "Random pool" |
| 48 | (string :tag "Keyserver address")) | 48 | (string :tag "Keyserver address")) |
| 49 | (const "keyring.debian.org") | 49 | (const "keyring.debian.org") |
| 50 | (const "keys.gnupg.net") | ||
| 51 | (const "keyserver.ubuntu.com") | 50 | (const "keyserver.ubuntu.com") |
| 52 | (const "pgp.mit.edu") | 51 | (const "pgp.mit.edu") |
| 53 | (const "pool.sks-keyservers.net") | ||
| 54 | (const "zimmermann.mayfirst.org") | ||
| 55 | (string :tag "Custom keyserver")) | 52 | (string :tag "Custom keyserver")) |
| 56 | :version "28.1") | 53 | :version "28.1") |
| 57 | 54 | ||
diff --git a/lisp/epa.el b/lisp/epa.el index 53da3bf6cce..c29df18bb58 100644 --- a/lisp/epa.el +++ b/lisp/epa.el | |||
| @@ -73,6 +73,17 @@ The command `epa-mail-encrypt' uses this." | |||
| 73 | :group 'epa | 73 | :group 'epa |
| 74 | :version "24.4") | 74 | :version "24.4") |
| 75 | 75 | ||
| 76 | (defcustom epa-keys-select-method 'buffer | ||
| 77 | "Method used to select keys in `epa-select-keys'. | ||
| 78 | If the value is \\='buffer, the default, keys are selected via a | ||
| 79 | pop-up buffer. If the value is \\='minibuffer, keys are selected | ||
| 80 | via the minibuffer instead, using `completing-read-multiple'. | ||
| 81 | Any other value is treated as \\='buffer." | ||
| 82 | :type '(choice (const :tag "Read keys from a pop-up buffer" buffer) | ||
| 83 | (const :tag "Read keys from minibuffer" minibuffer)) | ||
| 84 | :group 'epa | ||
| 85 | :version "30.1") | ||
| 86 | |||
| 76 | ;;; Faces | 87 | ;;; Faces |
| 77 | 88 | ||
| 78 | (defgroup epa-faces nil | 89 | (defgroup epa-faces nil |
| @@ -450,6 +461,25 @@ q trust status questionable. - trust status unspecified. | |||
| 450 | (epa--marked-keys)) | 461 | (epa--marked-keys)) |
| 451 | (kill-buffer epa-keys-buffer))))) | 462 | (kill-buffer epa-keys-buffer))))) |
| 452 | 463 | ||
| 464 | (defun epa--select-keys-in-minibuffer (prompt keys) | ||
| 465 | (let* ((prompt (pcase-let ((`(,first ,second ,third) | ||
| 466 | (string-split prompt "\\.")) | ||
| 467 | (hint "(separated by comma)")) | ||
| 468 | (if third | ||
| 469 | (format "%s %s. %s: " first hint second) | ||
| 470 | (format "%s %s: " first hint)))) | ||
| 471 | (keys-alist | ||
| 472 | (seq-map | ||
| 473 | (lambda (key) | ||
| 474 | (cons (substring-no-properties | ||
| 475 | (epa--button-key-text key)) | ||
| 476 | key)) | ||
| 477 | keys)) | ||
| 478 | (selected-keys (completing-read-multiple prompt keys-alist))) | ||
| 479 | (seq-map | ||
| 480 | (lambda (key) (cdr (assoc key keys-alist))) | ||
| 481 | selected-keys))) | ||
| 482 | |||
| 453 | ;;;###autoload | 483 | ;;;###autoload |
| 454 | (defun epa-select-keys (context prompt &optional names secret) | 484 | (defun epa-select-keys (context prompt &optional names secret) |
| 455 | "Display a user's keyring and ask him to select keys. | 485 | "Display a user's keyring and ask him to select keys. |
| @@ -459,7 +489,9 @@ NAMES is a list of strings to be matched with keys. If it is nil, all | |||
| 459 | the keys are listed. | 489 | the keys are listed. |
| 460 | If SECRET is non-nil, list secret keys instead of public keys." | 490 | If SECRET is non-nil, list secret keys instead of public keys." |
| 461 | (let ((keys (epg-list-keys context names secret))) | 491 | (let ((keys (epg-list-keys context names secret))) |
| 462 | (epa--select-keys prompt keys))) | 492 | (pcase epa-keys-select-method |
| 493 | ('minibuffer (epa--select-keys-in-minibuffer prompt keys)) | ||
| 494 | (_ (epa--select-keys prompt keys))))) | ||
| 463 | 495 | ||
| 464 | ;;;; Key Details | 496 | ;;;; Key Details |
| 465 | 497 | ||
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index e379066b08e..9fc8a4d29f4 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el | |||
| @@ -158,7 +158,6 @@ | |||
| 158 | (declare-function erc-parse-user "erc" (string)) | 158 | (declare-function erc-parse-user "erc" (string)) |
| 159 | (declare-function erc-process-away "erc" (proc away-p)) | 159 | (declare-function erc-process-away "erc" (proc away-p)) |
| 160 | (declare-function erc-process-ctcp-query "erc" (proc parsed nick login host)) | 160 | (declare-function erc-process-ctcp-query "erc" (proc parsed nick login host)) |
| 161 | (declare-function erc-query-buffer-p "erc" (&optional buffer)) | ||
| 162 | (declare-function erc-remove-channel-member "erc" (channel nick)) | 161 | (declare-function erc-remove-channel-member "erc" (channel nick)) |
| 163 | (declare-function erc-remove-channel-users "erc" nil) | 162 | (declare-function erc-remove-channel-users "erc" nil) |
| 164 | (declare-function erc-remove-user "erc" (nick)) | 163 | (declare-function erc-remove-user "erc" (nick)) |
| @@ -254,6 +253,11 @@ Entries are of the form: | |||
| 254 | or | 253 | or |
| 255 | (PARAMETER) if no value is provided. | 254 | (PARAMETER) if no value is provided. |
| 256 | 255 | ||
| 256 | where PARAMETER is a string and VALUE is a string or nil. For | ||
| 257 | compatibility, a raw parameter of the form \"FOO=\" becomes | ||
| 258 | (\"FOO\" . \"\") even though it's equivalent to the preferred | ||
| 259 | canonical form \"FOO\" and its lisp representation (\"FOO\"). | ||
| 260 | |||
| 257 | Some examples of possible parameters sent by servers: | 261 | Some examples of possible parameters sent by servers: |
| 258 | CHANMODES=b,k,l,imnpst - list of supported channel modes | 262 | CHANMODES=b,k,l,imnpst - list of supported channel modes |
| 259 | CHANNELLEN=50 - maximum length of channel names | 263 | CHANNELLEN=50 - maximum length of channel names |
| @@ -273,7 +277,8 @@ WALLCHOPS - supports sending messages to all operators in a channel") | |||
| 273 | (defvar-local erc--isupport-params nil | 277 | (defvar-local erc--isupport-params nil |
| 274 | "Hash map of \"ISUPPORT\" params. | 278 | "Hash map of \"ISUPPORT\" params. |
| 275 | Keys are symbols. Values are lists of zero or more strings with hex | 279 | Keys are symbols. Values are lists of zero or more strings with hex |
| 276 | escapes removed.") | 280 | escapes removed. ERC normalizes incoming parameters of the form |
| 281 | \"FOO=\" to (FOO).") | ||
| 277 | 282 | ||
| 278 | ;;; Server and connection state | 283 | ;;; Server and connection state |
| 279 | 284 | ||
| @@ -1474,10 +1479,12 @@ for decoding." | |||
| 1474 | (let ((args (erc-response.command-args parsed-response)) | 1479 | (let ((args (erc-response.command-args parsed-response)) |
| 1475 | (decode-target nil) | 1480 | (decode-target nil) |
| 1476 | (decoded-args ())) | 1481 | (decoded-args ())) |
| 1482 | ;; FIXME this should stop after the first match. | ||
| 1477 | (dolist (arg args nil) | 1483 | (dolist (arg args nil) |
| 1478 | (when (string-match "^[#&].*" arg) | 1484 | (when (string-match "^[#&].*" arg) |
| 1479 | (setq decode-target arg))) | 1485 | (setq decode-target arg))) |
| 1480 | (when (stringp decode-target) | 1486 | (when (stringp decode-target) |
| 1487 | ;; FIXME `decode-target' should be passed as TARGET. | ||
| 1481 | (setq decode-target (erc-decode-string-from-target decode-target nil))) | 1488 | (setq decode-target (erc-decode-string-from-target decode-target nil))) |
| 1482 | (setf (erc-response.unparsed parsed-response) | 1489 | (setf (erc-response.unparsed parsed-response) |
| 1483 | (erc-decode-string-from-target | 1490 | (erc-decode-string-from-target |
| @@ -2150,10 +2157,6 @@ Then display the welcome message." | |||
| 2150 | ;; | 2157 | ;; |
| 2151 | ;; > The server SHOULD send "X", not "X="; this is the normalized form. | 2158 | ;; > The server SHOULD send "X", not "X="; this is the normalized form. |
| 2152 | ;; | 2159 | ;; |
| 2153 | ;; Note: for now, assume the server will only send non-empty values, | ||
| 2154 | ;; possibly with printable ASCII escapes. Though in practice, the | ||
| 2155 | ;; only two escapes we're likely to see are backslash and space, | ||
| 2156 | ;; meaning the pattern is too liberal. | ||
| 2157 | (let (case-fold-search) | 2160 | (let (case-fold-search) |
| 2158 | (mapcar | 2161 | (mapcar |
| 2159 | (lambda (v) | 2162 | (lambda (v) |
| @@ -2164,7 +2167,9 @@ Then display the welcome message." | |||
| 2164 | (string-match "[\\]x[0-9A-F][0-9A-F]" v start)) | 2167 | (string-match "[\\]x[0-9A-F][0-9A-F]" v start)) |
| 2165 | (setq m (substring v (+ 2 (match-beginning 0)) (match-end 0)) | 2168 | (setq m (substring v (+ 2 (match-beginning 0)) (match-end 0)) |
| 2166 | c (string-to-number m 16)) | 2169 | c (string-to-number m 16)) |
| 2167 | (if (<= ?\ c ?~) | 2170 | ;; In practice, this range is too liberal. The only |
| 2171 | ;; escapes we're likely to see are ?\\, ?=, and ?\s. | ||
| 2172 | (if (<= ?\s c ?~) | ||
| 2168 | (setq v (concat (substring v 0 (match-beginning 0)) | 2173 | (setq v (concat (substring v 0 (match-beginning 0)) |
| 2169 | (string c) | 2174 | (string c) |
| 2170 | (substring v (match-end 0))) | 2175 | (substring v (match-end 0))) |
| @@ -2189,8 +2194,9 @@ primitive value." | |||
| 2189 | (or erc-server-parameters | 2194 | (or erc-server-parameters |
| 2190 | (erc-with-server-buffer | 2195 | (erc-with-server-buffer |
| 2191 | erc-server-parameters))))) | 2196 | erc-server-parameters))))) |
| 2192 | (if (cdr v) | 2197 | (if-let ((val (cdr v)) |
| 2193 | (erc--parse-isupport-value (cdr v)) | 2198 | ((not (string-empty-p val)))) |
| 2199 | (erc--parse-isupport-value val) | ||
| 2194 | '--empty--))))) | 2200 | '--empty--))))) |
| 2195 | (pcase value | 2201 | (pcase value |
| 2196 | ('--empty-- (unless single (list key))) | 2202 | ('--empty-- (unless single (list key))) |
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index abcdc4c8843..8388efe062c 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el | |||
| @@ -171,7 +171,7 @@ Derived from the advertised \"PREFIX\" ISUPPORT parameter." | |||
| 171 | 171 | ||
| 172 | ;; After dropping 28, we can use prefixed "erc-autoload" cookies. | 172 | ;; After dropping 28, we can use prefixed "erc-autoload" cookies. |
| 173 | (defun erc--normalize-module-symbol (symbol) | 173 | (defun erc--normalize-module-symbol (symbol) |
| 174 | "Return preferred SYMBOL for `erc--modules'." | 174 | "Return preferred SYMBOL for `erc--module'." |
| 175 | (while-let ((canonical (get symbol 'erc--module)) | 175 | (while-let ((canonical (get symbol 'erc--module)) |
| 176 | ((not (eq canonical symbol)))) | 176 | ((not (eq canonical symbol)))) |
| 177 | (setq symbol canonical)) | 177 | (setq symbol canonical)) |
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index dede833a93d..b5b8fbaf8ab 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el | |||
| @@ -31,51 +31,11 @@ | |||
| 31 | 31 | ||
| 32 | ;;; Code: | 32 | ;;; Code: |
| 33 | 33 | ||
| 34 | (require 'compat nil 'noerror) | 34 | (require 'compat) |
| 35 | (eval-when-compile (require 'cl-lib)) | 35 | (eval-when-compile (require 'cl-lib)) |
| 36 | 36 | ||
| 37 | ;; Except for the "erc-" namespacing, these two definitions should be | 37 | (define-obsolete-function-alias 'erc-compat-function #'compat-function "30.1") |
| 38 | ;; continuously updated to match the latest upstream ones verbatim. | 38 | (define-obsolete-function-alias 'erc-compat-call #'compat-call "30.1") |
| 39 | ;; Although they're pretty simple, it's likely not worth checking for | ||
| 40 | ;; and possibly deferring to the non-prefixed versions. | ||
| 41 | ;; | ||
| 42 | ;; BEGIN Compat macros | ||
| 43 | |||
| 44 | ;;;; Macros for extended compatibility function calls | ||
| 45 | |||
| 46 | (defmacro erc-compat-function (fun) | ||
| 47 | "Return compatibility function symbol for FUN. | ||
| 48 | |||
| 49 | If the Emacs version provides a sufficiently recent version of | ||
| 50 | FUN, the symbol FUN is returned itself. Otherwise the macro | ||
| 51 | returns the symbol of a compatibility function which supports the | ||
| 52 | behavior and calling convention of the current stable Emacs | ||
| 53 | version. For example Compat 29.1 will provide compatibility | ||
| 54 | functions which implement the behavior and calling convention of | ||
| 55 | Emacs 29.1. | ||
| 56 | |||
| 57 | See also `compat-call' to directly call compatibility functions." | ||
| 58 | (let ((compat (intern (format "compat--%s" fun)))) | ||
| 59 | `#',(if (fboundp compat) compat fun))) | ||
| 60 | |||
| 61 | (defmacro erc-compat-call (fun &rest args) | ||
| 62 | "Call compatibility function or macro FUN with ARGS. | ||
| 63 | |||
| 64 | A good example function is `plist-get' which was extended with an | ||
| 65 | additional predicate argument in Emacs 29.1. The compatibility | ||
| 66 | function, which supports this additional argument, can be | ||
| 67 | obtained via (compat-function plist-get) and called | ||
| 68 | via (compat-call plist-get plist prop predicate). It is not | ||
| 69 | possible to directly call (plist-get plist prop predicate) on | ||
| 70 | Emacs older than 29.1, since the original `plist-get' function | ||
| 71 | does not yet support the predicate argument. Note that the | ||
| 72 | Compat library never overrides existing functions. | ||
| 73 | |||
| 74 | See also `compat-function' to lookup compatibility functions." | ||
| 75 | (let ((compat (intern (format "compat--%s" fun)))) | ||
| 76 | `(,(if (fboundp compat) compat fun) ,@args))) | ||
| 77 | |||
| 78 | ;; END Compat macros | ||
| 79 | 39 | ||
| 80 | ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") | 40 | ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") |
| 81 | (define-obsolete-function-alias 'erc-define-minor-mode | 41 | (define-obsolete-function-alias 'erc-define-minor-mode |
| @@ -102,7 +62,7 @@ See `erc-encoding-coding-alist'." | |||
| 102 | 62 | ||
| 103 | (defun erc-set-write-file-functions (new-val) | 63 | (defun erc-set-write-file-functions (new-val) |
| 104 | (declare (obsolete nil "28.1")) | 64 | (declare (obsolete nil "28.1")) |
| 105 | (set (make-local-variable 'write-file-functions) new-val)) | 65 | (setq-local write-file-functions new-val)) |
| 106 | 66 | ||
| 107 | (defvar erc-emacs-build-time | 67 | (defvar erc-emacs-build-time |
| 108 | (if (or (stringp emacs-build-time) (not emacs-build-time)) | 68 | (if (or (stringp emacs-build-time) (not emacs-build-time)) |
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index b91ce007087..aa12b807fbc 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el | |||
| @@ -44,11 +44,7 @@ | |||
| 44 | (define-erc-module fill nil | 44 | (define-erc-module fill nil |
| 45 | "Manage filling in ERC buffers. | 45 | "Manage filling in ERC buffers. |
| 46 | ERC fill mode is a global minor mode. When enabled, messages in | 46 | ERC fill mode is a global minor mode. When enabled, messages in |
| 47 | the channel buffers are filled." | 47 | channel buffers are filled. See also `erc-fill-wrap-mode'." |
| 48 | ;; FIXME ensure a consistent ordering relative to hook members from | ||
| 49 | ;; other modules. Ideally, this module's processing should happen | ||
| 50 | ;; after "morphological" modifications to a message's text but | ||
| 51 | ;; before superficial decorations. | ||
| 52 | ((add-hook 'erc-insert-modify-hook #'erc-fill 60) | 48 | ((add-hook 'erc-insert-modify-hook #'erc-fill 60) |
| 53 | (add-hook 'erc-send-modify-hook #'erc-fill 60)) | 49 | (add-hook 'erc-send-modify-hook #'erc-fill 60)) |
| 54 | ((remove-hook 'erc-insert-modify-hook #'erc-fill) | 50 | ((remove-hook 'erc-insert-modify-hook #'erc-fill) |
| @@ -425,8 +421,11 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." | |||
| 425 | "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line) | 421 | "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line) |
| 426 | 422 | ||
| 427 | (defvar erc-button-mode) | 423 | (defvar erc-button-mode) |
| 424 | (defvar erc-scrolltobottom-mode) | ||
| 428 | (defvar erc-legacy-invisible-bounds-p) | 425 | (defvar erc-legacy-invisible-bounds-p) |
| 429 | 426 | ||
| 427 | (defvar erc--fill-wrap-scrolltobottom-exempt-p nil) | ||
| 428 | |||
| 430 | (defun erc-fill--wrap-ensure-dependencies () | 429 | (defun erc-fill--wrap-ensure-dependencies () |
| 431 | (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) | 430 | (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) |
| 432 | (when erc-legacy-invisible-bounds-p | 431 | (when erc-legacy-invisible-bounds-p |
| @@ -439,6 +438,10 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." | |||
| 439 | (unless erc-fill-mode | 438 | (unless erc-fill-mode |
| 440 | (push 'fill missing-deps) | 439 | (push 'fill missing-deps) |
| 441 | (erc-fill-mode +1)) | 440 | (erc-fill-mode +1)) |
| 441 | (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p | ||
| 442 | (memq 'scrolltobottom erc-modules)) | ||
| 443 | (push 'scrolltobottom missing-deps) | ||
| 444 | (erc-scrolltobottom-mode +1)) | ||
| 442 | (when erc-fill-wrap-merge | 445 | (when erc-fill-wrap-merge |
| 443 | (require 'erc-button) | 446 | (require 'erc-button) |
| 444 | (unless erc-button-mode | 447 | (unless erc-button-mode |
| @@ -459,27 +462,25 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." | |||
| 459 | ;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill) | 462 | ;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill) |
| 460 | (define-erc-module fill-wrap nil | 463 | (define-erc-module fill-wrap nil |
| 461 | "Fill style leveraging `visual-line-mode'. | 464 | "Fill style leveraging `visual-line-mode'. |
| 465 | |||
| 462 | This module displays nicks overhanging leftward to a common | 466 | This module displays nicks overhanging leftward to a common |
| 463 | offset, as determined by the option `erc-fill-static-center'. | 467 | offset, as determined by the option `erc-fill-static-center'. It |
| 464 | And it \"wraps\" messages at a common margin width, as determined | 468 | also \"wraps\" messages at a common width, as determined by the |
| 465 | by the option `erc-fill-wrap-margin-width'. To use it, either | 469 | option `erc-fill-wrap-margin-width'. To use it, either include |
| 466 | include `fill-wrap' in `erc-modules' or set `erc-fill-function' | 470 | `fill-wrap' in `erc-modules' or set `erc-fill-function' to |
| 467 | to `erc-fill-wrap'. Most users will want to enable the | 471 | `erc-fill-wrap'. |
| 468 | `scrolltobottom' module as well. | 472 | |
| 469 | 473 | Once enabled, use \\[erc-fill-wrap-nudge] to adjust the width of | |
| 470 | During sessions in which this module is active, use | 474 | the indent and the stamp margin. And For cycling between |
| 471 | \\[erc-fill-wrap-nudge] to adjust the width of the indent and the | 475 | logical- and screen-line oriented command movement, see |
| 472 | stamp margin, and use \\[erc-fill-wrap-toggle-truncate-lines] for | 476 | \\[erc-fill-wrap-toggle-truncate-lines]. Similarly, use |
| 473 | cycling between logical- and screen-line oriented command | 477 | \\[erc-fill-wrap-refill-buffer] to fix alignment problems after |
| 474 | movement. Similarly, use \\[erc-fill-wrap-refill-buffer] to fix | 478 | running certain commands, like `text-scale-adjust'. Also see |
| 475 | alignment problems after running certain commands, like | 479 | related stylistic options `erc-fill-wrap-merge', and |
| 476 | `text-scale-adjust'. Also see related stylistic options | 480 | `erc-fill-wrap-merge-indicator'. (Hint: in narrow windows, try |
| 477 | `erc-fill-wrap-merge', and `erc-fill-wrap-merge-indicator'. | 481 | setting `erc-fill-static-center' to 1, and if you use |
| 478 | \(Hint: in narrow windows, where is space tight, try setting | 482 | `erc-fill-wrap-merge-indicator', choose \"Leading MIDDLE DOT sans |
| 479 | `erc-fill-static-center' to 1. And if you also use the option | 483 | gap\" or one of the \"trailing\" items from the Customize menu.) |
| 480 | `erc-fill-wrap-merge-indicator', set that to value-menu item | ||
| 481 | \"Leading MIDDLE DOT sans gap\" or one of the various | ||
| 482 | \"trailing\" items.) | ||
| 483 | 484 | ||
| 484 | This module imposes various restrictions on the appearance of | 485 | This module imposes various restrictions on the appearance of |
| 485 | timestamps. Most notably, it insists on displaying them in the | 486 | timestamps. Most notably, it insists on displaying them in the |
| @@ -497,11 +498,12 @@ a workaround provided by `erc-stamp-prefix-log-filter', which | |||
| 497 | strips trailing stamps from logged messages and instead prepends | 498 | strips trailing stamps from logged messages and instead prepends |
| 498 | them to every line. | 499 | them to every line. |
| 499 | 500 | ||
| 500 | As a so-called \"local\" module, `fill-wrap' depends on the | 501 | A so-called \"local\" module, `fill-wrap' depends on the global |
| 501 | global modules `fill', `stamp', and `button'; it activates them | 502 | modules `fill', `stamp', `button', and `scrolltobottom'. It |
| 502 | as needed when initializing. Please note that enabling and | 503 | activates them as needed when initializing and leaves them |
| 503 | disabling this module by invoking one of its minor-mode toggles | 504 | enabled when shutting down. To opt out of `scrolltobottom' |
| 504 | is not recommended." | 505 | specifically, disable its minor mode, `erc-scrolltobottom-mode', |
| 506 | via `erc-fill-wrap-mode-hook'." | ||
| 505 | ((erc-fill--wrap-ensure-dependencies) | 507 | ((erc-fill--wrap-ensure-dependencies) |
| 506 | (erc--restore-initialize-priors erc-fill-wrap-mode | 508 | (erc--restore-initialize-priors erc-fill-wrap-mode |
| 507 | erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys | 509 | erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys |
| @@ -832,7 +834,7 @@ decorations applied by third-party modules." | |||
| 832 | (line (count-screen-lines (window-start) (window-point)))) | 834 | (line (count-screen-lines (window-start) (window-point)))) |
| 833 | (when (zerop arg) | 835 | (when (zerop arg) |
| 834 | (setq arg 1)) | 836 | (setq arg 1)) |
| 835 | (erc-compat-call | 837 | (compat-call |
| 836 | set-transient-map | 838 | set-transient-map |
| 837 | (let ((map (make-sparse-keymap))) | 839 | (let ((map (make-sparse-keymap))) |
| 838 | (dolist (key '(?= ?- ?0)) | 840 | (dolist (key '(?= ?- ?0)) |
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 8293994c5d4..7e30b1060fd 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el | |||
| @@ -83,7 +83,7 @@ be experimental. It currently only works with Emacs 28+." | |||
| 83 | (when (and erc-scrolltobottom-all (< emacs-major-version 28)) | 83 | (when (and erc-scrolltobottom-all (< emacs-major-version 28)) |
| 84 | (erc-button--display-error-notice-with-keys | 84 | (erc-button--display-error-notice-with-keys |
| 85 | "Option `erc-scrolltobottom-all' requires Emacs 28+. Disabling.") | 85 | "Option `erc-scrolltobottom-all' requires Emacs 28+. Disabling.") |
| 86 | (setopt erc-scrolltobottom-all nil)) | 86 | (setq erc-scrolltobottom-all nil)) |
| 87 | (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) | 87 | (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) |
| 88 | (if erc-scrolltobottom-all | 88 | (if erc-scrolltobottom-all |
| 89 | (progn | 89 | (progn |
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 99c3c0563d0..1b26afa1164 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el | |||
| @@ -1123,10 +1123,27 @@ TARGET to be an `erc--target' object." | |||
| 1123 | (lambda () | 1123 | (lambda () |
| 1124 | (when (and erc--target (eq (erc--target-symbol erc--target) | 1124 | (when (and erc--target (eq (erc--target-symbol erc--target) |
| 1125 | (erc--target-symbol target))) | 1125 | (erc--target-symbol target))) |
| 1126 | (let ((oursp (if (erc--target-channel-local-p target) | 1126 | ;; When a server sends administrative queries immediately |
| 1127 | (equal announced erc-server-announced-name) | 1127 | ;; after connection registration and before the session has a |
| 1128 | (erc-networks--id-equal-p identity erc-networks--id)))) | 1128 | ;; net-id, the buffer remains orphaned until reassociated |
| 1129 | (funcall (if oursp on-dupe on-collision)))))))) | 1129 | ;; here retroactively. |
| 1130 | (unless erc-networks--id | ||
| 1131 | (let ((id (erc-with-server-buffer erc-networks--id)) | ||
| 1132 | (server-buffer (process-buffer erc-server-process))) | ||
| 1133 | (apply #'erc-button--display-error-notice-with-keys | ||
| 1134 | server-buffer | ||
| 1135 | (concat "Missing network session (ID) for %S. " | ||
| 1136 | (if id "Using `%S' from %S." "Ignoring.")) | ||
| 1137 | (current-buffer) | ||
| 1138 | (and id (list (erc-networks--id-symbol | ||
| 1139 | (setq erc-networks--id id)) | ||
| 1140 | server-buffer))))) | ||
| 1141 | (when erc-networks--id | ||
| 1142 | (let ((oursp (if (erc--target-channel-local-p target) | ||
| 1143 | (equal announced erc-server-announced-name) | ||
| 1144 | (erc-networks--id-equal-p identity | ||
| 1145 | erc-networks--id)))) | ||
| 1146 | (funcall (if oursp on-dupe on-collision))))))))) | ||
| 1130 | 1147 | ||
| 1131 | (defconst erc-networks--qualified-sep "@" | 1148 | (defconst erc-networks--qualified-sep "@" |
| 1132 | "Separator used for naming a target buffer.") | 1149 | "Separator used for naming a target buffer.") |
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index e3d28aa60dd..a81a3869436 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el | |||
| @@ -566,8 +566,9 @@ The INDENT level is ignored." | |||
| 566 | (defun erc-speedbar--reset-last-ran-on-timer () | 566 | (defun erc-speedbar--reset-last-ran-on-timer () |
| 567 | "Reset `erc-speedbar--last-ran'." | 567 | "Reset `erc-speedbar--last-ran'." |
| 568 | (when speedbar-buffer | 568 | (when speedbar-buffer |
| 569 | (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) | 569 | (with-suppressed-warnings ((obsolete buffer-local-value)) ; <=29 |
| 570 | (current-time)))) | 570 | (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) |
| 571 | (current-time))))) | ||
| 571 | 572 | ||
| 572 | ;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t) | 573 | ;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t) |
| 573 | (define-erc-module nickbar nil | 574 | (define-erc-module nickbar nil |
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 558afd19427..a8190a2c94a 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el | |||
| @@ -184,7 +184,7 @@ from entering them and instead jump over them." | |||
| 184 | (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) | 184 | (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) |
| 185 | (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40) | 185 | (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40) |
| 186 | (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) | 186 | (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) |
| 187 | ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec) | 187 | ((remove-hook 'erc-mode-hook #'erc-stamp--setup) |
| 188 | (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) | 188 | (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) |
| 189 | (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) | 189 | (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) |
| 190 | (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) | 190 | (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) |
| @@ -198,6 +198,7 @@ from entering them and instead jump over them." | |||
| 198 | "Escape hatch for omitting stamps when first char is invisible.") | 198 | "Escape hatch for omitting stamps when first char is invisible.") |
| 199 | 199 | ||
| 200 | (defun erc-stamp--recover-on-reconnect () | 200 | (defun erc-stamp--recover-on-reconnect () |
| 201 | "Attempt to restore \"last-inserted\" snapshots from prior session." | ||
| 201 | (when-let ((priors (or erc--server-reconnecting erc--target-priors))) | 202 | (when-let ((priors (or erc--server-reconnecting erc--target-priors))) |
| 202 | (dolist (var '(erc-timestamp-last-inserted | 203 | (dolist (var '(erc-timestamp-last-inserted |
| 203 | erc-timestamp-last-inserted-left | 204 | erc-timestamp-last-inserted-left |
| @@ -827,6 +828,7 @@ left-sided stamps and date stamps inserted by this function." | |||
| 827 | ;; perform day alignments via this function only when needed. | 828 | ;; perform day alignments via this function only when needed. |
| 828 | (defun erc-stamp--time-as-day (current-time) | 829 | (defun erc-stamp--time-as-day (current-time) |
| 829 | "Discard hour, minute, and second info from timestamp CURRENT-TIME." | 830 | "Discard hour, minute, and second info from timestamp CURRENT-TIME." |
| 831 | (defvar current-time-list) ; <=28 | ||
| 830 | (let* ((current-time-list) ; flag | 832 | (let* ((current-time-list) ; flag |
| 831 | (decoded (decode-time current-time erc-stamp--tz))) | 833 | (decoded (decode-time current-time erc-stamp--tz))) |
| 832 | (setf (decoded-time-second decoded) 0 | 834 | (setf (decoded-time-second decoded) 0 |
| @@ -854,12 +856,20 @@ Return the empty string if FORMAT is nil." | |||
| 854 | 856 | ||
| 855 | (defvar-local erc-stamp--csf-props-updated-p nil) | 857 | (defvar-local erc-stamp--csf-props-updated-p nil) |
| 856 | 858 | ||
| 857 | ;; This function is used to munge `buffer-invisibility-spec' to an | 859 | (define-obsolete-function-alias 'erc-munge-invisibility-spec |
| 858 | ;; appropriate value. Currently, it only handles timestamps, thus its | 860 | #'erc-stamp--manage-local-options-state "30.1" |
| 859 | ;; location. If you add other features which affect invisibility, | 861 | "Perform setup and teardown of `stamp'-owned options. |
| 860 | ;; please modify this function and move it to a more appropriate | 862 | |
| 861 | ;; location. | 863 | Note that this function's role in practice has long defied its |
| 862 | (defun erc-munge-invisibility-spec () | 864 | stated mandate as claimed in a now deleted comment, which |
| 865 | envisioned it as evolving into a central toggle for modifying | ||
| 866 | `buffer-invisibility-spec' on behalf of options and features | ||
| 867 | ERC-wide.") | ||
| 868 | (defun erc-stamp--manage-local-options-state () | ||
| 869 | "Perform local setup and teardown for `stamp'-owned options. | ||
| 870 | For `erc-timestamp-intangible', toggle `cursor-intangible-mode'. | ||
| 871 | For `erc-echo-timestamps', integrate with `cursor-sensor-mode'. | ||
| 872 | For `erc-hide-timestamps, modify `buffer-invisibility-spec'." | ||
| 863 | (if erc-timestamp-intangible | 873 | (if erc-timestamp-intangible |
| 864 | (cursor-intangible-mode +1) ; idempotent | 874 | (cursor-intangible-mode +1) ; idempotent |
| 865 | (when (bound-and-true-p cursor-intangible-mode) | 875 | (when (bound-and-true-p cursor-intangible-mode) |
| @@ -869,10 +879,12 @@ Return the empty string if FORMAT is nil." | |||
| 869 | (unless erc-stamp--permanent-cursor-sensor-functions | 879 | (unless erc-stamp--permanent-cursor-sensor-functions |
| 870 | (dolist (hook '(erc-insert-post-hook erc-send-post-hook)) | 880 | (dolist (hook '(erc-insert-post-hook erc-send-post-hook)) |
| 871 | (add-hook hook #'erc-stamp--add-csf-on-post-modify nil t)) | 881 | (add-hook hook #'erc-stamp--add-csf-on-post-modify nil t)) |
| 872 | (erc--restore-initialize-priors erc-stamp-mode | 882 | (setq erc-stamp--csf-props-updated-p |
| 873 | erc-stamp--csf-props-updated-p nil) | 883 | (alist-get 'erc-stamp--csf-props-updated-p |
| 884 | (or erc--server-reconnecting erc--target-priors))) | ||
| 874 | (unless erc-stamp--csf-props-updated-p | 885 | (unless erc-stamp--csf-props-updated-p |
| 875 | (setq erc-stamp--csf-props-updated-p t) | 886 | (setq erc-stamp--csf-props-updated-p t) |
| 887 | ;; Spoof `erc--ts' as being non-nil. | ||
| 876 | (let ((erc--msg-props (map-into '((erc--ts . t)) 'hash-table))) | 888 | (let ((erc--msg-props (map-into '((erc--ts . t)) 'hash-table))) |
| 877 | (with-silent-modifications | 889 | (with-silent-modifications |
| 878 | (erc--traverse-inserted | 890 | (erc--traverse-inserted |
| @@ -902,9 +914,9 @@ Return the empty string if FORMAT is nil." | |||
| 902 | (defun erc-stamp--setup () | 914 | (defun erc-stamp--setup () |
| 903 | "Enable or disable buffer-local `erc-stamp-mode' modifications." | 915 | "Enable or disable buffer-local `erc-stamp-mode' modifications." |
| 904 | (if erc-stamp-mode | 916 | (if erc-stamp-mode |
| 905 | (erc-munge-invisibility-spec) | 917 | (erc-stamp--manage-local-options-state) |
| 906 | (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) | 918 | (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) |
| 907 | (erc-munge-invisibility-spec)) | 919 | (erc-stamp--manage-local-options-state)) |
| 908 | ;; Undo local mods from `erc-insert-timestamp-left-and-right'. | 920 | ;; Undo local mods from `erc-insert-timestamp-left-and-right'. |
| 909 | (erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left' | 921 | (erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left' |
| 910 | (kill-local-variable 'erc-stamp--last-stamp) | 922 | (kill-local-variable 'erc-stamp--last-stamp) |
| @@ -916,7 +928,7 @@ Return the empty string if FORMAT is nil." | |||
| 916 | "Hide timestamp information from display." | 928 | "Hide timestamp information from display." |
| 917 | (interactive) | 929 | (interactive) |
| 918 | (setq erc-hide-timestamps t) | 930 | (setq erc-hide-timestamps t) |
| 919 | (erc-munge-invisibility-spec)) | 931 | (erc-stamp--manage-local-options-state)) |
| 920 | 932 | ||
| 921 | (defun erc-show-timestamps () | 933 | (defun erc-show-timestamps () |
| 922 | "Show timestamp information on display. | 934 | "Show timestamp information on display. |
| @@ -924,7 +936,7 @@ This function only works if `erc-timestamp-format' was previously | |||
| 924 | set, and timestamping is already active." | 936 | set, and timestamping is already active." |
| 925 | (interactive) | 937 | (interactive) |
| 926 | (setq erc-hide-timestamps nil) | 938 | (setq erc-hide-timestamps nil) |
| 927 | (erc-munge-invisibility-spec)) | 939 | (erc-stamp--manage-local-options-state)) |
| 928 | 940 | ||
| 929 | (defun erc-toggle-timestamps () | 941 | (defun erc-toggle-timestamps () |
| 930 | "Hide or show timestamps in ERC buffers. | 942 | "Hide or show timestamps in ERC buffers. |
| @@ -938,7 +950,7 @@ enabled when the message was inserted." | |||
| 938 | (setq erc-hide-timestamps t)) | 950 | (setq erc-hide-timestamps t)) |
| 939 | (mapc (lambda (buffer) | 951 | (mapc (lambda (buffer) |
| 940 | (with-current-buffer buffer | 952 | (with-current-buffer buffer |
| 941 | (erc-munge-invisibility-spec))) | 953 | (erc-stamp--manage-local-options-state))) |
| 942 | (erc-buffer-list))) | 954 | (erc-buffer-list))) |
| 943 | 955 | ||
| 944 | (defvar-local erc-stamp--last-stamp nil) | 956 | (defvar-local erc-stamp--last-stamp nil) |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index edac1060c3e..cce3b2508fb 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -135,6 +135,13 @@ concerning buffers." | |||
| 135 | "Running scripts at startup and with /LOAD." | 135 | "Running scripts at startup and with /LOAD." |
| 136 | :group 'erc) | 136 | :group 'erc) |
| 137 | 137 | ||
| 138 | ;; Add `custom-loads' features for group symbols missing from a | ||
| 139 | ;; supported Emacs version, possibly because they belong to a new ERC | ||
| 140 | ;; library. These groups all share their library's feature name. | ||
| 141 | ;;;###autoload(dolist (symbol '( erc-sasl erc-spelling ; 29 | ||
| 142 | ;;;###autoload erc-imenu erc-nicks)) ; 30 | ||
| 143 | ;;;###autoload (custom-add-load symbol symbol)) | ||
| 144 | |||
| 138 | (defvar erc-message-parsed) ; only known to this file | 145 | (defvar erc-message-parsed) ; only known to this file |
| 139 | 146 | ||
| 140 | (defvar erc--msg-props nil | 147 | (defvar erc--msg-props nil |
| @@ -1531,7 +1538,7 @@ Bound to local variables from an existing (logical) session's | |||
| 1531 | buffer during local-module setup and `erc-mode-hook' activation.") | 1538 | buffer during local-module setup and `erc-mode-hook' activation.") |
| 1532 | 1539 | ||
| 1533 | (defmacro erc--restore-initialize-priors (mode &rest vars) | 1540 | (defmacro erc--restore-initialize-priors (mode &rest vars) |
| 1534 | "Restore local VARS for MODE from a previous session." | 1541 | "Restore local VARS for local minor MODE from a previous session." |
| 1535 | (declare (indent 1)) | 1542 | (declare (indent 1)) |
| 1536 | (let ((priors (make-symbol "priors")) | 1543 | (let ((priors (make-symbol "priors")) |
| 1537 | (initp (make-symbol "initp")) | 1544 | (initp (make-symbol "initp")) |
| @@ -1541,6 +1548,8 @@ buffer during local-module setup and `erc-mode-hook' activation.") | |||
| 1541 | (push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms)) | 1548 | (push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms)) |
| 1542 | `(let* ((,priors (or erc--server-reconnecting erc--target-priors)) | 1549 | `(let* ((,priors (or erc--server-reconnecting erc--target-priors)) |
| 1543 | (,initp (and ,priors (alist-get ',mode ,priors)))) | 1550 | (,initp (and ,priors (alist-get ',mode ,priors)))) |
| 1551 | (unless (local-variable-if-set-p ',mode) | ||
| 1552 | (error "Not a local minor mode var: %s" ',mode)) | ||
| 1544 | (setq ,@(mapcan #'identity (nreverse forms)))))) | 1553 | (setq ,@(mapcan #'identity (nreverse forms)))))) |
| 1545 | 1554 | ||
| 1546 | (defun erc--target-from-string (string) | 1555 | (defun erc--target-from-string (string) |
| @@ -1654,11 +1663,7 @@ If BUFFER is nil, the current buffer is used." | |||
| 1654 | (defun erc-query-buffer-p (&optional buffer) | 1663 | (defun erc-query-buffer-p (&optional buffer) |
| 1655 | "Return non-nil if BUFFER is an ERC query buffer. | 1664 | "Return non-nil if BUFFER is an ERC query buffer. |
| 1656 | If BUFFER is nil, the current buffer is used." | 1665 | If BUFFER is nil, the current buffer is used." |
| 1657 | (with-current-buffer (or buffer (current-buffer)) | 1666 | (not (erc-channel-p (or buffer (current-buffer))))) |
| 1658 | (let ((target (erc-target))) | ||
| 1659 | (and (eq major-mode 'erc-mode) | ||
| 1660 | target | ||
| 1661 | (not (memq (aref target 0) '(?# ?& ?+ ?!))))))) | ||
| 1662 | 1667 | ||
| 1663 | (defun erc-ison-p (nick) | 1668 | (defun erc-ison-p (nick) |
| 1664 | "Return non-nil if NICK is online." | 1669 | "Return non-nil if NICK is online." |
| @@ -1873,18 +1878,20 @@ buries those." | |||
| 1873 | :group 'erc-buffers | 1878 | :group 'erc-buffers |
| 1874 | :type 'boolean) | 1879 | :type 'boolean) |
| 1875 | 1880 | ||
| 1876 | (defun erc-channel-p (channel) | 1881 | (defvar erc--fallback-channel-prefixes "#&" |
| 1877 | "Return non-nil if CHANNEL seems to be an IRC channel name." | 1882 | "Prefix chars for distinguishing channel targets when CHANTYPES is unknown.") |
| 1878 | (cond ((stringp channel) | 1883 | |
| 1879 | (memq (aref channel 0) | 1884 | (defun erc-channel-p (target) |
| 1880 | (if-let ((types (erc--get-isupport-entry 'CHANTYPES 'single))) | 1885 | "Return non-nil if TARGET is a valid channel name or a channel buffer." |
| 1881 | (append types nil) | 1886 | (cond ((stringp target) |
| 1882 | '(?# ?& ?+ ?!)))) | 1887 | (and-let* |
| 1883 | ((and-let* (((bufferp channel)) | 1888 | (((not (string-empty-p target))) |
| 1884 | ((buffer-live-p channel)) | 1889 | (value (let ((entry (erc--get-isupport-entry 'CHANTYPES))) |
| 1885 | (target (buffer-local-value 'erc--target channel))) | 1890 | (if entry (cadr entry) erc--fallback-channel-prefixes))) |
| 1886 | (erc-channel-p (erc--target-string target)))) | 1891 | ((erc--strpos (aref target 0) value))))) |
| 1887 | (t nil))) | 1892 | ((and-let* (((buffer-live-p target)) |
| 1893 | (target (buffer-local-value 'erc--target target)) | ||
| 1894 | ((erc--target-channel-p target))))))) | ||
| 1888 | 1895 | ||
| 1889 | ;; For the sake of compatibility, a historical quirk concerning this | 1896 | ;; For the sake of compatibility, a historical quirk concerning this |
| 1890 | ;; option, when nil, has been preserved: all buffers are suffixed with | 1897 | ;; option, when nil, has been preserved: all buffers are suffixed with |
| @@ -2183,13 +2190,17 @@ buffer rather than a server buffer.") | |||
| 2183 | (cl-pushnew mod (if (get mod 'erc--module) built-in third-party))) | 2190 | (cl-pushnew mod (if (get mod 'erc--module) built-in third-party))) |
| 2184 | `(,@(sort built-in #'string-lessp) ,@(nreverse third-party)))) | 2191 | `(,@(sort built-in #'string-lessp) ,@(nreverse third-party)))) |
| 2185 | 2192 | ||
| 2193 | ;;;###autoload(custom-autoload 'erc-modules "erc") | ||
| 2194 | |||
| 2186 | (defcustom erc-modules '( autojoin button completion fill imenu irccontrols | 2195 | (defcustom erc-modules '( autojoin button completion fill imenu irccontrols |
| 2187 | list match menu move-to-prompt netsplit | 2196 | list match menu move-to-prompt netsplit |
| 2188 | networks readonly ring stamp track) | 2197 | networks readonly ring stamp track) |
| 2189 | "A list of modules which ERC should enable. | 2198 | "Modules to enable while connecting. |
| 2190 | If you set the value of this without using `customize' remember to call | 2199 | When modifying this option in lisp code, use a Custom-friendly |
| 2191 | \(erc-update-modules) after you change it. When using `customize', modules | 2200 | facilitator, like `setopt', or call `erc-update-modules' |
| 2192 | removed from the list will be disabled." | 2201 | afterward. This ensures a consistent ordering and disables |
| 2202 | removed modules. It also gives packages access to the hook | ||
| 2203 | `erc-before-connect'." | ||
| 2193 | :get (lambda (sym) | 2204 | :get (lambda (sym) |
| 2194 | ;; replace outdated names with their newer equivalents | 2205 | ;; replace outdated names with their newer equivalents |
| 2195 | (erc-migrate-modules (symbol-value sym))) | 2206 | (erc-migrate-modules (symbol-value sym))) |
| @@ -2473,29 +2484,22 @@ nil." | |||
| 2473 | (cl-assert (= (point) (point-max))))) | 2484 | (cl-assert (= (point) (point-max))))) |
| 2474 | 2485 | ||
| 2475 | (defun erc-open (&optional server port nick full-name | 2486 | (defun erc-open (&optional server port nick full-name |
| 2476 | connect passwd tgt-list channel process | 2487 | connect passwd _tgt-list channel process |
| 2477 | client-certificate user id) | 2488 | client-certificate user id) |
| 2478 | "Connect to SERVER on PORT as NICK with USER and FULL-NAME. | 2489 | "Return a new or reinitialized server or target buffer. |
| 2479 | 2490 | If CONNECT is non-nil, connect to SERVER and return its new or | |
| 2480 | If CONNECT is non-nil, connect to the server. Otherwise assume | 2491 | reassociated buffer. Otherwise, assume PROCESS is non-nil and belongs |
| 2481 | already connected and just create a separate buffer for the new | 2492 | to an active session, and return a new or refurbished target buffer for |
| 2482 | target given by CHANNEL, meaning these parameters are mutually | 2493 | CHANNEL, which may also be a query target (the parameter name remains |
| 2483 | exclusive. Note that CHANNEL may also be a query; its name has | 2494 | for historical reasons). Pass SERVER, PORT, NICK, USER, FULL-NAME, and |
| 2484 | been retained for historical reasons. | 2495 | PASSWD to `erc-determine-parameters' for preserving as session-local |
| 2485 | 2496 | variables. Do something similar for CLIENT-CERTIFICATE and ID, which | |
| 2486 | Use PASSWD as user password on the server. If TGT-LIST is | 2497 | should be as described by `erc-tls'. |
| 2487 | non-nil, use it to initialize `erc-default-recipients'. | 2498 | |
| 2488 | 2499 | Note that ERC ignores TGT-LIST and initializes `erc-default-recipients' | |
| 2489 | CLIENT-CERTIFICATE, if non-nil, should either be a list where the | 2500 | with CHANNEL as its only member. Note also that this function has the |
| 2490 | first element is the file name of the private key corresponding | 2501 | side effect of setting the current buffer to the one it returns. Use |
| 2491 | to a client certificate and the second element is the file name | 2502 | `with-current-buffer' or `save-excursion' to nullify this effect." |
| 2492 | of the client certificate itself to use when connecting over TLS, | ||
| 2493 | or t, which means that `auth-source' will be queried for the | ||
| 2494 | private key and the certificate. | ||
| 2495 | |||
| 2496 | When non-nil, ID should be a symbol for identifying the connection. | ||
| 2497 | |||
| 2498 | Returns the buffer for the given server or channel." | ||
| 2499 | (let* ((target (and channel (erc--target-from-string channel))) | 2503 | (let* ((target (and channel (erc--target-from-string channel))) |
| 2500 | (buffer (erc-get-buffer-create server port nil target id)) | 2504 | (buffer (erc-get-buffer-create server port nil target id)) |
| 2501 | (old-buffer (current-buffer)) | 2505 | (old-buffer (current-buffer)) |
| @@ -2532,7 +2536,7 @@ Returns the buffer for the given server or channel." | |||
| 2532 | ;; connection parameters | 2536 | ;; connection parameters |
| 2533 | (setq erc-server-process process) | 2537 | (setq erc-server-process process) |
| 2534 | ;; stack of default recipients | 2538 | ;; stack of default recipients |
| 2535 | (setq erc-default-recipients tgt-list) | 2539 | (when channel (setq erc-default-recipients (list channel))) |
| 2536 | (when target | 2540 | (when target |
| 2537 | (setq erc--target target | 2541 | (setq erc--target target |
| 2538 | erc-network (erc-network))) | 2542 | erc-network (erc-network))) |
| @@ -2768,8 +2772,9 @@ PORT, NICK, and PASSWORD, along with USER and FULL-NAME when | |||
| 2768 | given a prefix argument. Non-interactively, expect the rarely | 2772 | given a prefix argument. Non-interactively, expect the rarely |
| 2769 | needed ID parameter, when non-nil, to be a symbol or a string for | 2773 | needed ID parameter, when non-nil, to be a symbol or a string for |
| 2770 | naming the server buffer and identifying the connection | 2774 | naming the server buffer and identifying the connection |
| 2771 | unequivocally. (See Info node `(erc) Connecting' for details | 2775 | unequivocally. Once connected, return the server buffer. (See |
| 2772 | about all mentioned parameters.) | 2776 | Info node `(erc) Connecting' for details about all mentioned |
| 2777 | parameters.) | ||
| 2773 | 2778 | ||
| 2774 | Together with `erc-tls', this command serves as the main entry | 2779 | Together with `erc-tls', this command serves as the main entry |
| 2775 | point for ERC, the powerful, modular, and extensible IRC client. | 2780 | point for ERC, the powerful, modular, and extensible IRC client. |
| @@ -3828,14 +3833,14 @@ TYPE, when non-nil, to be a symbol handled by | |||
| 3828 | string MSG). Expect BUFFER to be among the sort accepted by the | 3833 | string MSG). Expect BUFFER to be among the sort accepted by the |
| 3829 | function `erc-display-line'. | 3834 | function `erc-display-line'. |
| 3830 | 3835 | ||
| 3831 | Expect BUFFER to be a live `erc-mode' buffer, a list of such | 3836 | When non-nil, expect BUFFER to be a live `erc-mode' buffer, a |
| 3832 | buffers, or the symbols `all' or `active'. If `all', insert | 3837 | list of such buffers, or the symbols `all' or `active'. If |
| 3833 | STRING in all buffers for the current session. If `active', | 3838 | `all', insert STRING in all buffers for the current session. If |
| 3834 | defer to the function `erc-active-buffer', which may return the | 3839 | `active', defer to the function `erc-active-buffer', which may |
| 3835 | session's server buffer if the previously active buffer has been | 3840 | return the session's server buffer if the previously active |
| 3836 | killed. If BUFFER is nil or a network process, pretend it's set | 3841 | buffer has been killed. If BUFFER is nil or a network process, |
| 3837 | to the appropriate server buffer. Otherwise, use the current | 3842 | pretend it's set to the appropriate server buffer. Otherwise, |
| 3838 | buffer. | 3843 | use the current buffer. |
| 3839 | 3844 | ||
| 3840 | When TYPE is a list of symbols, call handlers from left to right | 3845 | When TYPE is a list of symbols, call handlers from left to right |
| 3841 | without influencing how they behave when encountering existing | 3846 | without influencing how they behave when encountering existing |
| @@ -3848,11 +3853,10 @@ being (erc-error-face erc-notice-face) throughout MSG when | |||
| 3848 | `erc-notice-highlight-type' is left at its default, `all'. | 3853 | `erc-notice-highlight-type' is left at its default, `all'. |
| 3849 | 3854 | ||
| 3850 | As of ERC 5.6, assume third-party code will use this function | 3855 | As of ERC 5.6, assume third-party code will use this function |
| 3851 | instead of lower-level ones, like `erc-insert-line', when needing | 3856 | instead of lower-level ones, like `erc-insert-line', to insert |
| 3852 | ERC to process arbitrary informative messages as if they'd been | 3857 | arbitrary informative messages as if sent by the server. That |
| 3853 | sent from a server. That is, guarantee \"local\" messages, for | 3858 | is, tell modules to treat a \"local\" message for which PARSED is |
| 3854 | which PARSED is typically nil, will be subject to buttonizing, | 3859 | nil like any other server-sent message." |
| 3855 | filling, and other effects." | ||
| 3856 | (let* ((erc--msg-props | 3860 | (let* ((erc--msg-props |
| 3857 | (or erc--msg-props | 3861 | (or erc--msg-props |
| 3858 | (let ((table (make-hash-table)) | 3862 | (let ((table (make-hash-table)) |
| @@ -4042,16 +4046,42 @@ this function from interpreting the line as a command." | |||
| 4042 | ;; Input commands handlers | 4046 | ;; Input commands handlers |
| 4043 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 4047 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4044 | 4048 | ||
| 4045 | (defun erc-cmd-AMSG (line) | 4049 | (defun erc--connected-and-joined-p () |
| 4046 | "Send LINE to all channels of the current server that you are on." | 4050 | (and (erc--current-buffer-joined-p) |
| 4047 | (interactive "sSend to all channels you're on: ") | 4051 | erc-server-connected)) |
| 4048 | (setq line (erc-trim-string line)) | 4052 | |
| 4053 | (defun erc-cmd-GMSG (line) | ||
| 4054 | "Send LINE to all channels on all networks you are on." | ||
| 4055 | (setq line (string-remove-prefix " " line)) | ||
| 4049 | (erc-with-all-buffers-of-server nil | 4056 | (erc-with-all-buffers-of-server nil |
| 4050 | (lambda () | 4057 | #'erc--connected-and-joined-p |
| 4051 | (erc-channel-p (erc-default-target))) | 4058 | (erc-send-message line))) |
| 4059 | (put 'erc-cmd-GMSG 'do-not-parse-args t) | ||
| 4060 | |||
| 4061 | (defun erc-cmd-AMSG (line) | ||
| 4062 | "Send LINE to all channels of the current network. | ||
| 4063 | Interactively, prompt for the line of text to send." | ||
| 4064 | (interactive "sSend to all channels on this network: ") | ||
| 4065 | (setq line (string-remove-prefix " " line)) | ||
| 4066 | (erc-with-all-buffers-of-server erc-server-process | ||
| 4067 | #'erc--connected-and-joined-p | ||
| 4052 | (erc-send-message line))) | 4068 | (erc-send-message line))) |
| 4053 | (put 'erc-cmd-AMSG 'do-not-parse-args t) | 4069 | (put 'erc-cmd-AMSG 'do-not-parse-args t) |
| 4054 | 4070 | ||
| 4071 | (defun erc-cmd-GME (line) | ||
| 4072 | "Send LINE as an action to all channels on all networks you are on." | ||
| 4073 | (erc-with-all-buffers-of-server nil | ||
| 4074 | #'erc--connected-and-joined-p | ||
| 4075 | (erc-cmd-ME line))) | ||
| 4076 | (put 'erc-cmd-GME 'do-not-parse-args t) | ||
| 4077 | |||
| 4078 | (defun erc-cmd-AME (line) | ||
| 4079 | "Send LINE as an action to all channels on the current network." | ||
| 4080 | (erc-with-all-buffers-of-server erc-server-process | ||
| 4081 | #'erc--connected-and-joined-p | ||
| 4082 | (erc-cmd-ME line))) | ||
| 4083 | (put 'erc-cmd-AME 'do-not-parse-args t) | ||
| 4084 | |||
| 4055 | (defun erc-cmd-SAY (line) | 4085 | (defun erc-cmd-SAY (line) |
| 4056 | "Send LINE to the current query or channel as a message, not a command. | 4086 | "Send LINE to the current query or channel as a message, not a command. |
| 4057 | 4087 | ||
| @@ -6810,7 +6840,7 @@ stand-in from the fallback value \"(qaohv)~&@%+\"." | |||
| 6810 | "Return numeric rank for CHAR or nil if unknown. | 6840 | "Return numeric rank for CHAR or nil if unknown. |
| 6811 | For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h, | 6841 | For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h, |
| 6812 | and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a | 6842 | and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a |
| 6813 | `erc--parse-prefix' object. With FROM-PREFIX-P, expect CHAR to | 6843 | `erc--parsed-prefix' object. With FROM-PREFIX-P, expect CHAR to |
| 6814 | be a prefix instead." | 6844 | be a prefix instead." |
| 6815 | (and-let* ((obj (or parsed-prefix (erc--parsed-prefix))) | 6845 | (and-let* ((obj (or parsed-prefix (erc--parsed-prefix))) |
| 6816 | (pos (erc--strpos char (if from-prefix-p | 6846 | (pos (erc--strpos char (if from-prefix-p |
| @@ -9487,6 +9517,7 @@ guarantee that the input method functions properly for the | |||
| 9487 | purpose of typing within the ERC prompt." | 9517 | purpose of typing within the ERC prompt." |
| 9488 | (when (and (eq major-mode 'erc-mode) | 9518 | (when (and (eq major-mode 'erc-mode) |
| 9489 | (fboundp 'set-text-conversion-style)) | 9519 | (fboundp 'set-text-conversion-style)) |
| 9520 | (defvar text-conversion-style) ; avoid free variable warning on <=29 | ||
| 9490 | (if (>= (point) (erc-beg-of-input-line)) | 9521 | (if (>= (point) (erc-beg-of-input-line)) |
| 9491 | (unless (eq text-conversion-style 'action) | 9522 | (unless (eq text-conversion-style 'action) |
| 9492 | (set-text-conversion-style 'action)) | 9523 | (set-text-conversion-style 'action)) |
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index c3c3fea691a..23028576f45 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el | |||
| @@ -590,7 +590,7 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. | |||
| 590 | :external "cp" | 590 | :external "cp" |
| 591 | :show-usage | 591 | :show-usage |
| 592 | :usage "[OPTION]... SOURCE DEST | 592 | :usage "[OPTION]... SOURCE DEST |
| 593 | or: cp [OPTION]... SOURCE... DIRECTORY | 593 | or: cp [OPTION]... SOURCE... DIRECTORY |
| 594 | Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") | 594 | Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") |
| 595 | (if archive | 595 | (if archive |
| 596 | (setq preserve t no-dereference t em-recursive t)) | 596 | (setq preserve t no-dereference t em-recursive t)) |
| @@ -618,11 +618,11 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") | |||
| 618 | :preserve-args | 618 | :preserve-args |
| 619 | :external "ln" | 619 | :external "ln" |
| 620 | :show-usage | 620 | :show-usage |
| 621 | :usage "[OPTION]... TARGET [LINK_NAME] | 621 | :usage "[OPTION]... TARGET LINK_NAME |
| 622 | or: ln [OPTION]... TARGET... DIRECTORY | 622 | or: ln [OPTION]... TARGET... DIRECTORY |
| 623 | Create a link to the specified TARGET with optional LINK_NAME. If there is | 623 | Create a link to the specified TARGET with LINK_NAME. If there is more |
| 624 | more than one TARGET, the last argument must be a directory; create links | 624 | than one TARGET, the last argument must be a directory; create links in |
| 625 | in DIRECTORY to each TARGET. Create hard links by default, symbolic links | 625 | DIRECTORY to each TARGET. Create hard links by default, symbolic links |
| 626 | with `--symbolic'. When creating hard links, each TARGET must exist.") | 626 | with `--symbolic'. When creating hard links, each TARGET must exist.") |
| 627 | (let ((no-dereference t)) | 627 | (let ((no-dereference t)) |
| 628 | (eshell-mvcpln-template "ln" "linking" | 628 | (eshell-mvcpln-template "ln" "linking" |
| @@ -940,7 +940,7 @@ external command." | |||
| 940 | "display data only this many levels of data") | 940 | "display data only this many levels of data") |
| 941 | (?h "human-readable" 1024 human-readable | 941 | (?h "human-readable" 1024 human-readable |
| 942 | "print sizes in human readable format") | 942 | "print sizes in human readable format") |
| 943 | (?H "is" 1000 human-readable | 943 | (?H "si" 1000 human-readable |
| 944 | "likewise, but use powers of 1000 not 1024") | 944 | "likewise, but use powers of 1000 not 1024") |
| 945 | (?k "kilobytes" 1024 block-size | 945 | (?k "kilobytes" 1024 block-size |
| 946 | "like --block-size 1024") | 946 | "like --block-size 1024") |
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 97ddac58629..78cf28d785a 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el | |||
| @@ -285,7 +285,7 @@ QUOTED is passed to `eshell-concat' (which see) and, if non-nil, | |||
| 285 | allows values to be converted to numbers where appropriate. | 285 | allows values to be converted to numbers where appropriate. |
| 286 | 286 | ||
| 287 | ARGS should be a list of lists of arguments, such as that | 287 | ARGS should be a list of lists of arguments, such as that |
| 288 | produced by `eshell-prepare-slice'. \"Adjacent\" values of | 288 | produced by `eshell-prepare-splice'. \"Adjacent\" values of |
| 289 | consecutive arguments will be passed to `eshell-concat'. For | 289 | consecutive arguments will be passed to `eshell-concat'. For |
| 290 | example, if ARGS is | 290 | example, if ARGS is |
| 291 | 291 | ||
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index dc2b93e574b..44861c222b8 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el | |||
| @@ -253,10 +253,10 @@ An external command simply means external to Emacs." | |||
| 253 | "Add a set of paths to PATH." | 253 | "Add a set of paths to PATH." |
| 254 | (eshell-eval-using-options | 254 | (eshell-eval-using-options |
| 255 | "addpath" args | 255 | "addpath" args |
| 256 | '((?b "begin" nil prepend "add path element at beginning") | 256 | '((?b "begin" nil prepend "add to beginning of $PATH") |
| 257 | (?h "help" nil nil "display this usage message") | 257 | (?h "help" nil nil "display this usage message") |
| 258 | :usage "[-b] PATH | 258 | :usage "[-b] DIR... |
| 259 | Adds the given PATH to $PATH.") | 259 | Adds the given DIR to $PATH.") |
| 260 | (let ((path (eshell-get-path t))) | 260 | (let ((path (eshell-get-path t))) |
| 261 | (if args | 261 | (if args |
| 262 | (progn | 262 | (progn |
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index fd279f61673..b15f99a0359 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el | |||
| @@ -290,7 +290,7 @@ non-interactive sessions, such as when using `eshell-command'.") | |||
| 290 | "C-e" #'eshell-show-maximum-output | 290 | "C-e" #'eshell-show-maximum-output |
| 291 | "C-f" #'eshell-forward-argument | 291 | "C-f" #'eshell-forward-argument |
| 292 | "C-m" #'eshell-copy-old-input | 292 | "C-m" #'eshell-copy-old-input |
| 293 | "C-o" #'eshell-kill-output | 293 | "C-o" #'eshell-delete-output |
| 294 | "C-r" #'eshell-show-output | 294 | "C-r" #'eshell-show-output |
| 295 | "C-t" #'eshell-truncate-buffer | 295 | "C-t" #'eshell-truncate-buffer |
| 296 | "C-u" #'eshell-kill-input | 296 | "C-u" #'eshell-kill-input |
| @@ -832,15 +832,23 @@ This function should be in the list `eshell-output-filter-functions'." | |||
| 832 | eshell-last-output-start | 832 | eshell-last-output-start |
| 833 | eshell-last-output-end)) | 833 | eshell-last-output-end)) |
| 834 | 834 | ||
| 835 | (defun eshell-kill-output () | 835 | (defun eshell-delete-output (&optional kill) |
| 836 | "Kill all output from interpreter since last input. | 836 | "Delete all output from interpreter since last input. |
| 837 | Does not delete the prompt." | 837 | If KILL is non-nil (interactively, the prefix), save the killed text in |
| 838 | (interactive) | 838 | the kill ring. |
| 839 | |||
| 840 | This command does not delete the prompt." | ||
| 841 | (interactive "P") | ||
| 839 | (save-excursion | 842 | (save-excursion |
| 840 | (goto-char (eshell-beginning-of-output)) | 843 | (goto-char (eshell-beginning-of-output)) |
| 841 | (insert "*** output flushed ***\n") | 844 | (insert "*** output flushed ***\n") |
| 845 | (when kill | ||
| 846 | (copy-region-as-kill (point) (eshell-end-of-output))) | ||
| 842 | (delete-region (point) (eshell-end-of-output)))) | 847 | (delete-region (point) (eshell-end-of-output)))) |
| 843 | 848 | ||
| 849 | (define-obsolete-function-alias 'eshell-kill-output | ||
| 850 | #'eshell-delete-output "30.1") | ||
| 851 | |||
| 844 | (defun eshell-show-output (&optional arg) | 852 | (defun eshell-show-output (&optional arg) |
| 845 | "Display start of this batch of interpreter output at top of window. | 853 | "Display start of this batch of interpreter output at top of window. |
| 846 | Sets mark to the value of point when this command is run. | 854 | Sets mark to the value of point when this command is run. |
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index d01e3569d57..e6f5fc9629a 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el | |||
| @@ -100,29 +100,37 @@ the new process for its value. | |||
| 100 | Lastly, any remaining arguments will be available in the locally | 100 | Lastly, any remaining arguments will be available in the locally |
| 101 | let-bound variable `args'." | 101 | let-bound variable `args'." |
| 102 | (declare (debug (form form sexp body))) | 102 | (declare (debug (form form sexp body))) |
| 103 | `(let* ((temp-args | 103 | (let ((option-syms (eshell--get-option-symbols |
| 104 | ,(if (memq ':preserve-args (cadr options)) | 104 | ;; `options' is of the form (quote OPTS). |
| 105 | (list 'copy-tree macro-args) | 105 | (cadr options)))) |
| 106 | (list 'eshell-stringify-list | 106 | `(let* ((temp-args |
| 107 | (list 'flatten-tree macro-args)))) | 107 | ,(if (memq ':preserve-args (cadr options)) |
| 108 | (processed-args (eshell--do-opts ,name ,options temp-args ,macro-args)) | 108 | (list 'copy-tree macro-args) |
| 109 | ,@(delete-dups | 109 | (list 'eshell-stringify-list |
| 110 | (delq nil (mapcar (lambda (opt) | 110 | (list 'flatten-tree macro-args)))) |
| 111 | (and (listp opt) (nth 3 opt) | 111 | (args (eshell--do-opts ,name temp-args ,macro-args |
| 112 | `(,(nth 3 opt) (pop processed-args)))) | 112 | ,options ',option-syms)) |
| 113 | ;; `options' is of the form (quote OPTS). | 113 | ;; Bind all the option variables. When done, `args' will |
| 114 | (cadr options)))) | 114 | ;; contain any remaining positional arguments. |
| 115 | (args processed-args)) | 115 | ,@(mapcar (lambda (sym) `(,sym (pop args))) option-syms)) |
| 116 | ;; Silence unused lexical variable warning if body does not use `args'. | 116 | ;; Silence unused lexical variable warning if body does not use `args'. |
| 117 | (ignore args) | 117 | (ignore args) |
| 118 | ,@body-forms)) | 118 | ,@body-forms))) |
| 119 | 119 | ||
| 120 | ;;; Internal Functions: | 120 | ;;; Internal Functions: |
| 121 | 121 | ||
| 122 | ;; Documented part of the interface; see eshell-eval-using-options. | 122 | ;; Documented part of the interface; see eshell-eval-using-options. |
| 123 | (defvar eshell--args) | 123 | (defvar eshell--args) |
| 124 | 124 | ||
| 125 | (defun eshell--do-opts (name options args orig-args) | 125 | (defun eshell--get-option-symbols (options) |
| 126 | "Get a list of symbols for the specified OPTIONS. | ||
| 127 | OPTIONS is a list of command-line options from | ||
| 128 | `eshell-eval-using-options' (which see)." | ||
| 129 | (delete-dups | ||
| 130 | (delq nil (mapcar (lambda (opt) (and (listp opt) (nth 3 opt))) | ||
| 131 | options)))) | ||
| 132 | |||
| 133 | (defun eshell--do-opts (name args orig-args options option-syms) | ||
| 126 | "Helper function for `eshell-eval-using-options'. | 134 | "Helper function for `eshell-eval-using-options'. |
| 127 | This code doesn't really need to be macro expanded everywhere." | 135 | This code doesn't really need to be macro expanded everywhere." |
| 128 | (require 'esh-ext) | 136 | (require 'esh-ext) |
| @@ -134,7 +142,8 @@ This code doesn't really need to be macro expanded everywhere." | |||
| 134 | (if (and (= (length args) 0) | 142 | (if (and (= (length args) 0) |
| 135 | (memq ':show-usage options)) | 143 | (memq ':show-usage options)) |
| 136 | (eshell-show-usage name options) | 144 | (eshell-show-usage name options) |
| 137 | (setq args (eshell--process-args name args options)) | 145 | (setq args (eshell--process-args name args options |
| 146 | option-syms)) | ||
| 138 | nil)))) | 147 | nil)))) |
| 139 | (when usage-msg | 148 | (when usage-msg |
| 140 | (user-error "%s" usage-msg)))))) | 149 | (user-error "%s" usage-msg)))))) |
| @@ -269,16 +278,13 @@ triggered to say that the switch is unrecognized." | |||
| 269 | "%s: unrecognized option --%s") | 278 | "%s: unrecognized option --%s") |
| 270 | name (car switch))))))) | 279 | name (car switch))))))) |
| 271 | 280 | ||
| 272 | (defun eshell--process-args (name args options) | 281 | (defun eshell--process-args (name args options option-syms) |
| 273 | "Process the given ARGS using OPTIONS." | 282 | "Process the given ARGS for the command NAME using OPTIONS. |
| 274 | (let* ((seen ()) | 283 | OPTION-SYMS is a list of symbols that will hold the processed arguments. |
| 275 | (opt-vals (delq nil (mapcar (lambda (opt) | 284 | |
| 276 | (when (listp opt) | 285 | Return a list of values corresponding to each element in OPTION-SYMS, |
| 277 | (let ((sym (nth 3 opt))) | 286 | followed by any additional positional arguments." |
| 278 | (when (and sym (not (memq sym seen))) | 287 | (let* ((opt-vals (mapcar #'list option-syms)) |
| 279 | (push sym seen) | ||
| 280 | (list sym))))) | ||
| 281 | options))) | ||
| 282 | (ai 0) arg | 288 | (ai 0) arg |
| 283 | (eshell--args args) | 289 | (eshell--args args) |
| 284 | (pos-argument-found nil)) | 290 | (pos-argument-found nil)) |
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 537bc4b0641..02b5c785625 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el | |||
| @@ -433,7 +433,7 @@ the values of nil for each." | |||
| 433 | (?h "help" nil nil "show this usage screen") | 433 | (?h "help" nil nil "show this usage screen") |
| 434 | :external "env" | 434 | :external "env" |
| 435 | :parse-leading-options-only | 435 | :parse-leading-options-only |
| 436 | :usage "[NAME=VALUE]... [COMMAND [ARG]...]") | 436 | :usage "[NAME=VALUE]... [COMMAND]...") |
| 437 | (if args | 437 | (if args |
| 438 | (or (eshell-parse-local-variables args) | 438 | (or (eshell-parse-local-variables args) |
| 439 | (eshell-named-command (car args) (cdr args))) | 439 | (eshell-named-command (car args) (cdr args))) |
diff --git a/lisp/faces.el b/lisp/faces.el index d5120f42b92..c3a54a08a3d 100644 --- a/lisp/faces.el +++ b/lisp/faces.el | |||
| @@ -651,11 +651,11 @@ Optional argument INHERIT is passed to `face-attribute'." | |||
| 651 | If FACE is a face-alias, get the documentation for the target face." | 651 | If FACE is a face-alias, get the documentation for the target face." |
| 652 | (let ((alias (get face 'face-alias))) | 652 | (let ((alias (get face 'face-alias))) |
| 653 | (if alias | 653 | (if alias |
| 654 | (let ((doc (get alias 'face-documentation))) | 654 | (let ((doc (documentation-property alias 'face-documentation))) |
| 655 | (format "%s is an alias for the face `%s'.%s" face alias | 655 | (format "%s is an alias for the face `%s'.%s" face alias |
| 656 | (if doc (format "\n%s" doc) | 656 | (if doc (format "\n%s" doc) |
| 657 | ""))) | 657 | ""))) |
| 658 | (get face 'face-documentation)))) | 658 | (documentation-property face 'face-documentation)))) |
| 659 | 659 | ||
| 660 | 660 | ||
| 661 | (defun set-face-documentation (face string) | 661 | (defun set-face-documentation (face string) |
diff --git a/lisp/ffap.el b/lisp/ffap.el index 3492dcbf17a..5383f743878 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el | |||
| @@ -1098,12 +1098,12 @@ Suppose the cursor is somewhere that might be near end of file, | |||
| 1098 | the guessing would position point before punctuation (like comma) | 1098 | the guessing would position point before punctuation (like comma) |
| 1099 | after the file extension: | 1099 | after the file extension: |
| 1100 | 1100 | ||
| 1101 | C:\temp\file.log, which contain .... | 1101 | C:\\temp\\file.log, which contain .... |
| 1102 | =============================== (before) | 1102 | =============================== (before) |
| 1103 | ---------------- (after) | 1103 | ---------------- (after) |
| 1104 | 1104 | ||
| 1105 | 1105 | ||
| 1106 | C:\temp\file.log on Windows or /tmp/file.log on Unix | 1106 | C:\\temp\\file.log on Windows or /tmp/file.log on Unix |
| 1107 | =============================== (before) | 1107 | =============================== (before) |
| 1108 | ---------------- (after) | 1108 | ---------------- (after) |
| 1109 | 1109 | ||
diff --git a/lisp/files.el b/lisp/files.el index 9c8914bfc50..524385edc84 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -2747,6 +2747,10 @@ Fifth arg NOMODES non-nil means don't alter the file's modes. | |||
| 2747 | Finishes by calling the functions in `find-file-hook' | 2747 | Finishes by calling the functions in `find-file-hook' |
| 2748 | unless NOMODES is non-nil." | 2748 | unless NOMODES is non-nil." |
| 2749 | (setq buffer-read-only (not (file-writable-p buffer-file-name))) | 2749 | (setq buffer-read-only (not (file-writable-p buffer-file-name))) |
| 2750 | ;; The above is sufficiently like turning on read-only-mode, so run | ||
| 2751 | ;; the mode hook here by hand. | ||
| 2752 | (if buffer-read-only | ||
| 2753 | (run-hooks 'read-only-mode-hook)) | ||
| 2750 | (if noninteractive | 2754 | (if noninteractive |
| 2751 | nil | 2755 | nil |
| 2752 | (let* (not-serious | 2756 | (let* (not-serious |
| @@ -3270,7 +3274,16 @@ and `inhibit-local-variables-suffixes'. If | |||
| 3270 | ;; Optional group 1: env(1) invocation. | 3274 | ;; Optional group 1: env(1) invocation. |
| 3271 | "\\(" | 3275 | "\\(" |
| 3272 | "[^ \t\n]*/bin/env[ \t]*" | 3276 | "[^ \t\n]*/bin/env[ \t]*" |
| 3273 | "\\(?:-S[ \t]*\\|--split-string\\(?:=\\|[ \t]*\\)\\)?" | 3277 | ;; Within group 1: possible -S/--split-string and environment |
| 3278 | ;; adjustments. | ||
| 3279 | "\\(?:" | ||
| 3280 | ;; -S/--split-string | ||
| 3281 | "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)" | ||
| 3282 | ;; More env arguments. | ||
| 3283 | "\\(?:-[^ \t\n]+[ \t]+\\)*" | ||
| 3284 | ;; Interpreter environment modifications. | ||
| 3285 | "\\(?:[^ \t\n]+=[^ \t\n]*[ \t]+\\)*" | ||
| 3286 | "\\)?" | ||
| 3274 | "\\)?" | 3287 | "\\)?" |
| 3275 | ;; Group 2: interpreter. | 3288 | ;; Group 2: interpreter. |
| 3276 | "\\([^ \t\n]+\\)")) | 3289 | "\\([^ \t\n]+\\)")) |
| @@ -3754,7 +3767,8 @@ function is allowed to change the contents of this alist. | |||
| 3754 | This hook is called only if there is at least one file-local | 3767 | This hook is called only if there is at least one file-local |
| 3755 | variable to set.") | 3768 | variable to set.") |
| 3756 | 3769 | ||
| 3757 | (defvar permanently-enabled-local-variables '(lexical-binding) | 3770 | (defvar permanently-enabled-local-variables |
| 3771 | '(lexical-binding read-symbol-shorthands) | ||
| 3758 | "A list of file-local variables that are always enabled. | 3772 | "A list of file-local variables that are always enabled. |
| 3759 | This overrides any `enable-local-variables' setting.") | 3773 | This overrides any `enable-local-variables' setting.") |
| 3760 | 3774 | ||
| @@ -4190,6 +4204,13 @@ major-mode." | |||
| 4190 | ;; to use 'thisbuf's name in the | 4204 | ;; to use 'thisbuf's name in the |
| 4191 | ;; warning message. | 4205 | ;; warning message. |
| 4192 | (or (buffer-file-name thisbuf) "")))))) | 4206 | (or (buffer-file-name thisbuf) "")))))) |
| 4207 | ((eq var 'read-symbol-shorthands) | ||
| 4208 | ;; Sort automatically by shorthand length | ||
| 4209 | ;; in descending order. | ||
| 4210 | (setq val (sort val | ||
| 4211 | (lambda (sh1 sh2) (> (length (car sh1)) | ||
| 4212 | (length (car sh2)))))) | ||
| 4213 | (push (cons 'read-symbol-shorthands val) result)) | ||
| 4193 | ((and (eq var 'mode) handle-mode)) | 4214 | ((and (eq var 'mode) handle-mode)) |
| 4194 | (t | 4215 | (t |
| 4195 | (ignore-errors | 4216 | (ignore-errors |
diff --git a/lisp/filesets.el b/lisp/filesets.el index 4e2de8fed1b..68133ba2255 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el | |||
| @@ -161,18 +161,9 @@ COND-FN takes one argument: the current element." | |||
| 161 | (define-obsolete-function-alias 'filesets-member #'cl-member "28.1") | 161 | (define-obsolete-function-alias 'filesets-member #'cl-member "28.1") |
| 162 | (define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1") | 162 | (define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1") |
| 163 | 163 | ||
| 164 | (defun filesets-select-command (cmd-list) | ||
| 165 | "Select one command from CMD-LIST -- a string with space separated names." | ||
| 166 | (let ((this (shell-command-to-string | ||
| 167 | (format "which --skip-alias %s 2> %s | head -n 1" | ||
| 168 | cmd-list null-device)))) | ||
| 169 | (if (equal this "") | ||
| 170 | nil | ||
| 171 | (file-name-nondirectory (substring this 0 (- (length this) 1)))))) | ||
| 172 | |||
| 173 | (defun filesets-which-command (cmd) | 164 | (defun filesets-which-command (cmd) |
| 174 | "Call \"which CMD\"." | 165 | "Call \"which CMD\"." |
| 175 | (shell-command-to-string (format "which %s" cmd))) | 166 | (shell-command-to-string (format "which %s" (shell-quote-argument cmd)))) |
| 176 | 167 | ||
| 177 | (defun filesets-which-command-p (cmd) | 168 | (defun filesets-which-command-p (cmd) |
| 178 | "Call \"which CMD\" and return non-nil if the command was found." | 169 | "Call \"which CMD\" and return non-nil if the command was found." |
| @@ -547,16 +538,6 @@ the filename." | |||
| 547 | 538 | ||
| 548 | (defcustom filesets-external-viewers | 539 | (defcustom filesets-external-viewers |
| 549 | (let | 540 | (let |
| 550 | ;; ((ps-cmd (or (and (boundp 'my-ps-viewer) my-ps-viewer) | ||
| 551 | ;; (filesets-select-command "ggv gv"))) | ||
| 552 | ;; (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer) | ||
| 553 | ;; (filesets-select-command "xpdf acroread"))) | ||
| 554 | ;; (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer) | ||
| 555 | ;; (filesets-select-command "xdvi tkdvi"))) | ||
| 556 | ;; (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer) | ||
| 557 | ;; (filesets-select-command "antiword"))) | ||
| 558 | ;; (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer) | ||
| 559 | ;; (filesets-select-command "gqview ee display")))) | ||
| 560 | ((ps-cmd "ggv") | 541 | ((ps-cmd "ggv") |
| 561 | (pdf-cmd "xpdf") | 542 | (pdf-cmd "xpdf") |
| 562 | (dvi-cmd "xdvi") | 543 | (dvi-cmd "xdvi") |
| @@ -1084,10 +1065,6 @@ Return full path if FULL-FLAG is non-nil." | |||
| 1084 | (t | 1065 | (t |
| 1085 | (error "Filesets: %s does not exist" dir)))) | 1066 | (error "Filesets: %s does not exist" dir)))) |
| 1086 | 1067 | ||
| 1087 | (defun filesets-quote (txt) | ||
| 1088 | "Return TXT in quotes." | ||
| 1089 | (concat "\"" txt "\"")) | ||
| 1090 | |||
| 1091 | (defun filesets-get-selection () | 1068 | (defun filesets-get-selection () |
| 1092 | "Get the text between mark and point -- i.e. the selection or region." | 1069 | "Get the text between mark and point -- i.e. the selection or region." |
| 1093 | (let ((m (mark)) | 1070 | (let ((m (mark)) |
| @@ -1098,7 +1075,7 @@ Return full path if FULL-FLAG is non-nil." | |||
| 1098 | 1075 | ||
| 1099 | (defun filesets-get-quoted-selection () | 1076 | (defun filesets-get-quoted-selection () |
| 1100 | "Return the currently selected text in quotes." | 1077 | "Return the currently selected text in quotes." |
| 1101 | (filesets-quote (filesets-get-selection))) | 1078 | (shell-quote-argument (filesets-get-selection))) |
| 1102 | 1079 | ||
| 1103 | (defun filesets-get-shortcut (n) | 1080 | (defun filesets-get-shortcut (n) |
| 1104 | "Create menu shortcuts based on number N." | 1081 | "Create menu shortcuts based on number N." |
| @@ -1245,12 +1222,13 @@ Use the viewer defined in EV-ENTRY (a valid element of | |||
| 1245 | (if fmt | 1222 | (if fmt |
| 1246 | (mapconcat | 1223 | (mapconcat |
| 1247 | (lambda (this) | 1224 | (lambda (this) |
| 1248 | (if (stringp this) (format this file) | 1225 | (if (stringp this) |
| 1249 | (format "%S" (if (functionp this) | 1226 | (format this (shell-quote-argument file)) |
| 1250 | (funcall this) | 1227 | (shell-quote-argument (if (functionp this) |
| 1251 | this)))) | 1228 | (funcall this) |
| 1229 | this)))) | ||
| 1252 | fmt "") | 1230 | fmt "") |
| 1253 | (format "%S" file)))) | 1231 | (shell-quote-argument file)))) |
| 1254 | (output | 1232 | (output |
| 1255 | (cond | 1233 | (cond |
| 1256 | ((and (functionp vwr) co-flag) | 1234 | ((and (functionp vwr) co-flag) |
| @@ -1259,7 +1237,7 @@ Use the viewer defined in EV-ENTRY (a valid element of | |||
| 1259 | (funcall vwr file) | 1237 | (funcall vwr file) |
| 1260 | nil) | 1238 | nil) |
| 1261 | (co-flag | 1239 | (co-flag |
| 1262 | (shell-command-to-string (format "%s %s" vwr args))) | 1240 | (shell-command-to-string (format "%s %s" vwr args))) |
| 1263 | (t | 1241 | (t |
| 1264 | (shell-command (format "%s %s&" vwr args)) | 1242 | (shell-command (format "%s %s&" vwr args)) |
| 1265 | nil)))) | 1243 | nil)))) |
| @@ -2483,11 +2461,15 @@ Set up hooks, load the cache file -- if existing -- and build the menu." | |||
| 2483 | (setq filesets-menu-use-cached-flag t))) | 2461 | (setq filesets-menu-use-cached-flag t))) |
| 2484 | (filesets-build-menu))) | 2462 | (filesets-build-menu))) |
| 2485 | 2463 | ||
| 2464 | ;;; obsolete | ||
| 2465 | |||
| 2486 | (defun filesets-error (_class &rest args) | 2466 | (defun filesets-error (_class &rest args) |
| 2487 | "`error' wrapper." | 2467 | "`error' wrapper." |
| 2488 | (declare (obsolete error "28.1")) | 2468 | (declare (obsolete error "28.1")) |
| 2489 | (error "%s" (mapconcat #'identity args " "))) | 2469 | (error "%s" (mapconcat #'identity args " "))) |
| 2490 | 2470 | ||
| 2471 | (define-obsolete-function-alias 'filesets-quote #'shell-quote-argument "30.1") | ||
| 2472 | |||
| 2491 | (provide 'filesets) | 2473 | (provide 'filesets) |
| 2492 | 2474 | ||
| 2493 | ;;; filesets.el ends here | 2475 | ;;; filesets.el ends here |
diff --git a/lisp/forms.el b/lisp/forms.el index 009667af273..3a3160a0c8b 100644 --- a/lisp/forms.el +++ b/lisp/forms.el | |||
| @@ -343,7 +343,7 @@ suitable for forms processing.") | |||
| 343 | 343 | ||
| 344 | (defvar forms-write-file-filter nil | 344 | (defvar forms-write-file-filter nil |
| 345 | "The name of a function that is called before writing the data file. | 345 | "The name of a function that is called before writing the data file. |
| 346 | This can be used to undo the effects of `form-read-file-filter'.") | 346 | This can be used to undo the effects of `forms-read-file-filter'.") |
| 347 | 347 | ||
| 348 | (defvar forms-new-record-filter nil | 348 | (defvar forms-new-record-filter nil |
| 349 | "The name of a function that is called when a new record is created.") | 349 | "The name of a function that is called when a new record is created.") |
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 3ee93031119..1726b806913 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el | |||
| @@ -2910,13 +2910,9 @@ The following commands are available: | |||
| 2910 | (car func) | 2910 | (car func) |
| 2911 | (gnus-byte-compile `(lambda () ,func))))) | 2911 | (gnus-byte-compile `(lambda () ,func))))) |
| 2912 | 2912 | ||
| 2913 | (defun gnus-agent-true () | 2913 | (defalias 'gnus-agent-true #'always) |
| 2914 | "Return t." | ||
| 2915 | t) | ||
| 2916 | 2914 | ||
| 2917 | (defun gnus-agent-false () | 2915 | (defalias 'gnus-agent-false #'ignore) |
| 2918 | "Return nil." | ||
| 2919 | nil) | ||
| 2920 | 2916 | ||
| 2921 | (defun gnus-category-make-function-1 (predicate) | 2917 | (defun gnus-category-make-function-1 (predicate) |
| 2922 | "Make a function from PREDICATE." | 2918 | "Make a function from PREDICATE." |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c3c5eab7d89..9f313108089 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -694,7 +694,7 @@ used as possible file names." | |||
| 694 | 694 | ||
| 695 | (defcustom gnus-page-delimiter "^\^L" | 695 | (defcustom gnus-page-delimiter "^\^L" |
| 696 | "Regexp describing what to use as article page delimiters. | 696 | "Regexp describing what to use as article page delimiters. |
| 697 | The default value is \"^\^L\", which is a form linefeed at the | 697 | The default value is \"^\\^L\", which is a form linefeed at the |
| 698 | beginning of a line." | 698 | beginning of a line." |
| 699 | :type 'regexp | 699 | :type 'regexp |
| 700 | :group 'gnus-article-various) | 700 | :group 'gnus-article-various) |
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index 48c1aef968b..f33c5f7f2e5 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el | |||
| @@ -111,6 +111,12 @@ See `mail-user-agent' for more information." | |||
| 111 | 111 | ||
| 112 | (autoload 'gnus-completing-read "gnus-util") | 112 | (autoload 'gnus-completing-read "gnus-util") |
| 113 | 113 | ||
| 114 | (defcustom gnus-dired-attach-at-end t | ||
| 115 | "Non-nil means that files should be attached at the end of a buffer." | ||
| 116 | :group 'mail ;; dired? | ||
| 117 | :version "30.1" | ||
| 118 | :type 'boolean) | ||
| 119 | |||
| 114 | ;; Method to attach files to a mail composition. | 120 | ;; Method to attach files to a mail composition. |
| 115 | (defun gnus-dired-attach (files-to-attach) | 121 | (defun gnus-dired-attach (files-to-attach) |
| 116 | "Attach dired's marked files to a gnus message composition. | 122 | "Attach dired's marked files to a gnus message composition. |
| @@ -161,7 +167,8 @@ filenames." | |||
| 161 | 167 | ||
| 162 | ;; set buffer to destination buffer, and attach files | 168 | ;; set buffer to destination buffer, and attach files |
| 163 | (set-buffer destination) | 169 | (set-buffer destination) |
| 164 | (goto-char (point-max)) ;attach at end of buffer | 170 | (when gnus-dired-attach-at-end |
| 171 | (goto-char (point-max))) ;attach at end of buffer | ||
| 165 | (while files-to-attach | 172 | (while files-to-attach |
| 166 | (mml-attach-file (car files-to-attach) | 173 | (mml-attach-file (car files-to-attach) |
| 167 | (or (mm-default-file-type (car files-to-attach)) | 174 | (or (mm-default-file-type (car files-to-attach)) |
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index fdf97e1aabd..b18ede58fbf 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el | |||
| @@ -1189,12 +1189,12 @@ Uses the process/prefix convention. | |||
| 1189 | The reply will include all From/Cc headers from the original | 1189 | The reply will include all From/Cc headers from the original |
| 1190 | messages as the To/Cc headers. | 1190 | messages as the To/Cc headers. |
| 1191 | 1191 | ||
| 1192 | If prefix argument YANK is non-nil, the original article(s) will | 1192 | If prefix argument YANK is non-nil, the original article will |
| 1193 | be yanked automatically." | 1193 | be yanked automatically." |
| 1194 | (interactive (list (and current-prefix-arg | 1194 | (interactive (list (and current-prefix-arg |
| 1195 | (gnus-summary-work-articles 1))) | 1195 | (gnus-summary-work-articles 1))) |
| 1196 | gnus-summary-mode) | 1196 | gnus-summary-mode) |
| 1197 | (gnus-summary-reply yank t (gnus-summary-work-articles yank))) | 1197 | (gnus-summary-reply yank t (gnus-summary-work-articles current-prefix-arg))) |
| 1198 | 1198 | ||
| 1199 | (defun gnus-summary-very-wide-reply-with-original (n) | 1199 | (defun gnus-summary-very-wide-reply-with-original (n) |
| 1200 | "Start composing a very wide reply mail a set of messages. | 1200 | "Start composing a very wide reply mail a set of messages. |
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index bd19e7d7cd7..479b7496cf1 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el | |||
| @@ -893,9 +893,14 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." | |||
| 893 | (t "permanent")) | 893 | (t "permanent")) |
| 894 | header | 894 | header |
| 895 | (if (< score 0) "lower" "raise")) | 895 | (if (< score 0) "lower" "raise")) |
| 896 | (if (numberp match) | 896 | (cond ((numberp match) (int-to-string match)) |
| 897 | (int-to-string match) | 897 | ((string= header "date") |
| 898 | match)))) | 898 | (int-to-string |
| 899 | (- | ||
| 900 | (/ (car (time-convert (current-time) 1)) 86400) | ||
| 901 | (/ (car (time-convert (gnus-date-get-time match) 1)) | ||
| 902 | 86400)))) | ||
| 903 | (t match))))) | ||
| 899 | 904 | ||
| 900 | ;; If this is an integer comparison, we transform from string to int. | 905 | ;; If this is an integer comparison, we transform from string to int. |
| 901 | (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) | 906 | (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) |
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index b5aa0b02d34..0b0a9bbfc1d 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el | |||
| @@ -1113,8 +1113,7 @@ sure of changing the value of `foo'." | |||
| 1113 | (setq gnus-info-buffer (current-buffer)) | 1113 | (setq gnus-info-buffer (current-buffer)) |
| 1114 | (gnus-configure-windows 'info))) | 1114 | (gnus-configure-windows 'info))) |
| 1115 | 1115 | ||
| 1116 | (defun gnus-not-ignore (&rest _args) | 1116 | (defalias 'gnus-not-ignore #'always) |
| 1117 | t) | ||
| 1118 | 1117 | ||
| 1119 | (defvar gnus-directory-sep-char-regexp "/" | 1118 | (defvar gnus-directory-sep-char-regexp "/" |
| 1120 | "The regexp of directory separator character. | 1119 | "The regexp of directory separator character. |
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 99833e4eeca..dab66b60205 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el | |||
| @@ -309,12 +309,31 @@ be set in `.emacs' instead." | |||
| 309 | :group 'gnus-start | 309 | :group 'gnus-start |
| 310 | :type 'boolean) | 310 | :type 'boolean) |
| 311 | 311 | ||
| 312 | (defcustom gnus-mode-line-logo | ||
| 313 | '((:type svg :file "gnus-pointer.svg" :ascent center) | ||
| 314 | (:type xpm :file "gnus-pointer.xpm" :ascent center) | ||
| 315 | (:type xbm :file "gnus-pointer.xbm" :ascent center)) | ||
| 316 | "Image spec for the Gnus logo to be displayed in mode-line. | ||
| 317 | |||
| 318 | If non-nil, it should be a list of image specifications to be passed | ||
| 319 | as the first argument to `find-image', which see. Then, if the display | ||
| 320 | is capable of showing images, the Gnus logo will be displayed as part of | ||
| 321 | the buffer-identification in the mode-line of Gnus-buffers. | ||
| 322 | |||
| 323 | If nil, there will be no Gnus logo in the mode-line." | ||
| 324 | :group 'gnus-visual | ||
| 325 | :type '(choice | ||
| 326 | (repeat :tag "List of Gnus logo image specifications" (plist)) | ||
| 327 | (const :tag "Don't display Gnus logo" nil)) | ||
| 328 | :version "30.1") | ||
| 329 | |||
| 312 | (defun gnus-mode-line-buffer-identification (line) | 330 | (defun gnus-mode-line-buffer-identification (line) |
| 313 | (let* ((str (car-safe line)) | 331 | (let* ((str (car-safe line)) |
| 314 | (str (if (stringp str) | 332 | (str (if (stringp str) |
| 315 | (car (propertized-buffer-identification str)) | 333 | (car (propertized-buffer-identification str)) |
| 316 | str))) | 334 | str))) |
| 317 | (if (or (not (fboundp 'find-image)) | 335 | (if (or (not gnus-mode-line-logo) |
| 336 | (not (fboundp 'find-image)) | ||
| 318 | (not (display-graphic-p)) | 337 | (not (display-graphic-p)) |
| 319 | (not (stringp str)) | 338 | (not (stringp str)) |
| 320 | (not (string-match "^Gnus:" str))) | 339 | (not (string-match "^Gnus:" str))) |
| @@ -325,14 +344,7 @@ be set in `.emacs' instead." | |||
| 325 | (add-text-properties | 344 | (add-text-properties |
| 326 | 0 5 | 345 | 0 5 |
| 327 | (list 'display | 346 | (list 'display |
| 328 | (find-image | 347 | (find-image gnus-mode-line-logo t) |
| 329 | '((:type svg :file "gnus-pointer.svg" | ||
| 330 | :ascent center) | ||
| 331 | (:type xpm :file "gnus-pointer.xpm" | ||
| 332 | :ascent center) | ||
| 333 | (:type xbm :file "gnus-pointer.xbm" | ||
| 334 | :ascent center)) | ||
| 335 | t) | ||
| 336 | 'help-echo (if gnus-emacs-version | 348 | 'help-echo (if gnus-emacs-version |
| 337 | (format | 349 | (format |
| 338 | "This is %s, %s." | 350 | "This is %s, %s." |
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 97821894b48..ea679759f3e 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el | |||
| @@ -1016,7 +1016,7 @@ See `find-file-noselect' for the arguments." | |||
| 1016 | (nnheader-skeleton-replace from to t)) | 1016 | (nnheader-skeleton-replace from to t)) |
| 1017 | 1017 | ||
| 1018 | (defun nnheader-strip-cr () | 1018 | (defun nnheader-strip-cr () |
| 1019 | "Strip all \r's from the current buffer." | 1019 | "Strip all \\r's from the current buffer." |
| 1020 | (nnheader-skeleton-replace "\r")) | 1020 | (nnheader-skeleton-replace "\r")) |
| 1021 | 1021 | ||
| 1022 | (define-obsolete-function-alias 'nnheader-cancel-timer 'cancel-timer "27.1") | 1022 | (define-obsolete-function-alias 'nnheader-cancel-timer 'cancel-timer "27.1") |
diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 99642d08bbd..15d87f9925c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el | |||
| @@ -1799,9 +1799,8 @@ If FRAME is omitted or nil, use the selected frame." | |||
| 1799 | alias) | 1799 | alias) |
| 1800 | "")))) | 1800 | "")))) |
| 1801 | (insert "\nDocumentation:\n" | 1801 | (insert "\nDocumentation:\n" |
| 1802 | (substitute-command-keys | 1802 | (or (face-documentation face) |
| 1803 | (or (face-documentation face) | 1803 | "Not documented as a face.") |
| 1804 | "Not documented as a face.")) | ||
| 1805 | "\n\n")) | 1804 | "\n\n")) |
| 1806 | (with-current-buffer standard-output | 1805 | (with-current-buffer standard-output |
| 1807 | (save-excursion | 1806 | (save-excursion |
| @@ -2134,6 +2133,12 @@ keymap value." | |||
| 2134 | (when used-gentemp | 2133 | (when used-gentemp |
| 2135 | (makunbound keymap)))) | 2134 | (makunbound keymap)))) |
| 2136 | 2135 | ||
| 2136 | (defcustom describe-mode-outline t | ||
| 2137 | "Non-nil enables outlines in the output buffer of `describe-mode'." | ||
| 2138 | :type 'boolean | ||
| 2139 | :group 'help | ||
| 2140 | :version "30.1") | ||
| 2141 | |||
| 2137 | ;;;###autoload | 2142 | ;;;###autoload |
| 2138 | (defun describe-mode (&optional buffer) | 2143 | (defun describe-mode (&optional buffer) |
| 2139 | "Display documentation of current major mode and minor modes. | 2144 | "Display documentation of current major mode and minor modes. |
| @@ -2146,7 +2151,10 @@ variable \(listed in `minor-mode-alist') must also be a function | |||
| 2146 | whose documentation describes the minor mode. | 2151 | whose documentation describes the minor mode. |
| 2147 | 2152 | ||
| 2148 | If called from Lisp with a non-nil BUFFER argument, display | 2153 | If called from Lisp with a non-nil BUFFER argument, display |
| 2149 | documentation for the major and minor modes of that buffer." | 2154 | documentation for the major and minor modes of that buffer. |
| 2155 | |||
| 2156 | When `describe-mode-outline' is non-nil, Outline minor mode | ||
| 2157 | is enabled in the Help buffer." | ||
| 2150 | (interactive "@") | 2158 | (interactive "@") |
| 2151 | (unless buffer | 2159 | (unless buffer |
| 2152 | (setq buffer (current-buffer))) | 2160 | (setq buffer (current-buffer))) |
| @@ -2160,13 +2168,20 @@ documentation for the major and minor modes of that buffer." | |||
| 2160 | (with-current-buffer (help-buffer) | 2168 | (with-current-buffer (help-buffer) |
| 2161 | ;; Add the local minor modes at the start. | 2169 | ;; Add the local minor modes at the start. |
| 2162 | (when local-minors | 2170 | (when local-minors |
| 2163 | (insert (format "Minor mode%s enabled in this buffer:" | 2171 | (unless describe-mode-outline |
| 2164 | (if (length> local-minors 1) | 2172 | (insert (format "Minor mode%s enabled in this buffer:" |
| 2165 | "s" ""))) | 2173 | (if (length> local-minors 1) |
| 2174 | "s" "")))) | ||
| 2166 | (describe-mode--minor-modes local-minors)) | 2175 | (describe-mode--minor-modes local-minors)) |
| 2167 | 2176 | ||
| 2168 | ;; Document the major mode. | 2177 | ;; Document the major mode. |
| 2169 | (let ((major (buffer-local-value 'major-mode buffer))) | 2178 | (let ((major (buffer-local-value 'major-mode buffer))) |
| 2179 | (when describe-mode-outline | ||
| 2180 | (goto-char (point-min)) | ||
| 2181 | (put-text-property | ||
| 2182 | (point) (progn (insert (format "Major mode %S" major)) (point)) | ||
| 2183 | 'outline-level 1) | ||
| 2184 | (insert "\n\n")) | ||
| 2170 | (insert "The major mode is " | 2185 | (insert "The major mode is " |
| 2171 | (buttonize | 2186 | (buttonize |
| 2172 | (propertize (format-mode-line | 2187 | (propertize (format-mode-line |
| @@ -2190,36 +2205,56 @@ documentation for the major and minor modes of that buffer." | |||
| 2190 | 2205 | ||
| 2191 | ;; Insert the global minor modes after the major mode. | 2206 | ;; Insert the global minor modes after the major mode. |
| 2192 | (when global-minor-modes | 2207 | (when global-minor-modes |
| 2193 | (insert (format "Global minor mode%s enabled:" | 2208 | (unless describe-mode-outline |
| 2194 | (if (length> global-minor-modes 1) | 2209 | (insert (format "Global minor mode%s enabled:" |
| 2195 | "s" ""))) | 2210 | (if (length> global-minor-modes 1) |
| 2196 | (describe-mode--minor-modes global-minor-modes) | 2211 | "s" "")))) |
| 2197 | (when (re-search-forward "^\f") | 2212 | (describe-mode--minor-modes global-minor-modes t) |
| 2198 | (beginning-of-line) | 2213 | (unless describe-mode-outline |
| 2199 | (ensure-empty-lines 1))) | 2214 | (when (re-search-forward "^\f") |
| 2215 | (beginning-of-line) | ||
| 2216 | (ensure-empty-lines 1)))) | ||
| 2217 | |||
| 2218 | (when describe-mode-outline | ||
| 2219 | (setq-local outline-search-function #'outline-search-level) | ||
| 2220 | (setq-local outline-level (lambda () 1)) | ||
| 2221 | (setq-local outline-minor-mode-cycle t | ||
| 2222 | outline-minor-mode-highlight t | ||
| 2223 | outline-minor-mode-use-buttons 'insert) | ||
| 2224 | (outline-minor-mode 1)) | ||
| 2225 | |||
| 2200 | ;; For the sake of IELM and maybe others | 2226 | ;; For the sake of IELM and maybe others |
| 2201 | nil))))) | 2227 | nil))))) |
| 2202 | 2228 | ||
| 2203 | (defun describe-mode--minor-modes (modes) | 2229 | (defun describe-mode--minor-modes (modes &optional global) |
| 2204 | (dolist (mode (seq-sort #'string< modes)) | 2230 | (dolist (mode (seq-sort #'string< modes)) |
| 2205 | (let ((pretty-minor-mode | 2231 | (let ((pretty-minor-mode |
| 2206 | (capitalize | 2232 | (capitalize |
| 2207 | (replace-regexp-in-string | 2233 | (replace-regexp-in-string |
| 2208 | "\\(\\(-minor\\)?-mode\\)?\\'" "" | 2234 | "\\(\\(-minor\\)?-mode\\)?\\'" "" |
| 2209 | (symbol-name mode))))) | 2235 | (symbol-name mode))))) |
| 2210 | (insert | 2236 | (if (not describe-mode-outline) |
| 2211 | " " | 2237 | (insert |
| 2212 | (buttonize | 2238 | " " |
| 2213 | pretty-minor-mode | 2239 | (buttonize |
| 2214 | (lambda (mode) | 2240 | pretty-minor-mode |
| 2215 | (goto-char (point-min)) | 2241 | (lambda (mode) |
| 2216 | (text-property-search-forward | 2242 | (goto-char (point-min)) |
| 2217 | 'help-minor-mode mode t) | 2243 | (text-property-search-forward |
| 2218 | (beginning-of-line)) | 2244 | 'help-minor-mode mode t) |
| 2219 | mode)) | 2245 | (beginning-of-line)) |
| 2246 | mode)) | ||
| 2247 | (goto-char (point-max)) | ||
| 2248 | (put-text-property | ||
| 2249 | (point) (progn (insert (if global "Global" "Local") | ||
| 2250 | (format " minor mode %S" mode)) | ||
| 2251 | (point)) | ||
| 2252 | 'outline-level 1) | ||
| 2253 | (insert "\n\n")) | ||
| 2220 | (save-excursion | 2254 | (save-excursion |
| 2221 | (goto-char (point-max)) | 2255 | (unless describe-mode-outline |
| 2222 | (insert "\n\n\f\n") | 2256 | (goto-char (point-max)) |
| 2257 | (insert "\n\n\f\n")) | ||
| 2223 | ;; Document the minor modes fully. | 2258 | ;; Document the minor modes fully. |
| 2224 | (insert (buttonize | 2259 | (insert (buttonize |
| 2225 | (propertize pretty-minor-mode 'help-minor-mode mode) | 2260 | (propertize pretty-minor-mode 'help-minor-mode mode) |
| @@ -2233,11 +2268,14 @@ documentation for the major and minor modes of that buffer." | |||
| 2233 | (format "indicator%s" | 2268 | (format "indicator%s" |
| 2234 | indicator))))) | 2269 | indicator))))) |
| 2235 | (insert (or (help-split-fundoc (documentation mode) nil 'doc) | 2270 | (insert (or (help-split-fundoc (documentation mode) nil 'doc) |
| 2236 | "No docstring"))))) | 2271 | "No docstring")) |
| 2237 | (forward-line -1) | 2272 | (when describe-mode-outline |
| 2238 | (fill-paragraph nil) | 2273 | (insert "\n\n"))))) |
| 2239 | (forward-paragraph 1) | 2274 | (unless describe-mode-outline |
| 2240 | (ensure-empty-lines 1)) | 2275 | (forward-line -1) |
| 2276 | (fill-paragraph nil) | ||
| 2277 | (forward-paragraph 1) | ||
| 2278 | (ensure-empty-lines 1))) | ||
| 2241 | 2279 | ||
| 2242 | (defun help-fns--list-local-commands () | 2280 | (defun help-fns--list-local-commands () |
| 2243 | (let ((functions nil)) | 2281 | (let ((functions nil)) |
diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 9c405efeee5..f9ec8a5cc2b 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el | |||
| @@ -501,7 +501,17 @@ restore it properly when going back." | |||
| 501 | ;; Disable `outline-minor-mode' in a reused Help buffer | 501 | ;; Disable `outline-minor-mode' in a reused Help buffer |
| 502 | ;; created by `describe-bindings' that enables this mode. | 502 | ;; created by `describe-bindings' that enables this mode. |
| 503 | (when (bound-and-true-p outline-minor-mode) | 503 | (when (bound-and-true-p outline-minor-mode) |
| 504 | (outline-minor-mode -1)) | 504 | (outline-minor-mode -1) |
| 505 | (mapc #'kill-local-variable | ||
| 506 | '(outline-search-function | ||
| 507 | outline-regexp | ||
| 508 | outline-heading-end-regexp | ||
| 509 | outline-level | ||
| 510 | outline-minor-mode-cycle | ||
| 511 | outline-minor-mode-highlight | ||
| 512 | outline-minor-mode-use-buttons | ||
| 513 | outline-default-state | ||
| 514 | outline-default-rules))) | ||
| 505 | (when help-xref-stack-item | 515 | (when help-xref-stack-item |
| 506 | (push (cons (point) help-xref-stack-item) help-xref-stack) | 516 | (push (cons (point) help-xref-stack-item) help-xref-stack) |
| 507 | (setq help-xref-forward-stack nil)) | 517 | (setq help-xref-forward-stack nil)) |
diff --git a/lisp/help.el b/lisp/help.el index 72a4f8a800d..c6a1e3c6bd9 100644 --- a/lisp/help.el +++ b/lisp/help.el | |||
| @@ -151,7 +151,7 @@ buffer.") | |||
| 151 | ("Mark & Kill" | 151 | ("Mark & Kill" |
| 152 | (set-mark-command . "mark") | 152 | (set-mark-command . "mark") |
| 153 | (kill-line . "kill line") | 153 | (kill-line . "kill line") |
| 154 | (kill-ring-save . "kill region") | 154 | (kill-region . "kill region") |
| 155 | (yank . "yank") | 155 | (yank . "yank") |
| 156 | (exchange-point-and-mark . "swap")) | 156 | (exchange-point-and-mark . "swap")) |
| 157 | ("Projects" | 157 | ("Projects" |
| @@ -165,7 +165,15 @@ buffer.") | |||
| 165 | (isearch-forward . "search") | 165 | (isearch-forward . "search") |
| 166 | (isearch-backward . "reverse search") | 166 | (isearch-backward . "reverse search") |
| 167 | (query-replace . "search & replace") | 167 | (query-replace . "search & replace") |
| 168 | (fill-paragraph . "reformat")))) | 168 | (fill-paragraph . "reformat"))) |
| 169 | "Data structure for `help-quick'. | ||
| 170 | Value should be a list of elements, each element should of the form | ||
| 171 | |||
| 172 | (GROUP-NAME (COMMAND . DESCRIPTION) (COMMAND . DESCRIPTION)...) | ||
| 173 | |||
| 174 | where GROUP-NAME is the name of the group of the commands, | ||
| 175 | COMMAND is the symbol of a command and DESCRIPTION is its short | ||
| 176 | description, 10 to 15 char5acters at most.") | ||
| 169 | 177 | ||
| 170 | (declare-function prop-match-value "text-property-search" (match)) | 178 | (declare-function prop-match-value "text-property-search" (match)) |
| 171 | 179 | ||
| @@ -2253,6 +2261,27 @@ The `temp-buffer-window-setup-hook' hook is called." | |||
| 2253 | (with-output-to-temp-buffer " *Char Help*" | 2261 | (with-output-to-temp-buffer " *Char Help*" |
| 2254 | (princ msg))))) | 2262 | (princ msg))))) |
| 2255 | 2263 | ||
| 2264 | (defun help--append-keystrokes-help (str) | ||
| 2265 | (let* ((keys (this-single-command-keys)) | ||
| 2266 | (bindings (delete nil | ||
| 2267 | (mapcar (lambda (map) (lookup-key map keys t)) | ||
| 2268 | (current-active-maps t))))) | ||
| 2269 | (catch 'res | ||
| 2270 | (dolist (val help-event-list) | ||
| 2271 | (let ((key (vector (if (eql val 'help) | ||
| 2272 | help-char | ||
| 2273 | val)))) | ||
| 2274 | (unless (seq-find (lambda (map) (and (keymapp map) (lookup-key map key))) | ||
| 2275 | bindings) | ||
| 2276 | (throw 'res | ||
| 2277 | (concat | ||
| 2278 | str | ||
| 2279 | (substitute-command-keys | ||
| 2280 | (format | ||
| 2281 | " (\\`%s' for help)" | ||
| 2282 | (key-description key)))))))) | ||
| 2283 | str))) | ||
| 2284 | |||
| 2256 | 2285 | ||
| 2257 | (defun help--docstring-quote (string) | 2286 | (defun help--docstring-quote (string) |
| 2258 | "Return a doc string that represents STRING. | 2287 | "Return a doc string that represents STRING. |
diff --git a/lisp/ielm.el b/lisp/ielm.el index 777aebb70cf..e583e0fe32c 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el | |||
| @@ -110,6 +110,13 @@ This gives more frame width for large indented sexps, and allows functions | |||
| 110 | such as `edebug-defun' to work with such inputs." | 110 | such as `edebug-defun' to work with such inputs." |
| 111 | :type 'boolean) | 111 | :type 'boolean) |
| 112 | 112 | ||
| 113 | (defcustom ielm-history-file-name | ||
| 114 | (locate-user-emacs-file "ielm-history.eld") | ||
| 115 | "If non-nil, name of the file to read/write IELM input history." | ||
| 116 | :type '(choice (const :tag "Disable input history" nil) | ||
| 117 | file) | ||
| 118 | :version "30.1") | ||
| 119 | |||
| 113 | (defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook) | 120 | (defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook) |
| 114 | (defcustom ielm-mode-hook nil | 121 | (defcustom ielm-mode-hook nil |
| 115 | "Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started." | 122 | "Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started." |
| @@ -503,6 +510,17 @@ behavior of the indirect buffer." | |||
| 503 | (funcall pp-default-function beg end) | 510 | (funcall pp-default-function beg end) |
| 504 | end)) | 511 | end)) |
| 505 | 512 | ||
| 513 | ;;; Input history | ||
| 514 | |||
| 515 | (defvar ielm--exit nil | ||
| 516 | "Function to call when Emacs is killed.") | ||
| 517 | |||
| 518 | (defun ielm--input-history-writer (buf) | ||
| 519 | "Return a function writing IELM input history to BUF." | ||
| 520 | (lambda () | ||
| 521 | (with-current-buffer buf | ||
| 522 | (comint-write-input-ring)))) | ||
| 523 | |||
| 506 | ;;; Major mode | 524 | ;;; Major mode |
| 507 | 525 | ||
| 508 | (define-derived-mode inferior-emacs-lisp-mode comint-mode "IELM" | 526 | (define-derived-mode inferior-emacs-lisp-mode comint-mode "IELM" |
| @@ -605,6 +623,17 @@ Customized bindings may be defined in `ielm-map', which currently contains: | |||
| 605 | #'ielm-indirect-setup-hook 'append t) | 623 | #'ielm-indirect-setup-hook 'append t) |
| 606 | (setq comint-indirect-setup-function #'emacs-lisp-mode) | 624 | (setq comint-indirect-setup-function #'emacs-lisp-mode) |
| 607 | 625 | ||
| 626 | ;; Input history | ||
| 627 | (setq-local comint-input-ring-file-name ielm-history-file-name) | ||
| 628 | (setq-local ielm--exit (ielm--input-history-writer (current-buffer))) | ||
| 629 | (setq-local kill-buffer-hook | ||
| 630 | (lambda () | ||
| 631 | (funcall ielm--exit) | ||
| 632 | (remove-hook 'kill-emacs-hook ielm--exit))) | ||
| 633 | (unless noninteractive | ||
| 634 | (add-hook 'kill-emacs-hook ielm--exit)) | ||
| 635 | (comint-read-input-ring t) | ||
| 636 | |||
| 608 | ;; A dummy process to keep comint happy. It will never get any input | 637 | ;; A dummy process to keep comint happy. It will never get any input |
| 609 | (unless (comint-check-proc (current-buffer)) | 638 | (unless (comint-check-proc (current-buffer)) |
| 610 | ;; Was cat, but on non-Unix platforms that might not exist, so | 639 | ;; Was cat, but on non-Unix platforms that might not exist, so |
diff --git a/lisp/image.el b/lisp/image.el index 73801f88d1e..2ebce59a98c 100644 --- a/lisp/image.el +++ b/lisp/image.el | |||
| @@ -759,21 +759,25 @@ BUFFER nil or omitted means use the current buffer." | |||
| 759 | 759 | ||
| 760 | ;;;###autoload | 760 | ;;;###autoload |
| 761 | (defun find-image (specs &optional cache) | 761 | (defun find-image (specs &optional cache) |
| 762 | "Find an image, choosing one of a list of image specifications. | 762 | "Find an image that satisfies one of a list of image specifications. |
| 763 | 763 | ||
| 764 | SPECS is a list of image specifications. | 764 | SPECS is a list of image specifications. |
| 765 | 765 | ||
| 766 | Each image specification in SPECS is a property list. The contents of | 766 | Each image specification in SPECS is a property list. The |
| 767 | a specification are image type dependent. All specifications must at | 767 | contents of a specification are image type dependent; see the |
| 768 | least contain either the property `:file FILE' or `:data DATA', | 768 | info node `(elisp)Image Descriptors' for details. All specifications |
| 769 | where FILE is the file to load the image from, and DATA is a string | 769 | must at least contain either the property `:file FILE' or `:data DATA', |
| 770 | containing the actual image data. If the property `:type TYPE' is | 770 | where FILE is the file from which to load the image, and DATA is a |
| 771 | omitted or nil, try to determine the image type from its first few | 771 | string containing the actual image data. If the property `:type TYPE' |
| 772 | is omitted or nil, try to determine the image type from its first few | ||
| 772 | bytes of image data. If that doesn't work, and the property `:file | 773 | bytes of image data. If that doesn't work, and the property `:file |
| 773 | FILE' provide a file name, use its file extension as image type. | 774 | FILE' provide a file name, use its file extension as idication of the |
| 774 | If `:type TYPE' is provided, it must match the actual type | 775 | image type. If `:type TYPE' is provided, it must match the actual type |
| 775 | determined for FILE or DATA by `create-image'. Return nil if no | 776 | determined for FILE or DATA by `create-image'. |
| 776 | specification is satisfied. | 777 | |
| 778 | The function returns the image specification for the first specification | ||
| 779 | in the list whose TYPE is supported and FILE, if specified, exists. It | ||
| 780 | returns nil if no specification in the list can be satisfied. | ||
| 777 | 781 | ||
| 778 | If CACHE is non-nil, results are cached and returned on subsequent calls. | 782 | If CACHE is non-nil, results are cached and returned on subsequent calls. |
| 779 | 783 | ||
diff --git a/lisp/info.el b/lisp/info.el index e91cc7b8e54..176bc9c0033 100644 --- a/lisp/info.el +++ b/lisp/info.el | |||
| @@ -231,8 +231,9 @@ Each element of this list has the form (MANUALs . URL-SPEC). | |||
| 231 | MANUALs represents the name of one or more manuals. It can | 231 | MANUALs represents the name of one or more manuals. It can |
| 232 | either be a string or a list of strings. URL-SPEC can be a | 232 | either be a string or a list of strings. URL-SPEC can be a |
| 233 | string in which the substring \"%m\" will be expanded to the | 233 | string in which the substring \"%m\" will be expanded to the |
| 234 | manual-name, \"%n\" to the node-name, and \"%e\" to the | 234 | manual-name and \"%n\" to the node-name. \"%e\" will expand to |
| 235 | URL-encoded node-name (without a `.html' suffix). (The | 235 | the URL-encoded node-name, including the `.html' extension; in |
| 236 | case of the Top node, it will expand to the empty string. (The | ||
| 236 | URL-encoding of the node-name mimics GNU Texinfo, as documented | 237 | URL-encoding of the node-name mimics GNU Texinfo, as documented |
| 237 | at Info node `(texinfo)HTML Xref Node Name Expansion'.) | 238 | at Info node `(texinfo)HTML Xref Node Name Expansion'.) |
| 238 | Alternatively, URL-SPEC can be a function which is given | 239 | Alternatively, URL-SPEC can be a function which is given |
| @@ -499,6 +500,7 @@ or `Info-virtual-nodes'." | |||
| 499 | (".info.bz2" . ("bzip2" "-dc")) | 500 | (".info.bz2" . ("bzip2" "-dc")) |
| 500 | (".info.xz" . "unxz") | 501 | (".info.xz" . "unxz") |
| 501 | (".info.zst" . ("zstd" "-dc")) | 502 | (".info.zst" . ("zstd" "-dc")) |
| 503 | (".info.lz" . ("lzip" "-dc")) | ||
| 502 | (".info" . nil) | 504 | (".info" . nil) |
| 503 | ("-info.Z" . "uncompress") | 505 | ("-info.Z" . "uncompress") |
| 504 | ("-info.Y" . "unyabba") | 506 | ("-info.Y" . "unyabba") |
| @@ -507,6 +509,7 @@ or `Info-virtual-nodes'." | |||
| 507 | ("-info.z" . "gunzip") | 509 | ("-info.z" . "gunzip") |
| 508 | ("-info.xz" . "unxz") | 510 | ("-info.xz" . "unxz") |
| 509 | ("-info.zst" . ("zstd" "-dc")) | 511 | ("-info.zst" . ("zstd" "-dc")) |
| 512 | ("-info.lz" . ("lzip" "-dc")) | ||
| 510 | ("-info" . nil) | 513 | ("-info" . nil) |
| 511 | ("/index.Z" . "uncompress") | 514 | ("/index.Z" . "uncompress") |
| 512 | ("/index.Y" . "unyabba") | 515 | ("/index.Y" . "unyabba") |
| @@ -515,6 +518,7 @@ or `Info-virtual-nodes'." | |||
| 515 | ("/index.bz2" . ("bzip2" "-dc")) | 518 | ("/index.bz2" . ("bzip2" "-dc")) |
| 516 | ("/index.xz" . "unxz") | 519 | ("/index.xz" . "unxz") |
| 517 | ("/index.zst" . ("zstd" "-dc")) | 520 | ("/index.zst" . ("zstd" "-dc")) |
| 521 | ("/index.lz" . ("lzip" "-dc")) | ||
| 518 | ("/index" . nil) | 522 | ("/index" . nil) |
| 519 | (".Z" . "uncompress") | 523 | (".Z" . "uncompress") |
| 520 | (".Y" . "unyabba") | 524 | (".Y" . "unyabba") |
| @@ -523,6 +527,7 @@ or `Info-virtual-nodes'." | |||
| 523 | (".bz2" . ("bzip2" "-dc")) | 527 | (".bz2" . ("bzip2" "-dc")) |
| 524 | (".xz" . "unxz") | 528 | (".xz" . "unxz") |
| 525 | (".zst" . ("zstd" "-dc")) | 529 | (".zst" . ("zstd" "-dc")) |
| 530 | (".lz" . ("lzip" "-dc")) | ||
| 526 | ("" . nil))) | 531 | ("" . nil))) |
| 527 | "List of file name suffixes and associated decoding commands. | 532 | "List of file name suffixes and associated decoding commands. |
| 528 | Each entry should be (SUFFIX . STRING); the file is given to | 533 | Each entry should be (SUFFIX . STRING); the file is given to |
| @@ -1924,18 +1929,20 @@ NODE should be a string of the form \"(manual)Node\"." | |||
| 1924 | ;; (info "(texinfo) HTML Xref Node Name Expansion") | 1929 | ;; (info "(texinfo) HTML Xref Node Name Expansion") |
| 1925 | (if (equal node "Top") | 1930 | (if (equal node "Top") |
| 1926 | "" | 1931 | "" |
| 1927 | (url-hexify-string | 1932 | (concat |
| 1928 | (string-replace " " "-" | 1933 | (url-hexify-string |
| 1929 | (mapconcat | 1934 | (string-replace " " "-" |
| 1930 | (lambda (ch) | 1935 | (mapconcat |
| 1931 | (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- | 1936 | (lambda (ch) |
| 1932 | (<= 33 ch 47) ; !"#$%&'()*+,-./ | 1937 | (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- |
| 1933 | (<= 58 ch 64) ; :;<=>?@ | 1938 | (<= 33 ch 47) ; !"#$%&'()*+,-./ |
| 1934 | (<= 91 ch 96) ; [\]_` | 1939 | (<= 58 ch 64) ; :;<=>?@ |
| 1935 | (<= 123 ch 127)) ; {|}~ DEL | 1940 | (<= 91 ch 96) ; [\]_` |
| 1936 | (format "_00%x" ch) | 1941 | (<= 123 ch 127)) ; {|}~ DEL |
| 1937 | (char-to-string ch))) | 1942 | (format "_00%x" ch) |
| 1938 | node "")))))) | 1943 | (char-to-string ch))) |
| 1944 | node ""))) | ||
| 1945 | ".html")))) | ||
| 1939 | (cond | 1946 | (cond |
| 1940 | ((stringp url-spec) | 1947 | ((stringp url-spec) |
| 1941 | (format-spec url-spec | 1948 | (format-spec url-spec |
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index c4706e061e3..42584f6548c 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el | |||
| @@ -31,12 +31,12 @@ | |||
| 31 | ;; Convert cxterm dictionary (of TIT format) to quail-package. | 31 | ;; Convert cxterm dictionary (of TIT format) to quail-package. |
| 32 | ;; | 32 | ;; |
| 33 | ;; Usage (within Emacs): | 33 | ;; Usage (within Emacs): |
| 34 | ;; M-x titdic-convert<CR>CXTERM-DICTIONARY-NAME<CR> | 34 | ;; M-x tit-dic-convert<CR>CXTERM-DICTIONARY-NAME<CR> |
| 35 | ;; Usage (from shell): | 35 | ;; Usage (from shell): |
| 36 | ;; % emacs -batch -l titdic-cnv -f batch-titdic-convert\ | 36 | ;; % emacs -batch -l titdic-cnv -f batch-tit-dic-convert\ |
| 37 | ;; [-dir DIR] [DIR | FILE] ... | 37 | ;; [-dir DIR] [DIR | FILE] ... |
| 38 | ;; | 38 | ;; |
| 39 | ;; When you run titdic-convert within Emacs, you have a chance to | 39 | ;; When you run `tit-dic-convert' within Emacs, you have a chance to |
| 40 | ;; modify arguments of `quail-define-package' before saving the | 40 | ;; modify arguments of `quail-define-package' before saving the |
| 41 | ;; converted file. For instance, you are likely to modify TITLE, | 41 | ;; converted file. For instance, you are likely to modify TITLE, |
| 42 | ;; DOCSTRING, and KEY-BINDINGS. | 42 | ;; DOCSTRING, and KEY-BINDINGS. |
| @@ -90,7 +90,8 @@ | |||
| 90 | ;; \<quail-translation-docstring> is replaced by a description about | 90 | ;; \<quail-translation-docstring> is replaced by a description about |
| 91 | ;; how to select a translation from a list of candidates. | 91 | ;; how to select a translation from a list of candidates. |
| 92 | 92 | ||
| 93 | (defvar quail-cxterm-package-ext-info | 93 | (define-obsolete-variable-alias 'quail-cxterm-package-ext-info 'tit-quail-cxterm-package-ext-info "30.1") |
| 94 | (defvar tit-quail-cxterm-package-ext-info | ||
| 94 | '(("chinese-4corner" "四角") | 95 | '(("chinese-4corner" "四角") |
| 95 | ("chinese-array30" "30") | 96 | ("chinese-array30" "30") |
| 96 | ("chinese-ccdospy" "缩拼" | 97 | ("chinese-ccdospy" "缩拼" |
| @@ -277,7 +278,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, | |||
| 277 | (tit-moveleft ",<") | 278 | (tit-moveleft ",<") |
| 278 | (tit-keyprompt nil)) | 279 | (tit-keyprompt nil)) |
| 279 | 280 | ||
| 280 | (generate-lisp-file-heading filename 'titdic-convert :code nil) | 281 | (generate-lisp-file-heading filename 'tit-dic-convert :code nil) |
| 281 | (princ ";; Quail package `") | 282 | (princ ";; Quail package `") |
| 282 | (princ package) | 283 | (princ package) |
| 283 | (princ "\n") | 284 | (princ "\n") |
| @@ -354,7 +355,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, | |||
| 354 | 355 | ||
| 355 | (princ "(quail-define-package ") | 356 | (princ "(quail-define-package ") |
| 356 | ;; Args NAME, LANGUAGE, TITLE | 357 | ;; Args NAME, LANGUAGE, TITLE |
| 357 | (let ((title (nth 1 (assoc package quail-cxterm-package-ext-info)))) | 358 | (let ((title (nth 1 (assoc package tit-quail-cxterm-package-ext-info)))) |
| 358 | (princ "\"") | 359 | (princ "\"") |
| 359 | (princ package) | 360 | (princ package) |
| 360 | (princ "\" \"") | 361 | (princ "\" \"") |
| @@ -383,7 +384,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, | |||
| 383 | (let ((doc (concat tit-prompt "\n")) | 384 | (let ((doc (concat tit-prompt "\n")) |
| 384 | (comments (if tit-comments | 385 | (comments (if tit-comments |
| 385 | (mapconcat #'identity (nreverse tit-comments) "\n"))) | 386 | (mapconcat #'identity (nreverse tit-comments) "\n"))) |
| 386 | (doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info)))) | 387 | (doc-ext (nth 2 (assoc package tit-quail-cxterm-package-ext-info)))) |
| 387 | (if comments | 388 | (if comments |
| 388 | (setq doc (concat doc "\n" comments "\n"))) | 389 | (setq doc (concat doc "\n" comments "\n"))) |
| 389 | (if doc-ext | 390 | (if doc-ext |
| @@ -476,6 +477,9 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, | |||
| 476 | 477 | ||
| 477 | ;;;###autoload | 478 | ;;;###autoload |
| 478 | (defun titdic-convert (filename &optional dirname) | 479 | (defun titdic-convert (filename &optional dirname) |
| 480 | (declare (obsolete tit-dic-convert "30.1")) | ||
| 481 | (tit-dic-convert filename dirname)) | ||
| 482 | (defun tit-dic-convert (filename &optional dirname) | ||
| 479 | "Convert a TIT dictionary of FILENAME into a Quail package. | 483 | "Convert a TIT dictionary of FILENAME into a Quail package. |
| 480 | Optional argument DIRNAME if specified is the directory name under which | 484 | Optional argument DIRNAME if specified is the directory name under which |
| 481 | the generated Quail package is saved." | 485 | the generated Quail package is saved." |
| @@ -531,21 +535,24 @@ the generated Quail package is saved." | |||
| 531 | 535 | ||
| 532 | ;;;###autoload | 536 | ;;;###autoload |
| 533 | (defun batch-titdic-convert (&optional force) | 537 | (defun batch-titdic-convert (&optional force) |
| 534 | "Run `titdic-convert' on the files remaining on the command line. | 538 | (declare (obsolete batch-tit-dic-convert "30.1")) |
| 539 | (batch-tit-dic-convert force)) | ||
| 540 | (defun batch-tit-dic-convert (&optional force) | ||
| 541 | "Run `tit-dic-convert' on the files remaining on the command line. | ||
| 535 | Use this from the command line, with `-batch'; | 542 | Use this from the command line, with `-batch'; |
| 536 | it won't work in an interactive Emacs. | 543 | it won't work in an interactive Emacs. |
| 537 | For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to | 544 | For example, invoke \"emacs -batch -f batch-tit-dic-convert XXX.tit\" to |
| 538 | generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\". | 545 | generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\". |
| 539 | To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | 546 | To get complete usage, invoke \"emacs -batch -f batch-tit-dic-convert -h\"." |
| 540 | (defvar command-line-args-left) ; Avoid compiler warning. | 547 | (defvar command-line-args-left) ; Avoid compiler warning. |
| 541 | (if (not noninteractive) | 548 | (if (not noninteractive) |
| 542 | (error "`batch-titdic-convert' should be used only with -batch")) | 549 | (error "`batch-tit-dic-convert' should be used only with -batch")) |
| 543 | (if (string= (car command-line-args-left) "-h") | 550 | (if (string= (car command-line-args-left) "-h") |
| 544 | (progn | 551 | (progn |
| 545 | (message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:") | 552 | (message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:") |
| 546 | (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit") | 553 | (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert XXX.tit YYY.tit") |
| 547 | (message "To convert XXX.tit into DIR/xxx.el:") | 554 | (message "To convert XXX.tit into DIR/xxx.el:") |
| 548 | (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit")) | 555 | (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert -dir DIR XXX.tit")) |
| 549 | (let (targetdir filename files file) | 556 | (let (targetdir filename files file) |
| 550 | (if (string= (car command-line-args-left) "-dir") | 557 | (if (string= (car command-line-args-left) "-dir") |
| 551 | (progn | 558 | (progn |
| @@ -564,7 +571,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 564 | (when (or force | 571 | (when (or force |
| 565 | (file-newer-than-file-p | 572 | (file-newer-than-file-p |
| 566 | file (tit-make-quail-package-file-name file targetdir))) | 573 | file (tit-make-quail-package-file-name file targetdir))) |
| 567 | (titdic-convert file targetdir)) | 574 | (tit-dic-convert file targetdir)) |
| 568 | (setq files (cdr files))) | 575 | (setq files (cdr files))) |
| 569 | (setq command-line-args-left (cdr command-line-args-left))))) | 576 | (setq command-line-args-left (cdr command-line-args-left))))) |
| 570 | (kill-emacs 0)) | 577 | (kill-emacs 0)) |
| @@ -583,10 +590,11 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 583 | ;; COPYRIGHT-NOTICE ;; Copyright notice of the source dictionary. | 590 | ;; COPYRIGHT-NOTICE ;; Copyright notice of the source dictionary. |
| 584 | ;; ) | 591 | ;; ) |
| 585 | 592 | ||
| 586 | (defvar quail-misc-package-ext-info | 593 | (define-obsolete-variable-alias 'quail-misc-package-ext-info 'tit-quail-misc-package-ext-info "30.1") |
| 594 | (defvar tit-quail-misc-package-ext-info | ||
| 587 | '(("chinese-b5-tsangchi" "倉B" | 595 | '(("chinese-b5-tsangchi" "倉B" |
| 588 | "cangjie-table.b5" big5 "tsang-b5.el" | 596 | "cangjie-table.b5" big5 "tsang-b5.el" |
| 589 | tsang-b5-converter | 597 | tit--tsang-b5-converter |
| 590 | "\ | 598 | "\ |
| 591 | ;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw> | 599 | ;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw> |
| 592 | ;; # | 600 | ;; # |
| @@ -596,7 +604,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 596 | 604 | ||
| 597 | ("chinese-b5-quick" "簡B" | 605 | ("chinese-b5-quick" "簡B" |
| 598 | "cangjie-table.b5" big5 "quick-b5.el" | 606 | "cangjie-table.b5" big5 "quick-b5.el" |
| 599 | quick-b5-converter | 607 | tit--quick-b5-converter |
| 600 | "\ | 608 | "\ |
| 601 | ;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw> | 609 | ;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw> |
| 602 | ;; # | 610 | ;; # |
| @@ -606,7 +614,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 606 | 614 | ||
| 607 | ("chinese-cns-tsangchi" "倉C" | 615 | ("chinese-cns-tsangchi" "倉C" |
| 608 | "cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el" | 616 | "cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el" |
| 609 | tsang-cns-converter | 617 | tit--tsang-cns-converter |
| 610 | "\ | 618 | "\ |
| 611 | ;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw> | 619 | ;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw> |
| 612 | ;; # | 620 | ;; # |
| @@ -616,7 +624,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 616 | 624 | ||
| 617 | ("chinese-cns-quick" "簡C" | 625 | ("chinese-cns-quick" "簡C" |
| 618 | "cangjie-table.cns" iso-2022-cn-ext "quick-cns.el" | 626 | "cangjie-table.cns" iso-2022-cn-ext "quick-cns.el" |
| 619 | quick-cns-converter | 627 | tit--quick-cns-converter |
| 620 | "\ | 628 | "\ |
| 621 | ;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw> | 629 | ;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw> |
| 622 | ;; # | 630 | ;; # |
| @@ -626,7 +634,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 626 | 634 | ||
| 627 | ("chinese-py" "拼G" | 635 | ("chinese-py" "拼G" |
| 628 | "pinyin.map" cn-gb-2312 "PY.el" | 636 | "pinyin.map" cn-gb-2312 "PY.el" |
| 629 | py-converter | 637 | tit--py-converter |
| 630 | "\ | 638 | "\ |
| 631 | ;; \"pinyin.map\" is included in a free package called CCE. It is | 639 | ;; \"pinyin.map\" is included in a free package called CCE. It is |
| 632 | ;; available at: [link needs updating -- SK 2021-09-27] | 640 | ;; available at: [link needs updating -- SK 2021-09-27] |
| @@ -654,7 +662,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 654 | 662 | ||
| 655 | ("chinese-ziranma" "自然" | 663 | ("chinese-ziranma" "自然" |
| 656 | "ziranma.cin" cn-gb-2312 "ZIRANMA.el" | 664 | "ziranma.cin" cn-gb-2312 "ZIRANMA.el" |
| 657 | ziranma-converter | 665 | tit--ziranma-converter |
| 658 | "\ | 666 | "\ |
| 659 | ;; \"ziranma.cin\" is included in a free package called CCE. It is | 667 | ;; \"ziranma.cin\" is included in a free package called CCE. It is |
| 660 | ;; available at: [link needs updating -- SK 2021-09-27] | 668 | ;; available at: [link needs updating -- SK 2021-09-27] |
| @@ -682,7 +690,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 682 | 690 | ||
| 683 | ("chinese-ctlau" "刘粤" | 691 | ("chinese-ctlau" "刘粤" |
| 684 | "CTLau.html" cn-gb-2312 "CTLau.el" | 692 | "CTLau.html" cn-gb-2312 "CTLau.el" |
| 685 | ctlau-gb-converter | 693 | tit--ctlau-gb-converter |
| 686 | "\ | 694 | "\ |
| 687 | ;; \"CTLau.html\" is available at: | 695 | ;; \"CTLau.html\" is available at: |
| 688 | ;; | 696 | ;; |
| @@ -707,7 +715,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 707 | 715 | ||
| 708 | ("chinese-ctlaub" "劉粵" | 716 | ("chinese-ctlaub" "劉粵" |
| 709 | "CTLau-b5.html" big5 "CTLau-b5.el" | 717 | "CTLau-b5.html" big5 "CTLau-b5.el" |
| 710 | ctlau-b5-converter | 718 | tit--ctlau-b5-converter |
| 711 | "\ | 719 | "\ |
| 712 | ;; \"CTLau-b5.html\" is available at: | 720 | ;; \"CTLau-b5.html\" is available at: |
| 713 | ;; | 721 | ;; |
| @@ -740,7 +748,8 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 740 | ;; input method is for inputting Big5 characters. Otherwise the input | 748 | ;; input method is for inputting Big5 characters. Otherwise the input |
| 741 | ;; method is for inputting CNS characters. | 749 | ;; method is for inputting CNS characters. |
| 742 | 750 | ||
| 743 | (defun tsang-quick-converter (dicbuf tsang-p big5-p) | 751 | (define-obsolete-function-alias 'tsang-quick-converter #'tit--tsang-quick-converter "30.1") |
| 752 | (defun tit--tsang-quick-converter (dicbuf tsang-p big5-p) | ||
| 744 | (let ((fulltitle (if tsang-p "倉頡" "簡易")) | 753 | (let ((fulltitle (if tsang-p "倉頡" "簡易")) |
| 745 | dic) | 754 | dic) |
| 746 | (goto-char (point-max)) | 755 | (goto-char (point-max)) |
| @@ -822,23 +831,28 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." | |||
| 822 | (if big5-p (nth 1 elt) (nth 2 elt)))))) | 831 | (if big5-p (nth 1 elt) (nth 2 elt)))))) |
| 823 | (insert ")\n"))) | 832 | (insert ")\n"))) |
| 824 | 833 | ||
| 825 | (defun tsang-b5-converter (dicbuf) | 834 | (define-obsolete-function-alias 'tsang-b5-converter #'tit--tsang-b5-converter "30.1") |
| 826 | (tsang-quick-converter dicbuf t t)) | 835 | (defun tit--tsang-b5-converter (dicbuf) |
| 836 | (tit--tsang-quick-converter dicbuf t t)) | ||
| 827 | 837 | ||
| 828 | (defun quick-b5-converter (dicbuf) | 838 | (define-obsolete-function-alias 'quick-b5-converter #'tit--quick-b5-converter "30.1") |
| 829 | (tsang-quick-converter dicbuf nil t)) | 839 | (defun tit--quick-b5-converter (dicbuf) |
| 840 | (tit--tsang-quick-converter dicbuf nil t)) | ||
| 830 | 841 | ||
| 831 | (defun tsang-cns-converter (dicbuf) | 842 | (define-obsolete-function-alias 'tsang-cns-converter #'tit--tsang-cns-converter "30.1") |
| 832 | (tsang-quick-converter dicbuf t nil)) | 843 | (defun tit--tsang-cns-converter (dicbuf) |
| 844 | (tit--tsang-quick-converter dicbuf t nil)) | ||
| 833 | 845 | ||
| 834 | (defun quick-cns-converter (dicbuf) | 846 | (define-obsolete-function-alias 'quick-cns-converter #'tit--quick-cns-converter "30.1") |
| 835 | (tsang-quick-converter dicbuf nil nil)) | 847 | (defun tit--quick-cns-converter (dicbuf) |
| 848 | (tit--tsang-quick-converter dicbuf nil nil)) | ||
| 836 | 849 | ||
| 837 | ;; Generate a code of a Quail package in the current buffer from | 850 | ;; Generate a code of a Quail package in the current buffer from |
| 838 | ;; Pinyin dictionary in the buffer DICBUF. The input method name of | 851 | ;; Pinyin dictionary in the buffer DICBUF. The input method name of |
| 839 | ;; the Quail package is NAME, and the title string is TITLE. | 852 | ;; the Quail package is NAME, and the title string is TITLE. |
| 840 | 853 | ||
| 841 | (defun py-converter (dicbuf) | 854 | (define-obsolete-function-alias 'py-converter #'tit--py-converter "30.1") |
| 855 | (defun tit--py-converter (dicbuf) | ||
| 842 | (goto-char (point-max)) | 856 | (goto-char (point-max)) |
| 843 | (insert (format "%S\n" "汉字输入∷拼音∷ | 857 | (insert (format "%S\n" "汉字输入∷拼音∷ |
| 844 | 858 | ||
| @@ -913,7 +927,8 @@ method `chinese-tonepy' with which you must specify tones by digits | |||
| 913 | ;; Ziranma dictionary in the buffer DICBUF. The input method name of | 927 | ;; Ziranma dictionary in the buffer DICBUF. The input method name of |
| 914 | ;; the Quail package is NAME, and the title string is TITLE. | 928 | ;; the Quail package is NAME, and the title string is TITLE. |
| 915 | 929 | ||
| 916 | (defun ziranma-converter (dicbuf) | 930 | (define-obsolete-function-alias 'ziranma-converter #'tit--ziranma-converter "30.1") |
| 931 | (defun tit--ziranma-converter (dicbuf) | ||
| 917 | (let (dic) | 932 | (let (dic) |
| 918 | (with-current-buffer dicbuf | 933 | (with-current-buffer dicbuf |
| 919 | (goto-char (point-min)) | 934 | (goto-char (point-min)) |
| @@ -1022,7 +1037,8 @@ To input symbols and punctuation, type `/' followed by one of `a' to | |||
| 1022 | ;; method name of the Quail package is NAME, and the title string is | 1037 | ;; method name of the Quail package is NAME, and the title string is |
| 1023 | ;; TITLE. DESCRIPTION is the string shown by describe-input-method. | 1038 | ;; TITLE. DESCRIPTION is the string shown by describe-input-method. |
| 1024 | 1039 | ||
| 1025 | (defun ctlau-converter (dicbuf description) | 1040 | (define-obsolete-function-alias 'ctlau-converter #'tit--ctlau-converter "30.1") |
| 1041 | (defun tit--ctlau-converter (dicbuf description) | ||
| 1026 | (goto-char (point-max)) | 1042 | (goto-char (point-max)) |
| 1027 | (insert (format "%S\n" description)) | 1043 | (insert (format "%S\n" description)) |
| 1028 | (insert " '((\"\C-?\" . quail-delete-last-char) | 1044 | (insert " '((\"\C-?\" . quail-delete-last-char) |
| @@ -1071,8 +1087,9 @@ To input symbols and punctuation, type `/' followed by one of `a' to | |||
| 1071 | (forward-line 1))) | 1087 | (forward-line 1))) |
| 1072 | (insert ")\n")) | 1088 | (insert ")\n")) |
| 1073 | 1089 | ||
| 1074 | (defun ctlau-gb-converter (dicbuf) | 1090 | (define-obsolete-function-alias 'ctlau-gb-converter #'tit--ctlau-gb-converter "30.1") |
| 1075 | (ctlau-converter dicbuf | 1091 | (defun tit--ctlau-gb-converter (dicbuf) |
| 1092 | (tit--ctlau-converter dicbuf | ||
| 1076 | "汉字输入∷刘锡祥式粤音∷ | 1093 | "汉字输入∷刘锡祥式粤音∷ |
| 1077 | 1094 | ||
| 1078 | 刘锡祥式粤语注音方案 | 1095 | 刘锡祥式粤语注音方案 |
| @@ -1085,8 +1102,9 @@ To input symbols and punctuation, type `/' followed by one of `a' to | |||
| 1085 | Some infrequent GB characters are accessed by typing \\, followed by | 1102 | Some infrequent GB characters are accessed by typing \\, followed by |
| 1086 | the Cantonese romanization of the respective radical (部首).")) | 1103 | the Cantonese romanization of the respective radical (部首).")) |
| 1087 | 1104 | ||
| 1088 | (defun ctlau-b5-converter (dicbuf) | 1105 | (define-obsolete-function-alias 'ctlau-b5-converter #'tit--ctlau-b5-converter "30.1") |
| 1089 | (ctlau-converter dicbuf | 1106 | (defun tit--ctlau-b5-converter (dicbuf) |
| 1107 | (tit--ctlau-converter dicbuf | ||
| 1090 | "漢字輸入:劉錫祥式粵音: | 1108 | "漢字輸入:劉錫祥式粵音: |
| 1091 | 1109 | ||
| 1092 | 劉錫祥式粵語注音方案 | 1110 | 劉錫祥式粵語注音方案 |
| @@ -1101,14 +1119,15 @@ To input symbols and punctuation, type `/' followed by one of `a' to | |||
| 1101 | 1119 | ||
| 1102 | (declare-function dos-8+3-filename "dos-fns.el" (filename)) | 1120 | (declare-function dos-8+3-filename "dos-fns.el" (filename)) |
| 1103 | 1121 | ||
| 1104 | (defun miscdic-convert (filename &optional dirname) | 1122 | (define-obsolete-function-alias 'miscdic-convert #'tit-miscdic-convert "30.1") |
| 1123 | (defun tit-miscdic-convert (filename &optional dirname) | ||
| 1105 | "Convert a dictionary file FILENAME into a Quail package. | 1124 | "Convert a dictionary file FILENAME into a Quail package. |
| 1106 | Optional argument DIRNAME if specified is the directory name under which | 1125 | Optional argument DIRNAME if specified is the directory name under which |
| 1107 | the generated Quail package is saved." | 1126 | the generated Quail package is saved." |
| 1108 | (interactive "FInput method dictionary file: ") | 1127 | (interactive "FInput method dictionary file: ") |
| 1109 | (or (file-readable-p filename) | 1128 | (or (file-readable-p filename) |
| 1110 | (error "%s does not exist" filename)) | 1129 | (error "%s does not exist" filename)) |
| 1111 | (let ((tail quail-misc-package-ext-info) | 1130 | (let ((tail tit-quail-misc-package-ext-info) |
| 1112 | coding-system-for-write | 1131 | coding-system-for-write |
| 1113 | slot | 1132 | slot |
| 1114 | name title dicfile coding quailfile converter copyright) | 1133 | name title dicfile coding quailfile converter copyright) |
| @@ -1137,7 +1156,7 @@ the generated Quail package is saved." | |||
| 1137 | ;; Explicitly set eol format to `unix'. | 1156 | ;; Explicitly set eol format to `unix'. |
| 1138 | (setq coding-system-for-write 'utf-8-unix) | 1157 | (setq coding-system-for-write 'utf-8-unix) |
| 1139 | (with-temp-file (expand-file-name quailfile dirname) | 1158 | (with-temp-file (expand-file-name quailfile dirname) |
| 1140 | (generate-lisp-file-heading quailfile 'miscdic-convert) | 1159 | (generate-lisp-file-heading quailfile 'tit-miscdic-convert) |
| 1141 | (insert (format-message ";; Quail package `%s'\n" name)) | 1160 | (insert (format-message ";; Quail package `%s'\n" name)) |
| 1142 | (insert ";; Source dictionary file: " dicfile "\n") | 1161 | (insert ";; Source dictionary file: " dicfile "\n") |
| 1143 | (insert ";; Copyright notice of the source file\n") | 1162 | (insert ";; Copyright notice of the source file\n") |
| @@ -1164,15 +1183,17 @@ the generated Quail package is saved." | |||
| 1164 | quailfile :inhibit-provide t :compile t :coding nil))) | 1183 | quailfile :inhibit-provide t :compile t :coding nil))) |
| 1165 | (setq tail (cdr tail))))) | 1184 | (setq tail (cdr tail))))) |
| 1166 | 1185 | ||
| 1167 | (defun batch-miscdic-convert () | 1186 | ;; Used in `Makefile.in'. |
| 1168 | "Run `miscdic-convert' on the files remaining on the command line. | 1187 | (define-obsolete-function-alias 'batch-miscdic-convert #'batch-tit-miscdic-convert "30.1") |
| 1188 | (defun batch-tit-miscdic-convert () | ||
| 1189 | "Run `tit-miscdic-convert' on the files remaining on the command line. | ||
| 1169 | Use this from the command line, with `-batch'; | 1190 | Use this from the command line, with `-batch'; |
| 1170 | it won't work in an interactive Emacs. | 1191 | it won't work in an interactive Emacs. |
| 1171 | If there's an argument \"-dir\", the next argument specifies a directory | 1192 | If there's an argument \"-dir\", the next argument specifies a directory |
| 1172 | to store generated Quail packages." | 1193 | to store generated Quail packages." |
| 1173 | (defvar command-line-args-left) ; Avoid compiler warning. | 1194 | (defvar command-line-args-left) ; Avoid compiler warning. |
| 1174 | (if (not noninteractive) | 1195 | (if (not noninteractive) |
| 1175 | (error "`batch-miscdic-convert' should be used only with -batch")) | 1196 | (error "`batch-tit-miscdic-convert' should be used only with -batch")) |
| 1176 | (let ((dir default-directory) | 1197 | (let ((dir default-directory) |
| 1177 | filename) | 1198 | filename) |
| 1178 | (while command-line-args-left | 1199 | (while command-line-args-left |
| @@ -1186,11 +1207,13 @@ to store generated Quail packages." | |||
| 1186 | (if (file-directory-p filename) | 1207 | (if (file-directory-p filename) |
| 1187 | (dolist (file (directory-files filename t nil t)) | 1208 | (dolist (file (directory-files filename t nil t)) |
| 1188 | (or (file-directory-p file) | 1209 | (or (file-directory-p file) |
| 1189 | (miscdic-convert file dir))) | 1210 | (tit-miscdic-convert file dir))) |
| 1190 | (miscdic-convert filename dir)))) | 1211 | (tit-miscdic-convert filename dir)))) |
| 1191 | (kill-emacs 0)) | 1212 | (kill-emacs 0)) |
| 1192 | 1213 | ||
| 1193 | (defun pinyin-convert () | 1214 | ;; Used in `Makefile.in'. |
| 1215 | (define-obsolete-function-alias 'pinyin-convert #'tit-pinyin-convert "30.1") | ||
| 1216 | (defun tit-pinyin-convert () | ||
| 1194 | "Convert text file pinyin.map into an elisp library. | 1217 | "Convert text file pinyin.map into an elisp library. |
| 1195 | The library is named pinyin.el, and contains the constant | 1218 | The library is named pinyin.el, and contains the constant |
| 1196 | `pinyin-character-map'." | 1219 | `pinyin-character-map'." |
diff --git a/lisp/loadup.el b/lisp/loadup.el index c498c0e53af..c6a8dcbb909 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el | |||
| @@ -635,6 +635,8 @@ directory got moved. This is set to be a pair in the form of: | |||
| 635 | (unwind-protect | 635 | (unwind-protect |
| 636 | (let ((tmp-dump-mode dump-mode) | 636 | (let ((tmp-dump-mode dump-mode) |
| 637 | (dump-mode nil) | 637 | (dump-mode nil) |
| 638 | ;; Set `lexical-binding' to nil by default | ||
| 639 | ;; in the dumped Emacs. | ||
| 638 | (lexical-binding nil)) | 640 | (lexical-binding nil)) |
| 639 | (if (member tmp-dump-mode '("pdump" "pbootstrap")) | 641 | (if (member tmp-dump-mode '("pdump" "pbootstrap")) |
| 640 | (dump-emacs-portable (expand-file-name output invocation-directory)) | 642 | (dump-emacs-portable (expand-file-name output invocation-directory)) |
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 668cae05521..cfdbc1b2509 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el | |||
| @@ -1845,7 +1845,7 @@ place. It affects how `mail-extract-address-components' works." | |||
| 1845 | ;; https://en.wikipedia.org/wiki/List_of_Internet_top-level_domains | 1845 | ;; https://en.wikipedia.org/wiki/List_of_Internet_top-level_domains |
| 1846 | 1846 | ||
| 1847 | (defconst mail-extr-all-top-level-domains | 1847 | (defconst mail-extr-all-top-level-domains |
| 1848 | (let ((ob (make-vector 739 0))) | 1848 | (let ((ob (obarray-make 739))) |
| 1849 | (mapc | 1849 | (mapc |
| 1850 | (lambda (x) | 1850 | (lambda (x) |
| 1851 | (put (intern (downcase (car x)) ob) | 1851 | (put (intern (downcase (car x)) ob) |
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 68d325ea261..c8006294a7d 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el | |||
| @@ -171,7 +171,7 @@ no aliases, which is represented by this being a table with no entries.)") | |||
| 171 | ;;;###autoload | 171 | ;;;###autoload |
| 172 | (defun mail-abbrevs-setup () | 172 | (defun mail-abbrevs-setup () |
| 173 | "Initialize use of the `mailabbrev' package." | 173 | "Initialize use of the `mailabbrev' package." |
| 174 | (if (and (not (vectorp mail-abbrevs)) | 174 | (if (and (not (obarrayp mail-abbrevs)) |
| 175 | (file-exists-p mail-personal-alias-file)) | 175 | (file-exists-p mail-personal-alias-file)) |
| 176 | (progn | 176 | (progn |
| 177 | (setq mail-abbrev-modtime | 177 | (setq mail-abbrev-modtime |
| @@ -196,7 +196,7 @@ no aliases, which is represented by this being a table with no entries.)") | |||
| 196 | "Read mail aliases from personal mail alias file and set `mail-abbrevs'. | 196 | "Read mail aliases from personal mail alias file and set `mail-abbrevs'. |
| 197 | By default this is the file specified by `mail-personal-alias-file'." | 197 | By default this is the file specified by `mail-personal-alias-file'." |
| 198 | (setq file (expand-file-name (or file mail-personal-alias-file))) | 198 | (setq file (expand-file-name (or file mail-personal-alias-file))) |
| 199 | (if (vectorp mail-abbrevs) | 199 | (if (obarrayp mail-abbrevs) |
| 200 | nil | 200 | nil |
| 201 | (setq mail-abbrevs nil) | 201 | (setq mail-abbrevs nil) |
| 202 | (define-abbrev-table 'mail-abbrevs '())) | 202 | (define-abbrev-table 'mail-abbrevs '())) |
| @@ -278,7 +278,7 @@ double-quotes." | |||
| 278 | ;; true, and we do some evil space->comma hacking like /bin/mail does. | 278 | ;; true, and we do some evil space->comma hacking like /bin/mail does. |
| 279 | (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") | 279 | (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") |
| 280 | ;; Read the defaults first, if we have not done so. | 280 | ;; Read the defaults first, if we have not done so. |
| 281 | (unless (vectorp mail-abbrevs) (build-mail-abbrevs)) | 281 | (unless (obarrayp mail-abbrevs) (build-mail-abbrevs)) |
| 282 | ;; strip garbage from front and end | 282 | ;; strip garbage from front and end |
| 283 | (if (string-match "\\`[ \t\n,]+" definition) | 283 | (if (string-match "\\`[ \t\n,]+" definition) |
| 284 | (setq definition (substring definition (match-end 0)))) | 284 | (setq definition (substring definition (match-end 0)))) |
| @@ -355,7 +355,7 @@ double-quotes." | |||
| 355 | (if mail-abbrev-aliases-need-to-be-resolved | 355 | (if mail-abbrev-aliases-need-to-be-resolved |
| 356 | (progn | 356 | (progn |
| 357 | ;; (message "Resolving mail aliases...") | 357 | ;; (message "Resolving mail aliases...") |
| 358 | (if (vectorp mail-abbrevs) | 358 | (if (obarrayp mail-abbrevs) |
| 359 | (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs)) | 359 | (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs)) |
| 360 | (setq mail-abbrev-aliases-need-to-be-resolved nil) | 360 | (setq mail-abbrev-aliases-need-to-be-resolved nil) |
| 361 | ;; (message "Resolving mail aliases... done.") | 361 | ;; (message "Resolving mail aliases... done.") |
| @@ -555,9 +555,9 @@ of a mail alias. The value is set up, buffer-local, when first needed.") | |||
| 555 | (defun mail-abbrev-insert-alias (&optional alias) | 555 | (defun mail-abbrev-insert-alias (&optional alias) |
| 556 | "Prompt for and insert a mail alias." | 556 | "Prompt for and insert a mail alias." |
| 557 | (interactive (progn | 557 | (interactive (progn |
| 558 | (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) | 558 | (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup)) |
| 559 | (list (completing-read "Expand alias: " mail-abbrevs nil t)))) | 559 | (list (completing-read "Expand alias: " mail-abbrevs nil t)))) |
| 560 | (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) | 560 | (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup)) |
| 561 | (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) "")) | 561 | (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) "")) |
| 562 | (mail-abbrev-expand-hook)) | 562 | (mail-abbrev-expand-hook)) |
| 563 | 563 | ||
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 85eaec33660..d422383acdf 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el | |||
| @@ -805,8 +805,8 @@ that knows the exact ordering of the \\( \\) subexpressions.") | |||
| 805 | "\\(" cite-chars "[ \t]*\\)\\)+\\)" | 805 | "\\(" cite-chars "[ \t]*\\)\\)+\\)" |
| 806 | "\\(.*\\)") | 806 | "\\(.*\\)") |
| 807 | (beginning-of-line) (end-of-line) | 807 | (beginning-of-line) (end-of-line) |
| 808 | (1 font-lock-comment-delimiter-face nil t) | 808 | (1 'font-lock-comment-delimiter-face nil t) |
| 809 | (5 font-lock-comment-face nil t))) | 809 | (5 'font-lock-comment-face nil t))) |
| 810 | '("^\\(X-[a-z0-9-]+\\|In-Reply-To\\|Date\\):.*\\(\n[ \t]+.*\\)*$" | 810 | '("^\\(X-[a-z0-9-]+\\|In-Reply-To\\|Date\\):.*\\(\n[ \t]+.*\\)*$" |
| 811 | . 'rmail-header-name)))) | 811 | . 'rmail-header-name)))) |
| 812 | "Additional expressions to highlight in Rmail mode.") | 812 | "Additional expressions to highlight in Rmail mode.") |
| @@ -815,7 +815,7 @@ that knows the exact ordering of the \\( \\) subexpressions.") | |||
| 815 | (defun rmail-pop-to-buffer (&rest args) | 815 | (defun rmail-pop-to-buffer (&rest args) |
| 816 | "Like `pop-to-buffer', but with `split-width-threshold' set to nil." | 816 | "Like `pop-to-buffer', but with `split-width-threshold' set to nil." |
| 817 | (let (split-width-threshold) | 817 | (let (split-width-threshold) |
| 818 | (apply 'pop-to-buffer args))) | 818 | (apply #'pop-to-buffer args))) |
| 819 | 819 | ||
| 820 | ;; Perform BODY in the summary buffer | 820 | ;; Perform BODY in the summary buffer |
| 821 | ;; in such a way that its cursor is properly updated in its own window. | 821 | ;; in such a way that its cursor is properly updated in its own window. |
| @@ -1008,66 +1008,66 @@ The buffer is expected to be narrowed to just the header of the message." | |||
| 1008 | (defvar rmail-mode-map | 1008 | (defvar rmail-mode-map |
| 1009 | (let ((map (make-keymap))) | 1009 | (let ((map (make-keymap))) |
| 1010 | (suppress-keymap map) | 1010 | (suppress-keymap map) |
| 1011 | (define-key map "a" 'rmail-add-label) | 1011 | (define-key map "a" #'rmail-add-label) |
| 1012 | (define-key map "b" 'rmail-bury) | 1012 | (define-key map "b" #'rmail-bury) |
| 1013 | (define-key map "c" 'rmail-continue) | 1013 | (define-key map "c" #'rmail-continue) |
| 1014 | (define-key map "d" 'rmail-delete-forward) | 1014 | (define-key map "d" #'rmail-delete-forward) |
| 1015 | (define-key map "\C-d" 'rmail-delete-backward) | 1015 | (define-key map "\C-d" #'rmail-delete-backward) |
| 1016 | (define-key map "e" 'rmail-edit-current-message) | 1016 | (define-key map "e" #'rmail-edit-current-message) |
| 1017 | ;; If you change this, change the rmail-resend menu-item's :keys. | 1017 | ;; If you change this, change the rmail-resend menu-item's :keys. |
| 1018 | (define-key map "f" 'rmail-forward) | 1018 | (define-key map "f" #'rmail-forward) |
| 1019 | (define-key map "g" 'rmail-get-new-mail) | 1019 | (define-key map "g" #'rmail-get-new-mail) |
| 1020 | (define-key map "h" 'rmail-summary) | 1020 | (define-key map "h" #'rmail-summary) |
| 1021 | (define-key map "i" 'rmail-input) | 1021 | (define-key map "i" #'rmail-input) |
| 1022 | (define-key map "j" 'rmail-show-message) | 1022 | (define-key map "j" #'rmail-show-message) |
| 1023 | (define-key map "k" 'rmail-kill-label) | 1023 | (define-key map "k" #'rmail-kill-label) |
| 1024 | (define-key map "l" 'rmail-summary-by-labels) | 1024 | (define-key map "l" #'rmail-summary-by-labels) |
| 1025 | (define-key map "\e\C-h" 'rmail-summary) | 1025 | (define-key map "\e\C-h" #'rmail-summary) |
| 1026 | (define-key map "\e\C-l" 'rmail-summary-by-labels) | 1026 | (define-key map "\e\C-l" #'rmail-summary-by-labels) |
| 1027 | (define-key map "\e\C-r" 'rmail-summary-by-recipients) | 1027 | (define-key map "\e\C-r" #'rmail-summary-by-recipients) |
| 1028 | (define-key map "\e\C-s" 'rmail-summary-by-regexp) | 1028 | (define-key map "\e\C-s" #'rmail-summary-by-regexp) |
| 1029 | (define-key map "\e\C-f" 'rmail-summary-by-senders) | 1029 | (define-key map "\e\C-f" #'rmail-summary-by-senders) |
| 1030 | (define-key map "\e\C-t" 'rmail-summary-by-topic) | 1030 | (define-key map "\e\C-t" #'rmail-summary-by-topic) |
| 1031 | (define-key map "m" 'rmail-mail) | 1031 | (define-key map "m" #'rmail-mail) |
| 1032 | (define-key map "\em" 'rmail-retry-failure) | 1032 | (define-key map "\em" #'rmail-retry-failure) |
| 1033 | (define-key map "n" 'rmail-next-undeleted-message) | 1033 | (define-key map "n" #'rmail-next-undeleted-message) |
| 1034 | (define-key map "\en" 'rmail-next-message) | 1034 | (define-key map "\en" #'rmail-next-message) |
| 1035 | (define-key map "\e\C-n" 'rmail-next-labeled-message) | 1035 | (define-key map "\e\C-n" #'rmail-next-labeled-message) |
| 1036 | (define-key map "o" 'rmail-output) | 1036 | (define-key map "o" #'rmail-output) |
| 1037 | (define-key map "\C-o" 'rmail-output-as-seen) | 1037 | (define-key map "\C-o" #'rmail-output-as-seen) |
| 1038 | (define-key map "p" 'rmail-previous-undeleted-message) | 1038 | (define-key map "p" #'rmail-previous-undeleted-message) |
| 1039 | (define-key map "\ep" 'rmail-previous-message) | 1039 | (define-key map "\ep" #'rmail-previous-message) |
| 1040 | (define-key map "\e\C-p" 'rmail-previous-labeled-message) | 1040 | (define-key map "\e\C-p" #'rmail-previous-labeled-message) |
| 1041 | (define-key map "q" 'rmail-quit) | 1041 | (define-key map "q" #'rmail-quit) |
| 1042 | (define-key map "r" 'rmail-reply) | 1042 | (define-key map "r" #'rmail-reply) |
| 1043 | ;; I find I can't live without the default M-r command -- rms. | 1043 | ;; I find I can't live without the default M-r command -- rms. |
| 1044 | ;; (define-key rmail-mode-map "\er" 'rmail-search-backwards) | 1044 | ;; (define-key rmail-mode-map "\er" #'rmail-search-backwards) |
| 1045 | (define-key map "s" 'rmail-expunge-and-save) | 1045 | (define-key map "s" #'rmail-expunge-and-save) |
| 1046 | (define-key map "\es" 'rmail-search) | 1046 | (define-key map "\es" #'rmail-search) |
| 1047 | (define-key map "t" 'rmail-toggle-header) | 1047 | (define-key map "t" #'rmail-toggle-header) |
| 1048 | (define-key map "u" 'rmail-undelete-previous-message) | 1048 | (define-key map "u" #'rmail-undelete-previous-message) |
| 1049 | (define-key map "v" 'rmail-mime) | 1049 | (define-key map "v" #'rmail-mime) |
| 1050 | (define-key map "w" 'rmail-output-body-to-file) | 1050 | (define-key map "w" #'rmail-output-body-to-file) |
| 1051 | (define-key map "\C-c\C-w" 'rmail-widen) | 1051 | (define-key map "\C-c\C-w" #'rmail-widen) |
| 1052 | (define-key map "x" 'rmail-expunge) | 1052 | (define-key map "x" #'rmail-expunge) |
| 1053 | (define-key map "." 'rmail-beginning-of-message) | 1053 | (define-key map "." #'rmail-beginning-of-message) |
| 1054 | (define-key map "/" 'rmail-end-of-message) | 1054 | (define-key map "/" #'rmail-end-of-message) |
| 1055 | (define-key map "<" 'rmail-first-message) | 1055 | (define-key map "<" #'rmail-first-message) |
| 1056 | (define-key map ">" 'rmail-last-message) | 1056 | (define-key map ">" #'rmail-last-message) |
| 1057 | (define-key map " " 'scroll-up-command) | 1057 | (define-key map " " #'scroll-up-command) |
| 1058 | (define-key map [?\S-\ ] 'scroll-down-command) | 1058 | (define-key map [?\S-\ ] #'scroll-down-command) |
| 1059 | (define-key map "\177" 'scroll-down-command) | 1059 | (define-key map "\177" #'scroll-down-command) |
| 1060 | (define-key map "?" 'describe-mode) | 1060 | (define-key map "?" #'describe-mode) |
| 1061 | (define-key map "\C-c\C-d" 'rmail-epa-decrypt) | 1061 | (define-key map "\C-c\C-d" #'rmail-epa-decrypt) |
| 1062 | (define-key map "\C-c\C-s\C-d" 'rmail-sort-by-date) | 1062 | (define-key map "\C-c\C-s\C-d" #'rmail-sort-by-date) |
| 1063 | (define-key map "\C-c\C-s\C-s" 'rmail-sort-by-subject) | 1063 | (define-key map "\C-c\C-s\C-s" #'rmail-sort-by-subject) |
| 1064 | (define-key map "\C-c\C-s\C-a" 'rmail-sort-by-author) | 1064 | (define-key map "\C-c\C-s\C-a" #'rmail-sort-by-author) |
| 1065 | (define-key map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) | 1065 | (define-key map "\C-c\C-s\C-r" #'rmail-sort-by-recipient) |
| 1066 | (define-key map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) | 1066 | (define-key map "\C-c\C-s\C-c" #'rmail-sort-by-correspondent) |
| 1067 | (define-key map "\C-c\C-s\C-l" 'rmail-sort-by-lines) | 1067 | (define-key map "\C-c\C-s\C-l" #'rmail-sort-by-lines) |
| 1068 | (define-key map "\C-c\C-s\C-k" 'rmail-sort-by-labels) | 1068 | (define-key map "\C-c\C-s\C-k" #'rmail-sort-by-labels) |
| 1069 | (define-key map "\C-c\C-n" 'rmail-next-same-subject) | 1069 | (define-key map "\C-c\C-n" #'rmail-next-same-subject) |
| 1070 | (define-key map "\C-c\C-p" 'rmail-previous-same-subject) | 1070 | (define-key map "\C-c\C-p" #'rmail-previous-same-subject) |
| 1071 | 1071 | ||
| 1072 | 1072 | ||
| 1073 | (define-key map [menu-bar] (make-sparse-keymap)) | 1073 | (define-key map [menu-bar] (make-sparse-keymap)) |
| @@ -1344,9 +1344,9 @@ Instead, these commands are available: | |||
| 1344 | (setq local-abbrev-table text-mode-abbrev-table) | 1344 | (setq local-abbrev-table text-mode-abbrev-table) |
| 1345 | ;; Functions to support buffer swapping: | 1345 | ;; Functions to support buffer swapping: |
| 1346 | (add-hook 'write-region-annotate-functions | 1346 | (add-hook 'write-region-annotate-functions |
| 1347 | 'rmail-write-region-annotate nil t) | 1347 | #'rmail-write-region-annotate nil t) |
| 1348 | (add-hook 'kill-buffer-hook 'rmail-mode-kill-buffer-hook nil t) | 1348 | (add-hook 'kill-buffer-hook #'rmail-mode-kill-buffer-hook nil t) |
| 1349 | (add-hook 'change-major-mode-hook 'rmail-change-major-mode-hook nil t)) | 1349 | (add-hook 'change-major-mode-hook #'rmail-change-major-mode-hook nil t)) |
| 1350 | 1350 | ||
| 1351 | (defun rmail-generate-viewer-buffer () | 1351 | (defun rmail-generate-viewer-buffer () |
| 1352 | "Return a reusable buffer suitable for viewing messages. | 1352 | "Return a reusable buffer suitable for viewing messages. |
| @@ -1363,7 +1363,7 @@ Create the buffer if necessary." | |||
| 1363 | (file-name-nondirectory | 1363 | (file-name-nondirectory |
| 1364 | (or buffer-file-name (buffer-name))))))) | 1364 | (or buffer-file-name (buffer-name))))))) |
| 1365 | (with-current-buffer newbuf | 1365 | (with-current-buffer newbuf |
| 1366 | (add-hook 'kill-buffer-hook 'rmail-view-buffer-kill-buffer-hook nil t)) | 1366 | (add-hook 'kill-buffer-hook #'rmail-view-buffer-kill-buffer-hook nil t)) |
| 1367 | newbuf))) | 1367 | newbuf))) |
| 1368 | 1368 | ||
| 1369 | (defun rmail-swap-buffers () | 1369 | (defun rmail-swap-buffers () |
| @@ -1479,7 +1479,7 @@ If so restore the actual mbox message collection." | |||
| 1479 | ;; Don't turn off auto-saving based on the size of the buffer | 1479 | ;; Don't turn off auto-saving based on the size of the buffer |
| 1480 | ;; because that code does not understand buffer-swapping. | 1480 | ;; because that code does not understand buffer-swapping. |
| 1481 | (setq-local auto-save-include-big-deletions t) | 1481 | (setq-local auto-save-include-big-deletions t) |
| 1482 | (setq-local revert-buffer-function 'rmail-revert) | 1482 | (setq-local revert-buffer-function #'rmail-revert) |
| 1483 | (setq-local font-lock-defaults | 1483 | (setq-local font-lock-defaults |
| 1484 | '(rmail-font-lock-keywords | 1484 | '(rmail-font-lock-keywords |
| 1485 | t t nil nil | 1485 | t t nil nil |
| @@ -1490,7 +1490,7 @@ If so restore the actual mbox message collection." | |||
| 1490 | (setq-local file-precious-flag t) | 1490 | (setq-local file-precious-flag t) |
| 1491 | (setq-local desktop-save-buffer t) | 1491 | (setq-local desktop-save-buffer t) |
| 1492 | (setq-local save-buffer-coding-system 'no-conversion) | 1492 | (setq-local save-buffer-coding-system 'no-conversion) |
| 1493 | (setq next-error-move-function 'rmail-next-error-move)) | 1493 | (setq next-error-move-function #'rmail-next-error-move)) |
| 1494 | 1494 | ||
| 1495 | ;; Handle M-x revert-buffer done in an rmail-mode buffer. | 1495 | ;; Handle M-x revert-buffer done in an rmail-mode buffer. |
| 1496 | (defun rmail-revert (arg noconfirm) | 1496 | (defun rmail-revert (arg noconfirm) |
| @@ -1606,7 +1606,7 @@ The duplicate copy goes into the Rmail file just after the original." | |||
| 1606 | (files (directory-files start t rmail-secondary-file-regexp))) | 1606 | (files (directory-files start t rmail-secondary-file-regexp))) |
| 1607 | ;; Sort here instead of in directory-files | 1607 | ;; Sort here instead of in directory-files |
| 1608 | ;; because this list is usually much shorter. | 1608 | ;; because this list is usually much shorter. |
| 1609 | (sort files 'string<)))) | 1609 | (sort files #'string<)))) |
| 1610 | 1610 | ||
| 1611 | (defun rmail-list-to-menu (menu-name l action &optional full-name) | 1611 | (defun rmail-list-to-menu (menu-name l action &optional full-name) |
| 1612 | (let ((menu (make-sparse-keymap menu-name)) | 1612 | (let ((menu (make-sparse-keymap menu-name)) |
| @@ -2026,7 +2026,7 @@ Value is the size of the newly read mail after conversion." | |||
| 2026 | rmail-movemail-flags) | 2026 | rmail-movemail-flags) |
| 2027 | (list file tofile) | 2027 | (list file tofile) |
| 2028 | (if password (list password) nil)))) | 2028 | (if password (list password) nil)))) |
| 2029 | (apply 'call-process args)) | 2029 | (apply #'call-process args)) |
| 2030 | (if (not (buffer-modified-p errors)) | 2030 | (if (not (buffer-modified-p errors)) |
| 2031 | ;; No output => movemail won | 2031 | ;; No output => movemail won |
| 2032 | nil | 2032 | nil |
| @@ -2518,7 +2518,7 @@ Output a helpful message unless NOMSG is non-nil." | |||
| 2518 | ;; which will never be used. | 2518 | ;; which will never be used. |
| 2519 | (push nil messages-head) | 2519 | (push nil messages-head) |
| 2520 | (push ?0 deleted-head) | 2520 | (push ?0 deleted-head) |
| 2521 | (setq rmail-message-vector (apply 'vector messages-head) | 2521 | (setq rmail-message-vector (apply #'vector messages-head) |
| 2522 | rmail-deleted-vector (concat deleted-head)) | 2522 | rmail-deleted-vector (concat deleted-head)) |
| 2523 | 2523 | ||
| 2524 | (setq rmail-summary-vector (make-vector rmail-total-messages nil) | 2524 | (setq rmail-summary-vector (make-vector rmail-total-messages nil) |
| @@ -3605,10 +3605,10 @@ If `rmail-confirm-expunge' is non-nil, ask user to confirm." | |||
| 3605 | (cons (aref messages number) nil))) | 3605 | (cons (aref messages number) nil))) |
| 3606 | (setq rmail-current-message new-message-number | 3606 | (setq rmail-current-message new-message-number |
| 3607 | rmail-total-messages counter | 3607 | rmail-total-messages counter |
| 3608 | rmail-message-vector (apply 'vector messages-head) | 3608 | rmail-message-vector (apply #'vector messages-head) |
| 3609 | rmail-deleted-vector (make-string (1+ counter) ?\s) | 3609 | rmail-deleted-vector (make-string (1+ counter) ?\s) |
| 3610 | rmail-summary-vector (vconcat (nreverse new-summary)) | 3610 | rmail-summary-vector (vconcat (nreverse new-summary)) |
| 3611 | rmail-msgref-vector (apply 'vector (nreverse new-msgref)) | 3611 | rmail-msgref-vector (apply #'vector (nreverse new-msgref)) |
| 3612 | win t))) | 3612 | win t))) |
| 3613 | (message "Expunging deleted messages...done") | 3613 | (message "Expunging deleted messages...done") |
| 3614 | (if (not win) | 3614 | (if (not win) |
| @@ -3891,7 +3891,7 @@ use \\[mail-yank-original] to yank the original message into it." | |||
| 3891 | (if (or references message-id) | 3891 | (if (or references message-id) |
| 3892 | (list (cons "References" (if references | 3892 | (list (cons "References" (if references |
| 3893 | (concat | 3893 | (concat |
| 3894 | (mapconcat 'identity references " ") | 3894 | (mapconcat #'identity references " ") |
| 3895 | " " message-id) | 3895 | " " message-id) |
| 3896 | message-id))))))) | 3896 | message-id))))))) |
| 3897 | 3897 | ||
| @@ -4089,26 +4089,24 @@ typically for purposes of moderating a list." | |||
| 4089 | (insert "Resent-Bcc: " (user-login-name) "\n")) | 4089 | (insert "Resent-Bcc: " (user-login-name) "\n")) |
| 4090 | (insert "Resent-To: " (if (stringp address) | 4090 | (insert "Resent-To: " (if (stringp address) |
| 4091 | address | 4091 | address |
| 4092 | (mapconcat 'identity address ",\n\t")) | 4092 | (mapconcat #'identity address ",\n\t")) |
| 4093 | "\n") | 4093 | "\n") |
| 4094 | ;; Expand abbrevs in the recipients. | 4094 | ;; Expand abbrevs in the recipients. |
| 4095 | (save-excursion | 4095 | (save-excursion |
| 4096 | (if (featurep 'mailabbrev) | 4096 | (if (featurep 'mailabbrev) |
| 4097 | (let ((end (point-marker)) | 4097 | (let ((end (point-marker)) |
| 4098 | (local-abbrev-table mail-abbrevs) | 4098 | (local-abbrev-table mail-abbrevs)) |
| 4099 | (old-syntax-table (syntax-table))) | 4099 | (if (and (not (obarrayp mail-abbrevs)) |
| 4100 | (if (and (not (vectorp mail-abbrevs)) | ||
| 4101 | (file-exists-p mail-personal-alias-file)) | 4100 | (file-exists-p mail-personal-alias-file)) |
| 4102 | (build-mail-abbrevs)) | 4101 | (build-mail-abbrevs)) |
| 4103 | (unless mail-abbrev-syntax-table | 4102 | (unless mail-abbrev-syntax-table |
| 4104 | (mail-abbrev-make-syntax-table)) | 4103 | (mail-abbrev-make-syntax-table)) |
| 4105 | (set-syntax-table mail-abbrev-syntax-table) | 4104 | (with-syntax-table mail-abbrev-syntax-table |
| 4106 | (goto-char before) | 4105 | (goto-char before) |
| 4107 | (while (and (< (point) end) | 4106 | (while (and (< (point) end) |
| 4108 | (progn (forward-word-strictly 1) | 4107 | (progn (forward-word-strictly 1) |
| 4109 | (<= (point) end))) | 4108 | (<= (point) end))) |
| 4110 | (expand-abbrev)) | 4109 | (expand-abbrev)))) |
| 4111 | (set-syntax-table old-syntax-table)) | ||
| 4112 | (expand-mail-aliases before (point))))) | 4110 | (expand-mail-aliases before (point))))) |
| 4113 | ;;>> Set up comment, if any. | 4111 | ;;>> Set up comment, if any. |
| 4114 | (if (and (sequencep comment) (not (zerop (length comment)))) | 4112 | (if (and (sequencep comment) (not (zerop (length comment)))) |
| @@ -4335,7 +4333,7 @@ This has an effect only if a summary buffer exists." | |||
| 4335 | 4333 | ||
| 4336 | (defun rmail-fontify-buffer-function () | 4334 | (defun rmail-fontify-buffer-function () |
| 4337 | ;; This function's symbol is bound to font-lock-fontify-buffer-function. | 4335 | ;; This function's symbol is bound to font-lock-fontify-buffer-function. |
| 4338 | (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t) | 4336 | (add-hook 'rmail-show-message-hook #'rmail-fontify-message nil t) |
| 4339 | ;; If we're already showing a message, fontify it now. | 4337 | ;; If we're already showing a message, fontify it now. |
| 4340 | (if rmail-current-message (rmail-fontify-message)) | 4338 | (if rmail-current-message (rmail-fontify-message)) |
| 4341 | ;; Prevent Font Lock mode from kicking in. | 4339 | ;; Prevent Font Lock mode from kicking in. |
| @@ -4346,7 +4344,7 @@ This has an effect only if a summary buffer exists." | |||
| 4346 | (with-silent-modifications | 4344 | (with-silent-modifications |
| 4347 | (save-restriction | 4345 | (save-restriction |
| 4348 | (widen) | 4346 | (widen) |
| 4349 | (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t) | 4347 | (remove-hook 'rmail-show-message-hook #'rmail-fontify-message t) |
| 4350 | (remove-text-properties (point-min) (point-max) '(rmail-fontified nil)) | 4348 | (remove-text-properties (point-min) (point-max) '(rmail-fontified nil)) |
| 4351 | (font-lock-default-unfontify-buffer)))) | 4349 | (font-lock-default-unfontify-buffer)))) |
| 4352 | 4350 | ||
| @@ -4381,11 +4379,12 @@ browsing, and moving of messages." | |||
| 4381 | "Install those variables used by speedbar to enhance rmail." | 4379 | "Install those variables used by speedbar to enhance rmail." |
| 4382 | (unless rmail-speedbar-key-map | 4380 | (unless rmail-speedbar-key-map |
| 4383 | (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap)) | 4381 | (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap)) |
| 4384 | (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line) | 4382 | (declare-function speedbar-edit-line "speedbar") |
| 4385 | (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line) | 4383 | (define-key rmail-speedbar-key-map "e" #'speedbar-edit-line) |
| 4386 | (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line) | 4384 | (define-key rmail-speedbar-key-map "r" #'speedbar-edit-line) |
| 4385 | (define-key rmail-speedbar-key-map "\C-m" #'speedbar-edit-line) | ||
| 4387 | (define-key rmail-speedbar-key-map "M" | 4386 | (define-key rmail-speedbar-key-map "M" |
| 4388 | 'rmail-speedbar-move-message-to-folder-on-line))) | 4387 | #'rmail-speedbar-move-message-to-folder-on-line))) |
| 4389 | 4388 | ||
| 4390 | ;; Mouse-3. | 4389 | ;; Mouse-3. |
| 4391 | (defvar rmail-speedbar-menu-items | 4390 | (defvar rmail-speedbar-menu-items |
| @@ -4829,7 +4828,8 @@ Content-Transfer-Encoding: base64\n") | |||
| 4829 | (with-current-buffer | 4828 | (with-current-buffer |
| 4830 | (if (rmail-buffers-swapped-p) rmail-buffer rmail-view-buffer) | 4829 | (if (rmail-buffers-swapped-p) rmail-buffer rmail-view-buffer) |
| 4831 | (setq buffer-file-coding-system rmail-message-encoding)))) | 4830 | (setq buffer-file-coding-system rmail-message-encoding)))) |
| 4832 | (add-hook 'after-save-hook 'rmail-after-save-hook) | 4831 | ;; FIXME: Don't do it globally!! |
| 4832 | (add-hook 'after-save-hook #'rmail-after-save-hook) | ||
| 4833 | 4833 | ||
| 4834 | 4834 | ||
| 4835 | ;;; Mailing list support | 4835 | ;;; Mailing list support |
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index d9c4cb8cfee..a13c42edb5c 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el | |||
| @@ -31,7 +31,7 @@ | |||
| 31 | ;; Global to all RMAIL buffers. It exists for the sake of completion. | 31 | ;; Global to all RMAIL buffers. It exists for the sake of completion. |
| 32 | ;; It is better to use strings with the label functions and let them | 32 | ;; It is better to use strings with the label functions and let them |
| 33 | ;; worry about making the label. | 33 | ;; worry about making the label. |
| 34 | (defvar rmail-label-obarray (make-vector 47 0) | 34 | (defvar rmail-label-obarray (obarray-make 47) |
| 35 | "Obarray of labels used by Rmail. | 35 | "Obarray of labels used by Rmail. |
| 36 | `rmail-read-label' uses this to offer completion.") | 36 | `rmail-read-label' uses this to offer completion.") |
| 37 | 37 | ||
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 47c6a8f0613..5b290899ff5 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el | |||
| @@ -1353,6 +1353,15 @@ mail status in mode line")) | |||
| 1353 | (frame-visible-p | 1353 | (frame-visible-p |
| 1354 | (symbol-value 'speedbar-frame)))))) | 1354 | (symbol-value 'speedbar-frame)))))) |
| 1355 | 1355 | ||
| 1356 | (bindings--define-key menu [showhide-outline-minor-mode] | ||
| 1357 | '(menu-item "Outlines" outline-minor-mode | ||
| 1358 | :help "Turn outline-minor-mode on/off" | ||
| 1359 | :visible (seq-some #'local-variable-p | ||
| 1360 | '(outline-search-function | ||
| 1361 | outline-regexp outline-level)) | ||
| 1362 | :button (:toggle . (and (boundp 'outline-minor-mode) | ||
| 1363 | outline-minor-mode)))) | ||
| 1364 | |||
| 1356 | (bindings--define-key menu [showhide-tab-line-mode] | 1365 | (bindings--define-key menu [showhide-tab-line-mode] |
| 1357 | '(menu-item "Window Tab Line" global-tab-line-mode | 1366 | '(menu-item "Window Tab Line" global-tab-line-mode |
| 1358 | :help "Turn window-local tab-lines on/off" | 1367 | :help "Turn window-local tab-lines on/off" |
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 642ffad171a..099fa1599d5 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -321,7 +321,7 @@ the form (concat S2 S)." | |||
| 321 | ;; Predicates are called differently depending on the nature of | 321 | ;; Predicates are called differently depending on the nature of |
| 322 | ;; the completion table :-( | 322 | ;; the completion table :-( |
| 323 | (cond | 323 | (cond |
| 324 | ((vectorp table) ;Obarray. | 324 | ((obarrayp table) |
| 325 | (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) | 325 | (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) |
| 326 | ((hash-table-p table) | 326 | ((hash-table-p table) |
| 327 | (lambda (s _v) (funcall pred (concat prefix s)))) | 327 | (lambda (s _v) (funcall pred (concat prefix s)))) |
| @@ -1970,10 +1970,13 @@ appear to be a match." | |||
| 1970 | ;; Allow user to specify null string | 1970 | ;; Allow user to specify null string |
| 1971 | ((= beg end) (funcall exit-function)) | 1971 | ((= beg end) (funcall exit-function)) |
| 1972 | ;; The CONFIRM argument is a predicate. | 1972 | ;; The CONFIRM argument is a predicate. |
| 1973 | ((and (functionp minibuffer-completion-confirm) | 1973 | ((functionp minibuffer-completion-confirm) |
| 1974 | (funcall minibuffer-completion-confirm | 1974 | (if (funcall minibuffer-completion-confirm |
| 1975 | (buffer-substring beg end))) | 1975 | (buffer-substring beg end)) |
| 1976 | (funcall exit-function)) | 1976 | (funcall exit-function) |
| 1977 | (unless completion-fail-discreetly | ||
| 1978 | (ding) | ||
| 1979 | (completion--message "No match")))) | ||
| 1977 | ;; See if we have a completion from the table. | 1980 | ;; See if we have a completion from the table. |
| 1978 | ((test-completion (buffer-substring beg end) | 1981 | ((test-completion (buffer-substring beg end) |
| 1979 | minibuffer-completion-table | 1982 | minibuffer-completion-table |
| @@ -3482,9 +3485,10 @@ Fourth arg MUSTMATCH can take the following values: | |||
| 3482 | input, but she needs to confirm her choice if she called | 3485 | input, but she needs to confirm her choice if she called |
| 3483 | `minibuffer-complete' right before `minibuffer-complete-and-exit' | 3486 | `minibuffer-complete' right before `minibuffer-complete-and-exit' |
| 3484 | and the input is not an existing file. | 3487 | and the input is not an existing file. |
| 3485 | - a function, which will be called with the input as the | 3488 | - a function, which will be called with a single argument, the |
| 3486 | argument. If the function returns a non-nil value, the | 3489 | input unquoted by `substitute-in-file-name', which see. If the |
| 3487 | minibuffer is exited with that argument as the value. | 3490 | function returns a non-nil value, the minibuffer is exited with |
| 3491 | that argument as the value. | ||
| 3488 | - anything else behaves like t except that typing RET does not exit if it | 3492 | - anything else behaves like t except that typing RET does not exit if it |
| 3489 | does non-null completion. | 3493 | does non-null completion. |
| 3490 | 3494 | ||
| @@ -3573,7 +3577,13 @@ See `read-file-name' for the meaning of the arguments." | |||
| 3573 | (let ((ignore-case read-file-name-completion-ignore-case) | 3577 | (let ((ignore-case read-file-name-completion-ignore-case) |
| 3574 | (minibuffer-completing-file-name t) | 3578 | (minibuffer-completing-file-name t) |
| 3575 | (pred (or predicate 'file-exists-p)) | 3579 | (pred (or predicate 'file-exists-p)) |
| 3576 | (add-to-history nil)) | 3580 | (add-to-history nil) |
| 3581 | (require-match (if (functionp mustmatch) | ||
| 3582 | (lambda (input) | ||
| 3583 | (funcall mustmatch | ||
| 3584 | ;; User-supplied MUSTMATCH expects an unquoted filename | ||
| 3585 | (substitute-in-file-name input))) | ||
| 3586 | mustmatch))) | ||
| 3577 | 3587 | ||
| 3578 | (let* ((val | 3588 | (let* ((val |
| 3579 | (if (or (not (next-read-file-uses-dialog-p)) | 3589 | (if (or (not (next-read-file-uses-dialog-p)) |
| @@ -3609,7 +3619,7 @@ See `read-file-name' for the meaning of the arguments." | |||
| 3609 | (read-file-name--defaults dir initial)))) | 3619 | (read-file-name--defaults dir initial)))) |
| 3610 | (set-syntax-table minibuffer-local-filename-syntax)) | 3620 | (set-syntax-table minibuffer-local-filename-syntax)) |
| 3611 | (completing-read prompt 'read-file-name-internal | 3621 | (completing-read prompt 'read-file-name-internal |
| 3612 | pred mustmatch insdef | 3622 | pred require-match insdef |
| 3613 | 'file-name-history default-filename))) | 3623 | 'file-name-history default-filename))) |
| 3614 | ;; If DEFAULT-FILENAME not supplied and DIR contains | 3624 | ;; If DEFAULT-FILENAME not supplied and DIR contains |
| 3615 | ;; a file name, split it. | 3625 | ;; a file name, split it. |
diff --git a/lisp/mpc.el b/lisp/mpc.el index 9577e0f2f42..768c70c2e3a 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el | |||
| @@ -1867,11 +1867,14 @@ A value of t means the main playlist.") | |||
| 1867 | (defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t) | 1867 | (defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t) |
| 1868 | 1868 | ||
| 1869 | (defun mpc-volume-refresh () | 1869 | (defun mpc-volume-refresh () |
| 1870 | ;; Maintain the volume. | 1870 | "Maintain the volume." |
| 1871 | (setq mpc-volume | 1871 | (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status)) |
| 1872 | (mpc-volume-widget | 1872 | (status-vol (cdr (assq 'volume mpc-status)))) |
| 1873 | (string-to-number (cdr (assq 'volume mpc-status))))) | 1873 | ;; If MPD is paused or stopped the volume is nil. |
| 1874 | (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status))) | 1874 | (when status-vol |
| 1875 | (setq mpc-volume | ||
| 1876 | (mpc-volume-widget | ||
| 1877 | (string-to-number status-vol)))) | ||
| 1875 | (when (buffer-live-p status-buf) | 1878 | (when (buffer-live-p status-buf) |
| 1876 | (with-current-buffer status-buf (force-mode-line-update))))) | 1879 | (with-current-buffer status-buf (force-mode-line-update))))) |
| 1877 | 1880 | ||
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 359453ca433..ddc57724343 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el | |||
| @@ -688,8 +688,10 @@ websites are increasingly rare, but they do still exist." | |||
| 688 | (defun browse-url-url-at-point () | 688 | (defun browse-url-url-at-point () |
| 689 | (or (thing-at-point 'url t) | 689 | (or (thing-at-point 'url t) |
| 690 | ;; assume that the user is pointing at something like gnu.org/gnu | 690 | ;; assume that the user is pointing at something like gnu.org/gnu |
| 691 | (let ((f (thing-at-point 'filename t))) | 691 | (when-let ((f (thing-at-point 'filename t))) |
| 692 | (and f (concat browse-url-default-scheme "://" f))))) | 692 | (if (string-match-p browse-url-button-regexp f) |
| 693 | f | ||
| 694 | (concat browse-url-default-scheme "://" f))))) | ||
| 693 | 695 | ||
| 694 | ;; Having this as a separate function called by the browser-specific | 696 | ;; Having this as a separate function called by the browser-specific |
| 695 | ;; functions allows them to be stand-alone commands, making it easier | 697 | ;; functions allows them to be stand-alone commands, making it easier |
| @@ -1322,7 +1324,7 @@ and instant messengers instead of opening it in a web browser." | |||
| 1322 | :type 'boolean | 1324 | :type 'boolean |
| 1323 | :version "30.1") | 1325 | :version "30.1") |
| 1324 | 1326 | ||
| 1325 | (declare-function android-browse-url "androidselect.c") | 1327 | (declare-function android-browse-url "../term/android-win") |
| 1326 | 1328 | ||
| 1327 | ;;;###autoload | 1329 | ;;;###autoload |
| 1328 | (defun browse-url-default-android-browser (url &optional _new-window) | 1330 | (defun browse-url-default-android-browser (url &optional _new-window) |
diff --git a/lisp/net/dns.el b/lisp/net/dns.el index 23ea88ef4ad..54f4d227a49 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el | |||
| @@ -359,7 +359,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." | |||
| 359 | result)) | 359 | result)) |
| 360 | 360 | ||
| 361 | ;;; Interface functions. | 361 | ;;; Interface functions. |
| 362 | (defvar dns-cache (make-vector 4096 0)) | 362 | (defvar dns-cache (obarray-make 4096)) |
| 363 | 363 | ||
| 364 | (defun dns-query-cached (name &optional type fullp reversep) | 364 | (defun dns-query-cached (name &optional type fullp reversep) |
| 365 | (let* ((key (format "%s:%s:%s:%s" name type fullp reversep)) | 365 | (let* ((key (format "%s:%s:%s:%s" name type fullp reversep)) |
diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 6ae1e6d3d0a..5a25eef9e3c 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el | |||
| @@ -340,7 +340,7 @@ parameter, and should return the (possibly) transformed URL." | |||
| 340 | (defun eww-suggested-uris nil | 340 | (defun eww-suggested-uris nil |
| 341 | "Return the list of URIs to suggest at the `eww' prompt. | 341 | "Return the list of URIs to suggest at the `eww' prompt. |
| 342 | This list can be customized via `eww-suggest-uris'." | 342 | This list can be customized via `eww-suggest-uris'." |
| 343 | (let ((obseen (make-vector 42 0)) | 343 | (let ((obseen (obarray-make 42)) |
| 344 | (uris nil)) | 344 | (uris nil)) |
| 345 | (dolist (fun eww-suggest-uris) | 345 | (dolist (fun eww-suggest-uris) |
| 346 | (let ((ret (funcall fun))) | 346 | (let ((ret (funcall fun))) |
diff --git a/lisp/net/imap.el b/lisp/net/imap.el index f10b5b8fc12..a06740528e9 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el | |||
| @@ -1057,7 +1057,7 @@ necessary. If nil, the buffer name is generated." | |||
| 1057 | (setq imap-capability nil) | 1057 | (setq imap-capability nil) |
| 1058 | (setq streams nil)))))) | 1058 | (setq streams nil)))))) |
| 1059 | (when (imap-opened buffer) | 1059 | (when (imap-opened buffer) |
| 1060 | (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))) | 1060 | (setq imap-mailbox-data (obarray-make imap-mailbox-prime))) |
| 1061 | ;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer) | 1061 | ;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer) |
| 1062 | (when imap-stream | 1062 | (when imap-stream |
| 1063 | buffer)))) | 1063 | buffer)))) |
| @@ -1280,7 +1280,7 @@ If EXAMINE is non-nil, do a read-only select." | |||
| 1280 | (concat (if examine "EXAMINE" "SELECT") " \"" | 1280 | (concat (if examine "EXAMINE" "SELECT") " \"" |
| 1281 | mailbox "\""))) | 1281 | mailbox "\""))) |
| 1282 | (progn | 1282 | (progn |
| 1283 | (setq imap-message-data (make-vector imap-message-prime 0) | 1283 | (setq imap-message-data (obarray-make imap-message-prime) |
| 1284 | imap-state (if examine 'examine 'selected)) | 1284 | imap-state (if examine 'examine 'selected)) |
| 1285 | imap-current-mailbox) | 1285 | imap-current-mailbox) |
| 1286 | ;; Failed SELECT/EXAMINE unselects current mailbox | 1286 | ;; Failed SELECT/EXAMINE unselects current mailbox |
| @@ -1722,7 +1722,7 @@ See `imap-enable-exchange-bug-workaround'." | |||
| 1722 | (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox)))) | 1722 | (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox)))) |
| 1723 | (let ((old-mailbox imap-current-mailbox) | 1723 | (let ((old-mailbox imap-current-mailbox) |
| 1724 | (state imap-state) | 1724 | (state imap-state) |
| 1725 | (imap-message-data (make-vector 2 0))) | 1725 | (imap-message-data (obarray-make 2))) |
| 1726 | (when (imap-mailbox-examine-1 mailbox) | 1726 | (when (imap-mailbox-examine-1 mailbox) |
| 1727 | (prog1 | 1727 | (prog1 |
| 1728 | (and (imap-fetch-safe '("*" . "*:*") "UID") | 1728 | (and (imap-fetch-safe '("*" . "*:*") "UID") |
| @@ -1768,7 +1768,7 @@ first element. The rest of list contains the saved articles' UIDs." | |||
| 1768 | (imap-mailbox-get-1 'appenduid mailbox) | 1768 | (imap-mailbox-get-1 'appenduid mailbox) |
| 1769 | (let ((old-mailbox imap-current-mailbox) | 1769 | (let ((old-mailbox imap-current-mailbox) |
| 1770 | (state imap-state) | 1770 | (state imap-state) |
| 1771 | (imap-message-data (make-vector 2 0))) | 1771 | (imap-message-data (obarray-make 2))) |
| 1772 | (when (imap-mailbox-examine-1 mailbox) | 1772 | (when (imap-mailbox-examine-1 mailbox) |
| 1773 | (prog1 | 1773 | (prog1 |
| 1774 | (and (imap-fetch-safe '("*" . "*:*") "UID") | 1774 | (and (imap-fetch-safe '("*" . "*:*") "UID") |
diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 17fdffd619d..e23fc6104d2 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el | |||
| @@ -1437,13 +1437,85 @@ ones, in case fg and bg are nil." | |||
| 1437 | (shr-dom-print elem))))) | 1437 | (shr-dom-print elem))))) |
| 1438 | (insert (format "</%s>" (dom-tag dom)))) | 1438 | (insert (format "</%s>" (dom-tag dom)))) |
| 1439 | 1439 | ||
| 1440 | (defconst shr-correct-attribute-case | ||
| 1441 | '((attributename . attributeName) | ||
| 1442 | (attributetype . attributeType) | ||
| 1443 | (basefrequency . baseFrequency) | ||
| 1444 | (baseprofile . baseProfile) | ||
| 1445 | (calcmode . calcMode) | ||
| 1446 | (clippathunits . clipPathUnits) | ||
| 1447 | (diffuseconstant . diffuseConstant) | ||
| 1448 | (edgemode . edgeMode) | ||
| 1449 | (filterunits . filterUnits) | ||
| 1450 | (glyphref . glyphRef) | ||
| 1451 | (gradienttransform . gradientTransform) | ||
| 1452 | (gradientunits . gradientUnits) | ||
| 1453 | (kernelmatrix . kernelMatrix) | ||
| 1454 | (kernelunitlength . kernelUnitLength) | ||
| 1455 | (keypoints . keyPoints) | ||
| 1456 | (keysplines . keySplines) | ||
| 1457 | (keytimes . keyTimes) | ||
| 1458 | (lengthadjust . lengthAdjust) | ||
| 1459 | (limitingconeangle . limitingConeAngle) | ||
| 1460 | (markerheight . markerHeight) | ||
| 1461 | (markerunits . markerUnits) | ||
| 1462 | (markerwidth . markerWidth) | ||
| 1463 | (maskcontentunits . maskContentUnits) | ||
| 1464 | (maskunits . maskUnits) | ||
| 1465 | (numoctaves . numOctaves) | ||
| 1466 | (pathlength . pathLength) | ||
| 1467 | (patterncontentunits . patternContentUnits) | ||
| 1468 | (patterntransform . patternTransform) | ||
| 1469 | (patternunits . patternUnits) | ||
| 1470 | (pointsatx . pointsAtX) | ||
| 1471 | (pointsaty . pointsAtY) | ||
| 1472 | (pointsatz . pointsAtZ) | ||
| 1473 | (preservealpha . preserveAlpha) | ||
| 1474 | (preserveaspectratio . preserveAspectRatio) | ||
| 1475 | (primitiveunits . primitiveUnits) | ||
| 1476 | (refx . refX) | ||
| 1477 | (refy . refY) | ||
| 1478 | (repeatcount . repeatCount) | ||
| 1479 | (repeatdur . repeatDur) | ||
| 1480 | (requiredextensions . requiredExtensions) | ||
| 1481 | (requiredfeatures . requiredFeatures) | ||
| 1482 | (specularconstant . specularConstant) | ||
| 1483 | (specularexponent . specularExponent) | ||
| 1484 | (spreadmethod . spreadMethod) | ||
| 1485 | (startoffset . startOffset) | ||
| 1486 | (stddeviation . stdDeviation) | ||
| 1487 | (stitchtiles . stitchTiles) | ||
| 1488 | (surfacescale . surfaceScale) | ||
| 1489 | (systemlanguage . systemLanguage) | ||
| 1490 | (tablevalues . tableValues) | ||
| 1491 | (targetx . targetX) | ||
| 1492 | (targety . targetY) | ||
| 1493 | (textlength . textLength) | ||
| 1494 | (viewbox . viewBox) | ||
| 1495 | (viewtarget . viewTarget) | ||
| 1496 | (xchannelselector . xChannelSelector) | ||
| 1497 | (ychannelselector . yChannelSelector) | ||
| 1498 | (zoomandpan . zoomAndPan)) | ||
| 1499 | "Attributes for correcting the case in SVG and MathML. | ||
| 1500 | Based on https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inforeign .") | ||
| 1501 | |||
| 1502 | (defun shr-correct-dom-case (dom) | ||
| 1503 | "Correct the case for SVG segments." | ||
| 1504 | (dolist (attr (dom-attributes dom)) | ||
| 1505 | (when-let ((rep (assoc-default (car attr) shr-correct-attribute-case))) | ||
| 1506 | (setcar attr rep))) | ||
| 1507 | (dolist (child (dom-children dom)) | ||
| 1508 | (shr-correct-dom-case child)) | ||
| 1509 | dom) | ||
| 1510 | |||
| 1440 | (defun shr-tag-svg (dom) | 1511 | (defun shr-tag-svg (dom) |
| 1441 | (when (and (image-type-available-p 'svg) | 1512 | (when (and (image-type-available-p 'svg) |
| 1442 | (not shr-inhibit-images) | 1513 | (not shr-inhibit-images) |
| 1443 | (dom-attr dom 'width) | 1514 | (dom-attr dom 'width) |
| 1444 | (dom-attr dom 'height)) | 1515 | (dom-attr dom 'height)) |
| 1445 | (funcall shr-put-image-function (list (shr-dom-to-xml dom 'utf-8) | 1516 | (funcall shr-put-image-function |
| 1446 | 'image/svg+xml) | 1517 | (list (shr-dom-to-xml (shr-correct-dom-case dom) 'utf-8) |
| 1518 | 'image/svg+xml) | ||
| 1447 | "SVG Image"))) | 1519 | "SVG Image"))) |
| 1448 | 1520 | ||
| 1449 | (defun shr-tag-sup (dom) | 1521 | (defun shr-tag-sup (dom) |
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 2e4ad1cc412..8ad7c271b4f 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -263,9 +263,10 @@ arguments to pass to the OPERATION." | |||
| 263 | (tramp-convert-file-attributes v localname id-format | 263 | (tramp-convert-file-attributes v localname id-format |
| 264 | (and | 264 | (and |
| 265 | (tramp-adb-send-command-and-check | 265 | (tramp-adb-send-command-and-check |
| 266 | v (format "%s -d -l %s | cat" | 266 | v (format "(%s -d -l %s; echo tramp_exit_status $?) | cat" |
| 267 | (tramp-adb-get-ls-command v) | 267 | (tramp-adb-get-ls-command v) |
| 268 | (tramp-shell-quote-argument localname))) | 268 | (tramp-shell-quote-argument localname)) |
| 269 | nil t) | ||
| 269 | (with-current-buffer (tramp-get-buffer v) | 270 | (with-current-buffer (tramp-get-buffer v) |
| 270 | (tramp-adb-sh-fix-ls-output) | 271 | (tramp-adb-sh-fix-ls-output) |
| 271 | (cdar (tramp-do-parse-file-attributes-with-ls v))))))) | 272 | (cdar (tramp-do-parse-file-attributes-with-ls v))))))) |
| @@ -316,9 +317,10 @@ arguments to pass to the OPERATION." | |||
| 316 | directory full match nosort id-format count | 317 | directory full match nosort id-format count |
| 317 | (with-current-buffer (tramp-get-buffer v) | 318 | (with-current-buffer (tramp-get-buffer v) |
| 318 | (when (tramp-adb-send-command-and-check | 319 | (when (tramp-adb-send-command-and-check |
| 319 | v (format "%s -a -l %s | cat" | 320 | v (format "(%s -a -l %s; echo tramp_exit_status $?) | cat" |
| 320 | (tramp-adb-get-ls-command v) | 321 | (tramp-adb-get-ls-command v) |
| 321 | (tramp-shell-quote-argument localname))) | 322 | (tramp-shell-quote-argument localname)) |
| 323 | nil t) | ||
| 322 | ;; We insert also filename/. and filename/.., because "ls" | 324 | ;; We insert also filename/. and filename/.., because "ls" |
| 323 | ;; doesn't on some file systems, like "sdcard". | 325 | ;; doesn't on some file systems, like "sdcard". |
| 324 | (unless (search-backward-regexp (rx "." eol) nil t) | 326 | (unless (search-backward-regexp (rx "." eol) nil t) |
| @@ -440,10 +442,12 @@ Emacs dired can't find files." | |||
| 440 | filename | 442 | filename |
| 441 | (with-parsed-tramp-file-name (expand-file-name directory) nil | 443 | (with-parsed-tramp-file-name (expand-file-name directory) nil |
| 442 | (with-tramp-file-property v localname "file-name-all-completions" | 444 | (with-tramp-file-property v localname "file-name-all-completions" |
| 443 | (tramp-adb-send-command | 445 | (unless (tramp-adb-send-command-and-check |
| 444 | v (format "%s -a %s | cat" | 446 | v (format "(%s -a %s; echo tramp_exit_status $?) | cat" |
| 445 | (tramp-adb-get-ls-command v) | 447 | (tramp-adb-get-ls-command v) |
| 446 | (tramp-shell-quote-argument localname))) | 448 | (tramp-shell-quote-argument localname)) |
| 449 | nil t) | ||
| 450 | (erase-buffer)) | ||
| 447 | (mapcar | 451 | (mapcar |
| 448 | (lambda (f) | 452 | (lambda (f) |
| 449 | (if (file-directory-p (expand-file-name f directory)) | 453 | (if (file-directory-p (expand-file-name f directory)) |
| @@ -1142,17 +1146,23 @@ error and non-nil on success." | |||
| 1142 | (while (search-forward-regexp (rx (+ "\r") eol) nil t) | 1146 | (while (search-forward-regexp (rx (+ "\r") eol) nil t) |
| 1143 | (replace-match "" nil nil))))))) | 1147 | (replace-match "" nil nil))))))) |
| 1144 | 1148 | ||
| 1145 | (defun tramp-adb-send-command-and-check (vec command &optional exit-status) | 1149 | (defun tramp-adb-send-command-and-check |
| 1150 | (vec command &optional exit-status command-augmented-p) | ||
| 1146 | "Run COMMAND and check its exit status. | 1151 | "Run COMMAND and check its exit status. |
| 1147 | Sends `echo $?' along with the COMMAND for checking the exit | 1152 | Sends `echo $?' along with the COMMAND for checking the exit |
| 1148 | status. If COMMAND is nil, just sends `echo $?'. Returns nil if | 1153 | status. If COMMAND is nil, just sends `echo $?'. Returns nil if |
| 1149 | the exit status is not equal 0, and t otherwise. | 1154 | the exit status is not equal 0, and t otherwise. |
| 1150 | 1155 | ||
| 1156 | If COMMAND-AUGMENTED-P, COMMAND is already configured to print exit | ||
| 1157 | status upon completion and need not be modified. | ||
| 1158 | |||
| 1151 | Optional argument EXIT-STATUS, if non-nil, triggers the return of | 1159 | Optional argument EXIT-STATUS, if non-nil, triggers the return of |
| 1152 | the exit status." | 1160 | the exit status." |
| 1153 | (tramp-adb-send-command | 1161 | (tramp-adb-send-command |
| 1154 | vec (if command | 1162 | vec (if command |
| 1155 | (format "%s; echo tramp_exit_status $?" command) | 1163 | (if command-augmented-p |
| 1164 | command | ||
| 1165 | (format "%s; echo tramp_exit_status $?" command)) | ||
| 1156 | "echo tramp_exit_status $?")) | 1166 | "echo tramp_exit_status $?")) |
| 1157 | (with-current-buffer (tramp-get-connection-buffer vec) | 1167 | (with-current-buffer (tramp-get-connection-buffer vec) |
| 1158 | (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) | 1168 | (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) |
| @@ -1230,7 +1240,7 @@ connection if a previous connection has died for some reason." | |||
| 1230 | (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct? | 1240 | (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct? |
| 1231 | (process-connection-type tramp-process-connection-type) | 1241 | (process-connection-type tramp-process-connection-type) |
| 1232 | (args (tramp-expand-args | 1242 | (args (tramp-expand-args |
| 1233 | vec 'tramp-login-args ?d (or device ""))) | 1243 | vec 'tramp-login-args nil ?d (or device ""))) |
| 1234 | (p (let ((default-directory | 1244 | (p (let ((default-directory |
| 1235 | tramp-compat-temporary-file-directory)) | 1245 | tramp-compat-temporary-file-directory)) |
| 1236 | (apply | 1246 | (apply |
diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el new file mode 100644 index 00000000000..fd9edb6a92e --- /dev/null +++ b/lisp/net/tramp-androidsu.el | |||
| @@ -0,0 +1,577 @@ | |||
| 1 | ;;; tramp-androidsu.el --- TRAMP method for Android superuser shells -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2024 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Keywords: comm, processes | ||
| 6 | ;; Package: tramp | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;; The `su' method struggles (as do other shell-based methods) with the | ||
| 26 | ;; crippled versions of many Unix utilities installed on Android, | ||
| 27 | ;; workarounds for which are implemented in the `adb' method. This | ||
| 28 | ;; method defines a shell-based method that is identical in function to | ||
| 29 | ;; `su', but reuses such code from the `adb' method where applicable and | ||
| 30 | ;; also provides for certain mannerisms of popular Android `su' | ||
| 31 | ;; implementations. | ||
| 32 | |||
| 33 | ;;; Code: | ||
| 34 | |||
| 35 | (require 'tramp) | ||
| 36 | (require 'tramp-adb) | ||
| 37 | (require 'tramp-sh) | ||
| 38 | |||
| 39 | ;;;###tramp-autoload | ||
| 40 | (defconst tramp-androidsu-method "androidsu" | ||
| 41 | "When this method name is used, forward all calls to su.") | ||
| 42 | |||
| 43 | ;;;###tramp-autoload | ||
| 44 | (defcustom tramp-androidsu-mount-global-namespace t | ||
| 45 | "When non-nil, browse files from within the global mount namespace. | ||
| 46 | On systems that assign each application a unique view of the filesystem | ||
| 47 | by executing them within individual mount namespaces and thus conceal | ||
| 48 | each application's data directories from others, invoke `su' with the | ||
| 49 | option `-mm' in order for the shell launched to run within the global | ||
| 50 | mount namespace, so that TRAMP may edit files belonging to any and all | ||
| 51 | applications." | ||
| 52 | :group 'tramp | ||
| 53 | :version "30.1" | ||
| 54 | :type 'boolean) | ||
| 55 | |||
| 56 | (defvar tramp-androidsu-su-mm-supported 'unknown | ||
| 57 | "Whether `su -mm' is supported on this system.") | ||
| 58 | |||
| 59 | ;;;###tramp-autoload | ||
| 60 | (tramp--with-startup | ||
| 61 | (add-to-list 'tramp-methods | ||
| 62 | `(,tramp-androidsu-method | ||
| 63 | (tramp-login-program "su") | ||
| 64 | (tramp-login-args (("-") ("%u"))) | ||
| 65 | (tramp-remote-shell "/system/bin/sh") | ||
| 66 | (tramp-remote-shell-login ("-l")) | ||
| 67 | (tramp-remote-shell-args ("-c")) | ||
| 68 | (tramp-tmpdir "/data/local/tmp") | ||
| 69 | (tramp-connection-timeout 10))) | ||
| 70 | |||
| 71 | (add-to-list 'tramp-default-host-alist | ||
| 72 | `(,tramp-androidsu-method nil "localhost"))) | ||
| 73 | |||
| 74 | (defvar android-use-exec-loader) ; androidfns.c. | ||
| 75 | |||
| 76 | (defun tramp-androidsu-maybe-open-connection (vec) | ||
| 77 | "Open a connection VEC if not already open. | ||
| 78 | Mostly identical to `tramp-adb-maybe-open-connection', but also disables | ||
| 79 | multibyte mode and waits for the shell prompt to appear." | ||
| 80 | ;; During completion, don't reopen a new connection. | ||
| 81 | (unless (tramp-connectable-p vec) | ||
| 82 | (throw 'non-essential 'non-essential)) | ||
| 83 | |||
| 84 | (with-tramp-debug-message vec "Opening connection" | ||
| 85 | (let ((p (tramp-get-connection-process vec)) | ||
| 86 | (process-name (tramp-get-connection-property vec "process-name")) | ||
| 87 | (process-environment (copy-sequence process-environment))) | ||
| 88 | ;; Open a new connection. | ||
| 89 | (condition-case err | ||
| 90 | (unless (process-live-p p) | ||
| 91 | (with-tramp-progress-reporter | ||
| 92 | vec 3 | ||
| 93 | (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) | ||
| 94 | (format "Opening connection %s for %s using %s" | ||
| 95 | process-name | ||
| 96 | (tramp-file-name-host vec) | ||
| 97 | (tramp-file-name-method vec)) | ||
| 98 | (format "Opening connection %s for %s@%s using %s" | ||
| 99 | process-name | ||
| 100 | (tramp-file-name-user vec) | ||
| 101 | (tramp-file-name-host vec) | ||
| 102 | (tramp-file-name-method vec))) | ||
| 103 | (let* ((coding-system-for-read 'utf-8-unix) | ||
| 104 | (process-connection-type tramp-process-connection-type) | ||
| 105 | ;; The executable loader cannot execute setuid | ||
| 106 | ;; binaries, such as su. | ||
| 107 | (android-use-exec-loader nil) | ||
| 108 | (p (start-process (tramp-get-connection-name vec) | ||
| 109 | (tramp-get-connection-buffer vec) | ||
| 110 | ;; Disregard | ||
| 111 | ;; tramp-encoding-shell, as | ||
| 112 | ;; there's no guarantee that it's | ||
| 113 | ;; possible to execute it with | ||
| 114 | ;; `android-use-exec-loader' off. | ||
| 115 | "/system/bin/sh" "-i")) | ||
| 116 | (user (tramp-file-name-user vec)) | ||
| 117 | command) | ||
| 118 | ;; Set sentinel. Initialize variables. | ||
| 119 | (set-process-sentinel p #'tramp-process-sentinel) | ||
| 120 | (tramp-post-process-creation p vec) | ||
| 121 | |||
| 122 | ;; Replace `login-args' place holders. | ||
| 123 | (setq command (format "exec su - %s || exit" | ||
| 124 | (or user "root"))) | ||
| 125 | |||
| 126 | ;; Attempt to execute the shell inside the global mount | ||
| 127 | ;; namespace if requested. | ||
| 128 | (when tramp-androidsu-mount-global-namespace | ||
| 129 | (progn | ||
| 130 | (when (eq tramp-androidsu-su-mm-supported 'unknown) | ||
| 131 | ;; Change the prompt in advance so that | ||
| 132 | ;; tramp-adb-send-command-and-check can call | ||
| 133 | ;; tramp-search-regexp. | ||
| 134 | (tramp-adb-send-command | ||
| 135 | vec (format "PS1=%s" | ||
| 136 | (tramp-shell-quote-argument | ||
| 137 | tramp-end-of-output))) | ||
| 138 | (setq tramp-androidsu-su-mm-supported | ||
| 139 | ;; Detect support for `su -mm'. | ||
| 140 | (tramp-adb-send-command-and-check | ||
| 141 | vec "su -mm -c 'exit 24'" 24))) | ||
| 142 | (when tramp-androidsu-su-mm-supported | ||
| 143 | (setq command (format "exec su -mm - %s || exit" | ||
| 144 | (or user "root")))))) | ||
| 145 | ;; Send the command. | ||
| 146 | (tramp-message vec 3 "Sending command `%s'" command) | ||
| 147 | (tramp-adb-send-command vec command t t) | ||
| 148 | ;; Android su binaries contact a background service to | ||
| 149 | ;; obtain authentication; during this process, input | ||
| 150 | ;; received is discarded, so input cannot be | ||
| 151 | ;; guaranteed to reach the root shell until its prompt | ||
| 152 | ;; is displayed. | ||
| 153 | (with-current-buffer (process-buffer p) | ||
| 154 | (tramp-wait-for-regexp p tramp-connection-timeout | ||
| 155 | "#[[:space:]]*$")) | ||
| 156 | |||
| 157 | ;; Set connection-local variables. | ||
| 158 | (tramp-set-connection-local-variables vec) | ||
| 159 | |||
| 160 | ;; Change prompt. | ||
| 161 | (tramp-adb-send-command | ||
| 162 | vec (format "PS1=%s" | ||
| 163 | (tramp-shell-quote-argument tramp-end-of-output))) | ||
| 164 | |||
| 165 | ;; Disable line editing. | ||
| 166 | (tramp-adb-send-command | ||
| 167 | vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs") | ||
| 168 | |||
| 169 | ;; Dump option settings in the traces. | ||
| 170 | (when (>= tramp-verbose 9) | ||
| 171 | (tramp-adb-send-command vec "set -o")) | ||
| 172 | |||
| 173 | ;; Disable Unicode. | ||
| 174 | (tramp-adb-send-command vec "set +U") | ||
| 175 | |||
| 176 | ;; Disable echo expansion. | ||
| 177 | (tramp-adb-send-command | ||
| 178 | vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t) | ||
| 179 | |||
| 180 | ;; Check whether the echo has really been disabled. | ||
| 181 | ;; Some implementations, like busybox, don't support | ||
| 182 | ;; disabling. | ||
| 183 | (tramp-adb-send-command vec "echo foo" t) | ||
| 184 | (with-current-buffer (process-buffer p) | ||
| 185 | (goto-char (point-min)) | ||
| 186 | (when (looking-at-p "echo foo") | ||
| 187 | (tramp-set-connection-property p "remote-echo" t) | ||
| 188 | (tramp-message vec 5 "Remote echo still on. Ok.") | ||
| 189 | ;; Make sure backspaces and their echo are enabled | ||
| 190 | ;; and no line width magic interferes with them. | ||
| 191 | (tramp-adb-send-command vec | ||
| 192 | "stty icanon erase ^H cols 32767" | ||
| 193 | t))) | ||
| 194 | |||
| 195 | ;; Set the remote PATH to a suitable value. | ||
| 196 | (tramp-set-connection-property vec "remote-path" | ||
| 197 | "/system/bin:/system/xbin") | ||
| 198 | |||
| 199 | ;; Mark it as connected. | ||
| 200 | (tramp-set-connection-property p "connected" t)))) | ||
| 201 | |||
| 202 | ;; Cleanup, and propagate the signal. | ||
| 203 | ((error quit) | ||
| 204 | (tramp-cleanup-connection vec t) | ||
| 205 | (signal (car err) (cdr err))))))) | ||
| 206 | |||
| 207 | (defun tramp-androidsu-generate-wrapper (function) | ||
| 208 | "Return connection wrapper function for FUNCTION. | ||
| 209 | Return a function which temporarily substitutes local replacements for | ||
| 210 | the `adb' method's connection management functions around a call to | ||
| 211 | FUNCTION." | ||
| 212 | (lambda (&rest args) | ||
| 213 | (let ((tramp-adb-wait-for-output | ||
| 214 | (symbol-function #'tramp-adb-wait-for-output)) | ||
| 215 | (tramp-adb-maybe-open-connection | ||
| 216 | (symbol-function #'tramp-adb-maybe-open-connection))) | ||
| 217 | (unwind-protect | ||
| 218 | (progn | ||
| 219 | ;; tramp-adb-wait-for-output addresses problems introduced | ||
| 220 | ;; by the adb utility itself, not Android utilities, so | ||
| 221 | ;; replace it with the regular TRAMP function. | ||
| 222 | (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) | ||
| 223 | ;; Likewise, except some special treatment is necessary on | ||
| 224 | ;; account of flaws in Android's su implementation. | ||
| 225 | (fset 'tramp-adb-maybe-open-connection | ||
| 226 | #'tramp-androidsu-maybe-open-connection) | ||
| 227 | (apply function args)) | ||
| 228 | ;; Restore the original definitions of the functions overridden | ||
| 229 | ;; above. | ||
| 230 | (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) | ||
| 231 | (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) | ||
| 232 | |||
| 233 | (defalias 'tramp-androidsu-handle-access-file | ||
| 234 | (tramp-androidsu-generate-wrapper #'tramp-handle-access-file)) | ||
| 235 | |||
| 236 | (defalias 'tramp-androidsu-handle-add-name-to-file | ||
| 237 | (tramp-androidsu-generate-wrapper #'tramp-handle-add-name-to-file)) | ||
| 238 | |||
| 239 | (defalias 'tramp-androidsu-handle-copy-directory | ||
| 240 | (tramp-androidsu-generate-wrapper #'tramp-handle-copy-directory)) | ||
| 241 | |||
| 242 | (defalias 'tramp-androidsu-sh-handle-copy-file | ||
| 243 | (tramp-androidsu-generate-wrapper #'tramp-sh-handle-copy-file)) | ||
| 244 | |||
| 245 | (defalias 'tramp-androidsu-adb-handle-delete-directory | ||
| 246 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) | ||
| 247 | |||
| 248 | (defalias 'tramp-androidsu-adb-handle-delete-file | ||
| 249 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file)) | ||
| 250 | |||
| 251 | (defalias 'tramp-androidsu-handle-directory-file-name | ||
| 252 | (tramp-androidsu-generate-wrapper #'tramp-handle-directory-file-name)) | ||
| 253 | |||
| 254 | (defalias 'tramp-androidsu-handle-directory-files | ||
| 255 | (tramp-androidsu-generate-wrapper #'tramp-handle-directory-files)) | ||
| 256 | |||
| 257 | (defalias 'tramp-androidsu-adb-handle-directory-files-and-attributes | ||
| 258 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-directory-files-and-attributes)) | ||
| 259 | |||
| 260 | (defalias 'tramp-androidsu-handle-dired-uncache | ||
| 261 | (tramp-androidsu-generate-wrapper #'tramp-handle-dired-uncache)) | ||
| 262 | |||
| 263 | (defalias 'tramp-androidsu-adb-handle-exec-path | ||
| 264 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path)) | ||
| 265 | |||
| 266 | (defalias 'tramp-androidsu-handle-expand-file-name | ||
| 267 | (tramp-androidsu-generate-wrapper #'tramp-handle-expand-file-name)) | ||
| 268 | |||
| 269 | (defalias 'tramp-androidsu-handle-file-accessible-directory-p | ||
| 270 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-accessible-directory-p)) | ||
| 271 | |||
| 272 | (defalias 'tramp-androidsu-adb-handle-file-attributes | ||
| 273 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-attributes)) | ||
| 274 | |||
| 275 | (defalias 'tramp-androidsu-handle-file-directory-p | ||
| 276 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-directory-p)) | ||
| 277 | |||
| 278 | (defalias 'tramp-androidsu-handle-file-equal-p | ||
| 279 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-equal-p)) | ||
| 280 | |||
| 281 | (defalias 'tramp-androidsu-adb-handle-file-executable-p | ||
| 282 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-executable-p)) | ||
| 283 | |||
| 284 | (defalias 'tramp-androidsu-adb-handle-file-exists-p | ||
| 285 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p)) | ||
| 286 | |||
| 287 | (defalias 'tramp-androidsu-handle-file-group-gid | ||
| 288 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-group-gid)) | ||
| 289 | |||
| 290 | (defalias 'tramp-androidsu-handle-file-in-directory-p | ||
| 291 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-in-directory-p)) | ||
| 292 | |||
| 293 | (defalias 'tramp-androidsu-sh-handle-file-local-copy | ||
| 294 | (tramp-androidsu-generate-wrapper #'tramp-sh-handle-file-local-copy)) | ||
| 295 | |||
| 296 | (defalias 'tramp-androidsu-handle-file-locked-p | ||
| 297 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-locked-p)) | ||
| 298 | |||
| 299 | (defalias 'tramp-androidsu-handle-file-modes | ||
| 300 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-modes)) | ||
| 301 | |||
| 302 | (defalias 'tramp-androidsu-adb-handle-file-name-all-completions | ||
| 303 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-name-all-completions)) | ||
| 304 | |||
| 305 | (defalias 'tramp-androidsu-handle-file-name-as-directory | ||
| 306 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-as-directory)) | ||
| 307 | |||
| 308 | (defalias 'tramp-androidsu-handle-file-name-case-insensitive-p | ||
| 309 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-case-insensitive-p)) | ||
| 310 | |||
| 311 | (defalias 'tramp-androidsu-handle-file-name-completion | ||
| 312 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-completion)) | ||
| 313 | |||
| 314 | (defalias 'tramp-androidsu-handle-file-name-directory | ||
| 315 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-directory)) | ||
| 316 | |||
| 317 | (defalias 'tramp-androidsu-handle-file-name-nondirectory | ||
| 318 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-nondirectory)) | ||
| 319 | |||
| 320 | (defalias 'tramp-androidsu-handle-file-newer-than-file-p | ||
| 321 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-newer-than-file-p)) | ||
| 322 | |||
| 323 | (defalias 'tramp-androidsu-handle-file-notify-add-watch | ||
| 324 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-add-watch)) | ||
| 325 | |||
| 326 | (defalias 'tramp-androidsu-handle-file-notify-rm-watch | ||
| 327 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-rm-watch)) | ||
| 328 | |||
| 329 | (defalias 'tramp-androidsu-handle-file-notify-valid-p | ||
| 330 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-valid-p)) | ||
| 331 | |||
| 332 | (defalias 'tramp-androidsu-adb-handle-file-readable-p | ||
| 333 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p)) | ||
| 334 | |||
| 335 | (defalias 'tramp-androidsu-handle-file-regular-p | ||
| 336 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-regular-p)) | ||
| 337 | |||
| 338 | (defalias 'tramp-androidsu-handle-file-remote-p | ||
| 339 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-remote-p)) | ||
| 340 | |||
| 341 | (defalias 'tramp-androidsu-handle-file-selinux-context | ||
| 342 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-selinux-context)) | ||
| 343 | |||
| 344 | (defalias 'tramp-androidsu-handle-file-symlink-p | ||
| 345 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-symlink-p)) | ||
| 346 | |||
| 347 | (defalias 'tramp-androidsu-adb-handle-file-system-info | ||
| 348 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-system-info)) | ||
| 349 | |||
| 350 | (defalias 'tramp-androidsu-handle-file-truename | ||
| 351 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-truename)) | ||
| 352 | |||
| 353 | (defalias 'tramp-androidsu-handle-file-user-uid | ||
| 354 | (tramp-androidsu-generate-wrapper #'tramp-handle-file-user-uid)) | ||
| 355 | |||
| 356 | (defalias 'tramp-androidsu-adb-handle-file-writable-p | ||
| 357 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-writable-p)) | ||
| 358 | |||
| 359 | (defalias 'tramp-androidsu-handle-find-backup-file-name | ||
| 360 | (tramp-androidsu-generate-wrapper #'tramp-handle-find-backup-file-name)) | ||
| 361 | |||
| 362 | (defalias 'tramp-androidsu-handle-insert-directory | ||
| 363 | (tramp-androidsu-generate-wrapper #'tramp-handle-insert-directory)) | ||
| 364 | |||
| 365 | (defalias 'tramp-androidsu-handle-insert-file-contents | ||
| 366 | (tramp-androidsu-generate-wrapper #'tramp-handle-insert-file-contents)) | ||
| 367 | |||
| 368 | (defalias 'tramp-androidsu-handle-list-system-processes | ||
| 369 | (tramp-androidsu-generate-wrapper #'tramp-handle-list-system-processes)) | ||
| 370 | |||
| 371 | (defalias 'tramp-androidsu-handle-load | ||
| 372 | (tramp-androidsu-generate-wrapper #'tramp-handle-load)) | ||
| 373 | |||
| 374 | (defalias 'tramp-androidsu-handle-lock-file | ||
| 375 | (tramp-androidsu-generate-wrapper #'tramp-handle-lock-file)) | ||
| 376 | |||
| 377 | (defalias 'tramp-androidsu-handle-make-auto-save-file-name | ||
| 378 | (tramp-androidsu-generate-wrapper #'tramp-handle-make-auto-save-file-name)) | ||
| 379 | |||
| 380 | (defalias 'tramp-androidsu-adb-handle-make-directory | ||
| 381 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-directory)) | ||
| 382 | |||
| 383 | (defalias 'tramp-androidsu-handle-make-lock-file-name | ||
| 384 | (tramp-androidsu-generate-wrapper #'tramp-handle-make-lock-file-name)) | ||
| 385 | |||
| 386 | (defalias 'tramp-androidsu-handle-make-nearby-temp-file | ||
| 387 | (tramp-androidsu-generate-wrapper #'tramp-handle-make-nearby-temp-file)) | ||
| 388 | |||
| 389 | (defalias 'tramp-androidsu-adb-handle-make-process | ||
| 390 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-process)) | ||
| 391 | |||
| 392 | (defalias 'tramp-androidsu-sh-handle-make-symbolic-link | ||
| 393 | (tramp-androidsu-generate-wrapper | ||
| 394 | #'tramp-sh-handle-make-symbolic-link)) | ||
| 395 | |||
| 396 | (defalias 'tramp-androidsu-handle-memory-info | ||
| 397 | (tramp-androidsu-generate-wrapper #'tramp-handle-memory-info)) | ||
| 398 | |||
| 399 | (defalias 'tramp-androidsu-handle-process-attributes | ||
| 400 | (tramp-androidsu-generate-wrapper #'tramp-handle-process-attributes)) | ||
| 401 | |||
| 402 | (defalias 'tramp-androidsu-adb-handle-process-file | ||
| 403 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) | ||
| 404 | |||
| 405 | (defalias 'tramp-androidsu-sh-handle-rename-file | ||
| 406 | (tramp-androidsu-generate-wrapper #'tramp-sh-handle-rename-file)) | ||
| 407 | |||
| 408 | (defalias 'tramp-androidsu-adb-handle-set-file-modes | ||
| 409 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) | ||
| 410 | |||
| 411 | (defalias 'tramp-androidsu-adb-handle-set-file-times | ||
| 412 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-times)) | ||
| 413 | |||
| 414 | (defalias 'tramp-androidsu-handle-set-visited-file-modtime | ||
| 415 | (tramp-androidsu-generate-wrapper #'tramp-handle-set-visited-file-modtime)) | ||
| 416 | |||
| 417 | (defalias 'tramp-androidsu-handle-shell-command | ||
| 418 | (tramp-androidsu-generate-wrapper #'tramp-handle-shell-command)) | ||
| 419 | |||
| 420 | (defalias 'tramp-androidsu-handle-start-file-process | ||
| 421 | (tramp-androidsu-generate-wrapper #'tramp-handle-start-file-process)) | ||
| 422 | |||
| 423 | (defalias 'tramp-androidsu-handle-substitute-in-file-name | ||
| 424 | (tramp-androidsu-generate-wrapper #'tramp-handle-substitute-in-file-name)) | ||
| 425 | |||
| 426 | (defalias 'tramp-androidsu-handle-temporary-file-directory | ||
| 427 | (tramp-androidsu-generate-wrapper #'tramp-handle-temporary-file-directory)) | ||
| 428 | |||
| 429 | (defalias 'tramp-androidsu-adb-handle-get-remote-gid | ||
| 430 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-gid)) | ||
| 431 | |||
| 432 | (defalias 'tramp-androidsu-adb-handle-get-remote-groups | ||
| 433 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-groups)) | ||
| 434 | |||
| 435 | (defalias 'tramp-androidsu-adb-handle-get-remote-uid | ||
| 436 | (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid)) | ||
| 437 | |||
| 438 | (defalias 'tramp-androidsu-handle-unlock-file | ||
| 439 | (tramp-androidsu-generate-wrapper #'tramp-handle-unlock-file)) | ||
| 440 | |||
| 441 | (defalias 'tramp-androidsu-handle-verify-visited-file-modtime | ||
| 442 | (tramp-androidsu-generate-wrapper #'tramp-handle-verify-visited-file-modtime)) | ||
| 443 | |||
| 444 | (defalias 'tramp-androidsu-sh-handle-write-region | ||
| 445 | (tramp-androidsu-generate-wrapper #'tramp-sh-handle-write-region)) | ||
| 446 | |||
| 447 | ;;;###tramp-autoload | ||
| 448 | (defconst tramp-androidsu-file-name-handler-alist | ||
| 449 | '(;; `abbreviate-file-name' performed by default handler. | ||
| 450 | (access-file . tramp-androidsu-handle-access-file) | ||
| 451 | (add-name-to-file . tramp-androidsu-handle-add-name-to-file) | ||
| 452 | ;; `byte-compiler-base-file-name' performed by default handler. | ||
| 453 | (copy-directory . tramp-androidsu-handle-copy-directory) | ||
| 454 | (copy-file . tramp-androidsu-sh-handle-copy-file) | ||
| 455 | (delete-directory . tramp-androidsu-adb-handle-delete-directory) | ||
| 456 | (delete-file . tramp-androidsu-adb-handle-delete-file) | ||
| 457 | ;; `diff-latest-backup-file' performed by default handler. | ||
| 458 | (directory-file-name . tramp-androidsu-handle-directory-file-name) | ||
| 459 | (directory-files . tramp-androidsu-handle-directory-files) | ||
| 460 | (directory-files-and-attributes | ||
| 461 | . tramp-androidsu-adb-handle-directory-files-and-attributes) | ||
| 462 | (dired-compress-file . ignore) | ||
| 463 | (dired-uncache . tramp-androidsu-handle-dired-uncache) | ||
| 464 | (exec-path . tramp-androidsu-adb-handle-exec-path) | ||
| 465 | (expand-file-name . tramp-androidsu-handle-expand-file-name) | ||
| 466 | (file-accessible-directory-p . tramp-androidsu-handle-file-accessible-directory-p) | ||
| 467 | (file-acl . ignore) | ||
| 468 | (file-attributes . tramp-androidsu-adb-handle-file-attributes) | ||
| 469 | (file-directory-p . tramp-androidsu-handle-file-directory-p) | ||
| 470 | (file-equal-p . tramp-androidsu-handle-file-equal-p) | ||
| 471 | (file-executable-p . tramp-androidsu-adb-handle-file-executable-p) | ||
| 472 | (file-exists-p . tramp-androidsu-adb-handle-file-exists-p) | ||
| 473 | (file-group-gid . tramp-androidsu-handle-file-group-gid) | ||
| 474 | (file-in-directory-p . tramp-androidsu-handle-file-in-directory-p) | ||
| 475 | (file-local-copy . tramp-androidsu-sh-handle-file-local-copy) | ||
| 476 | (file-locked-p . tramp-androidsu-handle-file-locked-p) | ||
| 477 | (file-modes . tramp-androidsu-handle-file-modes) | ||
| 478 | (file-name-all-completions . tramp-androidsu-adb-handle-file-name-all-completions) | ||
| 479 | (file-name-as-directory . tramp-androidsu-handle-file-name-as-directory) | ||
| 480 | (file-name-case-insensitive-p . tramp-androidsu-handle-file-name-case-insensitive-p) | ||
| 481 | (file-name-completion . tramp-androidsu-handle-file-name-completion) | ||
| 482 | (file-name-directory . tramp-androidsu-handle-file-name-directory) | ||
| 483 | (file-name-nondirectory . tramp-androidsu-handle-file-name-nondirectory) | ||
| 484 | ;; `file-name-sans-versions' performed by default handler. | ||
| 485 | (file-newer-than-file-p . tramp-androidsu-handle-file-newer-than-file-p) | ||
| 486 | (file-notify-add-watch . tramp-androidsu-handle-file-notify-add-watch) | ||
| 487 | (file-notify-rm-watch . tramp-androidsu-handle-file-notify-rm-watch) | ||
| 488 | (file-notify-valid-p . tramp-androidsu-handle-file-notify-valid-p) | ||
| 489 | (file-ownership-preserved-p . ignore) | ||
| 490 | (file-readable-p . tramp-androidsu-adb-handle-file-readable-p) | ||
| 491 | (file-regular-p . tramp-androidsu-handle-file-regular-p) | ||
| 492 | (file-remote-p . tramp-androidsu-handle-file-remote-p) | ||
| 493 | (file-selinux-context . tramp-androidsu-handle-file-selinux-context) | ||
| 494 | (file-symlink-p . tramp-androidsu-handle-file-symlink-p) | ||
| 495 | (file-system-info . tramp-androidsu-adb-handle-file-system-info) | ||
| 496 | (file-truename . tramp-androidsu-handle-file-truename) | ||
| 497 | (file-user-uid . tramp-androidsu-handle-file-user-uid) | ||
| 498 | (file-writable-p . tramp-androidsu-adb-handle-file-writable-p) | ||
| 499 | (find-backup-file-name . tramp-androidsu-handle-find-backup-file-name) | ||
| 500 | ;; `get-file-buffer' performed by default handler. | ||
| 501 | (insert-directory . tramp-androidsu-handle-insert-directory) | ||
| 502 | (insert-file-contents . tramp-androidsu-handle-insert-file-contents) | ||
| 503 | (list-system-processes . tramp-androidsu-handle-list-system-processes) | ||
| 504 | (load . tramp-androidsu-handle-load) | ||
| 505 | (lock-file . tramp-androidsu-handle-lock-file) | ||
| 506 | (make-auto-save-file-name . tramp-androidsu-handle-make-auto-save-file-name) | ||
| 507 | (make-directory . tramp-androidsu-adb-handle-make-directory) | ||
| 508 | (make-directory-internal . ignore) | ||
| 509 | (make-lock-file-name . tramp-androidsu-handle-make-lock-file-name) | ||
| 510 | (make-nearby-temp-file . tramp-androidsu-handle-make-nearby-temp-file) | ||
| 511 | (make-process . tramp-androidsu-adb-handle-make-process) | ||
| 512 | (make-symbolic-link . tramp-androidsu-sh-handle-make-symbolic-link) | ||
| 513 | (memory-info . tramp-androidsu-handle-memory-info) | ||
| 514 | (process-attributes . tramp-androidsu-handle-process-attributes) | ||
| 515 | (process-file . tramp-androidsu-adb-handle-process-file) | ||
| 516 | (rename-file . tramp-androidsu-sh-handle-rename-file) | ||
| 517 | (set-file-acl . ignore) | ||
| 518 | (set-file-modes . tramp-androidsu-adb-handle-set-file-modes) | ||
| 519 | (set-file-selinux-context . ignore) | ||
| 520 | (set-file-times . tramp-androidsu-adb-handle-set-file-times) | ||
| 521 | (set-visited-file-modtime . tramp-androidsu-handle-set-visited-file-modtime) | ||
| 522 | (shell-command . tramp-androidsu-handle-shell-command) | ||
| 523 | (start-file-process . tramp-androidsu-handle-start-file-process) | ||
| 524 | (substitute-in-file-name . tramp-androidsu-handle-substitute-in-file-name) | ||
| 525 | (temporary-file-directory . tramp-androidsu-handle-temporary-file-directory) | ||
| 526 | (tramp-get-home-directory . ignore) | ||
| 527 | (tramp-get-remote-gid . tramp-androidsu-adb-handle-get-remote-gid) | ||
| 528 | (tramp-get-remote-groups . tramp-androidsu-adb-handle-get-remote-groups) | ||
| 529 | (tramp-get-remote-uid . tramp-androidsu-adb-handle-get-remote-uid) | ||
| 530 | (tramp-set-file-uid-gid . ignore) | ||
| 531 | (unhandled-file-name-directory . ignore) | ||
| 532 | (unlock-file . tramp-androidsu-handle-unlock-file) | ||
| 533 | (vc-registered . ignore) | ||
| 534 | (verify-visited-file-modtime . tramp-androidsu-handle-verify-visited-file-modtime) | ||
| 535 | (write-region . tramp-androidsu-sh-handle-write-region)) | ||
| 536 | "Alist of TRAMP handler functions for superuser sessions on Android.") | ||
| 537 | |||
| 538 | ;; It must be a `defsubst' in order to push the whole code into | ||
| 539 | ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. | ||
| 540 | ;;;###tramp-autoload | ||
| 541 | (defsubst tramp-androidsu-file-name-p (vec-or-filename) | ||
| 542 | "Check whether VEC-OR-FILENAME is for the `androidsu' method." | ||
| 543 | (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))) | ||
| 544 | (equal (tramp-file-name-method vec) tramp-androidsu-method))) | ||
| 545 | |||
| 546 | ;;;###tramp-autoload | ||
| 547 | (defun tramp-androidsu-file-name-handler (operation &rest args) | ||
| 548 | "Invoke the `androidsu' handler for OPERATION. | ||
| 549 | First arg specifies the OPERATION, second arg is a list of | ||
| 550 | arguments to pass to the OPERATION." | ||
| 551 | (if-let ((fn (assoc operation tramp-androidsu-file-name-handler-alist))) | ||
| 552 | (prog1 (save-match-data (apply (cdr fn) args)) | ||
| 553 | (setq tramp-debug-message-fnh-function (cdr fn))) | ||
| 554 | (prog1 (tramp-run-real-handler operation args) | ||
| 555 | (setq tramp-debug-message-fnh-function operation)))) | ||
| 556 | |||
| 557 | ;;;###tramp-autoload | ||
| 558 | (tramp--with-startup | ||
| 559 | (tramp-register-foreign-file-name-handler | ||
| 560 | #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler)) | ||
| 561 | |||
| 562 | (connection-local-set-profile-variables | ||
| 563 | 'tramp-adb-connection-local-default-ps-profile | ||
| 564 | tramp-adb-connection-local-default-ps-variables) | ||
| 565 | |||
| 566 | (with-eval-after-load 'shell | ||
| 567 | (connection-local-set-profiles | ||
| 568 | `(:application tramp :protocol ,tramp-adb-method) | ||
| 569 | 'tramp-adb-connection-local-default-shell-profile | ||
| 570 | 'tramp-adb-connection-local-default-ps-profile)) | ||
| 571 | |||
| 572 | (add-hook 'tramp-unload-hook | ||
| 573 | (lambda () | ||
| 574 | (unload-feature 'tramp-androidsu 'force))) | ||
| 575 | |||
| 576 | (provide 'tramp-androidsu) | ||
| 577 | ;;; tramp-androidsu.el ends here | ||
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 298cacdb0e0..59c4223794c 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el | |||
| @@ -387,6 +387,8 @@ arguments to pass to the OPERATION." | |||
| 387 | ;;;###autoload | 387 | ;;;###autoload |
| 388 | (progn (defun tramp-register-archive-autoload-file-name-handler () | 388 | (progn (defun tramp-register-archive-autoload-file-name-handler () |
| 389 | "Add archive file name handler to `file-name-handler-alist'." | 389 | "Add archive file name handler to `file-name-handler-alist'." |
| 390 | ;; Do not use read syntax #' for `tramp-archive-file-name-handler', it | ||
| 391 | ;; isn't autoloaded. | ||
| 390 | (when (and tramp-archive-enabled | 392 | (when (and tramp-archive-enabled |
| 391 | (not | 393 | (not |
| 392 | (rassq 'tramp-archive-file-name-handler file-name-handler-alist))) | 394 | (rassq 'tramp-archive-file-name-handler file-name-handler-alist))) |
| @@ -443,7 +445,7 @@ arguments to pass to the OPERATION." | |||
| 443 | (and (tramp-archive-file-name-p name) | 445 | (and (tramp-archive-file-name-p name) |
| 444 | (match-string 2 name))) | 446 | (match-string 2 name))) |
| 445 | 447 | ||
| 446 | (defvar tramp-archive-hash (make-hash-table :test 'equal) | 448 | (defvar tramp-archive-hash (make-hash-table :test #'equal) |
| 447 | "Hash table for archive local copies. | 449 | "Hash table for archive local copies. |
| 448 | The hash key is the archive name. The value is a cons of the | 450 | The hash key is the archive name. The value is a cons of the |
| 449 | used `tramp-file-name' structure for tramp-gvfs, and the file | 451 | used `tramp-file-name' structure for tramp-gvfs, and the file |
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 25123a6e282..225a26ad1cd 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el | |||
| @@ -144,7 +144,6 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil." | |||
| 144 | (defun tramp-get-file-property (key file property &optional default) | 144 | (defun tramp-get-file-property (key file property &optional default) |
| 145 | "Get the PROPERTY of FILE from the cache context of KEY. | 145 | "Get the PROPERTY of FILE from the cache context of KEY. |
| 146 | Return DEFAULT if not set." | 146 | Return DEFAULT if not set." |
| 147 | ;; Unify localname. Remove hop from `tramp-file-name' structure. | ||
| 148 | (setq key (tramp-file-name-unify key file)) | 147 | (setq key (tramp-file-name-unify key file)) |
| 149 | (if (eq key tramp-cache-undefined) default | 148 | (if (eq key tramp-cache-undefined) default |
| 150 | (let* ((hash (tramp-get-hash-table key)) | 149 | (let* ((hash (tramp-get-hash-table key)) |
| @@ -191,7 +190,6 @@ Return DEFAULT if not set." | |||
| 191 | (defun tramp-set-file-property (key file property value) | 190 | (defun tramp-set-file-property (key file property value) |
| 192 | "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. | 191 | "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. |
| 193 | Return VALUE." | 192 | Return VALUE." |
| 194 | ;; Unify localname. Remove hop from `tramp-file-name' structure. | ||
| 195 | (setq key (tramp-file-name-unify key file)) | 193 | (setq key (tramp-file-name-unify key file)) |
| 196 | (if (eq key tramp-cache-undefined) value | 194 | (if (eq key tramp-cache-undefined) value |
| 197 | (let ((hash (tramp-get-hash-table key))) | 195 | (let ((hash (tramp-get-hash-table key))) |
| @@ -224,7 +222,6 @@ Return VALUE." | |||
| 224 | ;;;###tramp-autoload | 222 | ;;;###tramp-autoload |
| 225 | (defun tramp-flush-file-property (key file property) | 223 | (defun tramp-flush-file-property (key file property) |
| 226 | "Remove PROPERTY of FILE in the cache context of KEY." | 224 | "Remove PROPERTY of FILE in the cache context of KEY." |
| 227 | ;; Unify localname. Remove hop from `tramp-file-name' structure. | ||
| 228 | (setq key (tramp-file-name-unify key file)) | 225 | (setq key (tramp-file-name-unify key file)) |
| 229 | (unless (eq key tramp-cache-undefined) | 226 | (unless (eq key tramp-cache-undefined) |
| 230 | (remhash property (tramp-get-hash-table key)) | 227 | (remhash property (tramp-get-hash-table key)) |
| @@ -239,7 +236,6 @@ Return VALUE." | |||
| 239 | ;; `file-name-directory' can return nil, for example for "~". | 236 | ;; `file-name-directory' can return nil, for example for "~". |
| 240 | (when-let ((file (file-name-directory file)) | 237 | (when-let ((file (file-name-directory file)) |
| 241 | (file (directory-file-name file))) | 238 | (file (directory-file-name file))) |
| 242 | ;; Unify localname. Remove hop from `tramp-file-name' structure. | ||
| 243 | (setq key (tramp-file-name-unify key file)) | 239 | (setq key (tramp-file-name-unify key file)) |
| 244 | (unless (eq key tramp-cache-undefined) | 240 | (unless (eq key tramp-cache-undefined) |
| 245 | (dolist (property (hash-table-keys (tramp-get-hash-table key))) | 241 | (dolist (property (hash-table-keys (tramp-get-hash-table key))) |
| @@ -254,7 +250,6 @@ Return VALUE." | |||
| 254 | (defun tramp-flush-file-properties (key file) | 250 | (defun tramp-flush-file-properties (key file) |
| 255 | "Remove all properties of FILE in the cache context of KEY." | 251 | "Remove all properties of FILE in the cache context of KEY." |
| 256 | (let ((truename (tramp-get-file-property key file "file-truename"))) | 252 | (let ((truename (tramp-get-file-property key file "file-truename"))) |
| 257 | ;; Unify localname. Remove hop from `tramp-file-name' structure. | ||
| 258 | (setq key (tramp-file-name-unify key file)) | 253 | (setq key (tramp-file-name-unify key file)) |
| 259 | (unless (eq key tramp-cache-undefined) | 254 | (unless (eq key tramp-cache-undefined) |
| 260 | (tramp-message key 8 "%s" (tramp-file-name-localname key)) | 255 | (tramp-message key 8 "%s" (tramp-file-name-localname key)) |
| @@ -338,17 +333,15 @@ FILE must be a local file name on a connection identified via KEY." | |||
| 338 | "Save PROPERTY, run BODY, reset PROPERTY. | 333 | "Save PROPERTY, run BODY, reset PROPERTY. |
| 339 | Preserve timestamps." | 334 | Preserve timestamps." |
| 340 | (declare (indent 3) (debug t)) | 335 | (declare (indent 3) (debug t)) |
| 341 | `(progn | 336 | `(let* ((key (tramp-file-name-unify ,key ,file)) |
| 342 | ;; Unify localname. Remove hop from `tramp-file-name' structure. | 337 | (hash (tramp-get-hash-table key)) |
| 343 | (setf ,key (tramp-file-name-unify ,key ,file)) | 338 | (cached (and (hash-table-p hash) (gethash ,property hash)))) |
| 344 | (let* ((hash (tramp-get-hash-table ,key)) | 339 | (unwind-protect (progn ,@body) |
| 345 | (cached (and (hash-table-p hash) (gethash ,property hash)))) | 340 | ;; Reset PROPERTY. Recompute hash, it could have been flushed. |
| 346 | (unwind-protect (progn ,@body) | 341 | (setq hash (tramp-get-hash-table key)) |
| 347 | ;; Reset PROPERTY. Recompute hash, it could have been flushed. | 342 | (if (consp cached) |
| 348 | (setq hash (tramp-get-hash-table ,key)) | 343 | (puthash ,property cached hash) |
| 349 | (if (consp cached) | 344 | (remhash ,property hash))))) |
| 350 | (puthash ,property cached hash) | ||
| 351 | (remhash ,property hash)))))) | ||
| 352 | 345 | ||
| 353 | ;;;###tramp-autoload | 346 | ;;;###tramp-autoload |
| 354 | (defmacro with-tramp-saved-file-properties (key file properties &rest body) | 347 | (defmacro with-tramp-saved-file-properties (key file properties &rest body) |
| @@ -356,22 +349,20 @@ Preserve timestamps." | |||
| 356 | PROPERTIES is a list of file properties (strings). | 349 | PROPERTIES is a list of file properties (strings). |
| 357 | Preserve timestamps." | 350 | Preserve timestamps." |
| 358 | (declare (indent 3) (debug t)) | 351 | (declare (indent 3) (debug t)) |
| 359 | `(progn | 352 | `(let* ((key (tramp-file-name-unify ,key ,file)) |
| 360 | ;; Unify localname. Remove hop from `tramp-file-name' structure. | 353 | (hash (tramp-get-hash-table key)) |
| 361 | (setf ,key (tramp-file-name-unify ,key ,file)) | 354 | (values |
| 362 | (let* ((hash (tramp-get-hash-table ,key)) | 355 | (and (hash-table-p hash) |
| 363 | (values | 356 | (mapcar |
| 364 | (and (hash-table-p hash) | 357 | (lambda (property) (cons property (gethash property hash))) |
| 365 | (mapcar | 358 | ,properties)))) |
| 366 | (lambda (property) (cons property (gethash property hash))) | 359 | (unwind-protect (progn ,@body) |
| 367 | ,properties)))) | 360 | ;; Reset PROPERTIES. Recompute hash, it could have been flushed. |
| 368 | (unwind-protect (progn ,@body) | 361 | (setq hash (tramp-get-hash-table key)) |
| 369 | ;; Reset PROPERTIES. Recompute hash, it could have been flushed. | 362 | (dolist (value values) |
| 370 | (setq hash (tramp-get-hash-table ,key)) | 363 | (if (consp (cdr value)) |
| 371 | (dolist (value values) | 364 | (puthash (car value) (cdr value) hash) |
| 372 | (if (consp (cdr value)) | 365 | (remhash (car value) hash)))))) |
| 373 | (puthash (car value) (cdr value) hash) | ||
| 374 | (remhash (car value) hash))))))) | ||
| 375 | 366 | ||
| 376 | ;;; -- Properties -- | 367 | ;;; -- Properties -- |
| 377 | 368 | ||
| @@ -473,38 +464,36 @@ used to cache connection properties of the local machine." | |||
| 473 | (defmacro with-tramp-saved-connection-property (key property &rest body) | 464 | (defmacro with-tramp-saved-connection-property (key property &rest body) |
| 474 | "Save PROPERTY, run BODY, reset PROPERTY." | 465 | "Save PROPERTY, run BODY, reset PROPERTY." |
| 475 | (declare (indent 2) (debug t)) | 466 | (declare (indent 2) (debug t)) |
| 476 | `(progn | 467 | `(let* ((key (tramp-file-name-unify ,key)) |
| 477 | (setf ,key (tramp-file-name-unify ,key)) | 468 | (hash (tramp-get-hash-table key)) |
| 478 | (let* ((hash (tramp-get-hash-table ,key)) | 469 | (cached (and (hash-table-p hash) |
| 479 | (cached (and (hash-table-p hash) | 470 | (gethash ,property hash tramp-cache-undefined)))) |
| 480 | (gethash ,property hash tramp-cache-undefined)))) | 471 | (unwind-protect (progn ,@body) |
| 481 | (unwind-protect (progn ,@body) | 472 | ;; Reset PROPERTY. Recompute hash, it could have been flushed. |
| 482 | ;; Reset PROPERTY. Recompute hash, it could have been flushed. | 473 | (setq hash (tramp-get-hash-table key)) |
| 483 | (setq hash (tramp-get-hash-table ,key)) | 474 | (if (not (eq cached tramp-cache-undefined)) |
| 484 | (if (not (eq cached tramp-cache-undefined)) | 475 | (puthash ,property cached hash) |
| 485 | (puthash ,property cached hash) | 476 | (remhash ,property hash))))) |
| 486 | (remhash ,property hash)))))) | ||
| 487 | 477 | ||
| 488 | ;;;###tramp-autoload | 478 | ;;;###tramp-autoload |
| 489 | (defmacro with-tramp-saved-connection-properties (key properties &rest body) | 479 | (defmacro with-tramp-saved-connection-properties (key properties &rest body) |
| 490 | "Save PROPERTIES, run BODY, reset PROPERTIES. | 480 | "Save PROPERTIES, run BODY, reset PROPERTIES. |
| 491 | PROPERTIES is a list of file properties (strings)." | 481 | PROPERTIES is a list of file properties (strings)." |
| 492 | (declare (indent 2) (debug t)) | 482 | (declare (indent 2) (debug t)) |
| 493 | `(progn | 483 | `(let* ((key (tramp-file-name-unify ,key)) |
| 494 | (setf ,key (tramp-file-name-unify ,key)) | 484 | (hash (tramp-get-hash-table key)) |
| 495 | (let* ((hash (tramp-get-hash-table ,key)) | 485 | (values |
| 496 | (values | 486 | (mapcar |
| 497 | (mapcar | 487 | (lambda (property) |
| 498 | (lambda (property) | 488 | (cons property (gethash property hash tramp-cache-undefined))) |
| 499 | (cons property (gethash property hash tramp-cache-undefined))) | 489 | ,properties))) |
| 500 | ,properties))) | 490 | (unwind-protect (progn ,@body) |
| 501 | (unwind-protect (progn ,@body) | 491 | ;; Reset PROPERTIES. Recompute hash, it could have been flushed. |
| 502 | ;; Reset PROPERTIES. Recompute hash, it could have been flushed. | 492 | (setq hash (tramp-get-hash-table key)) |
| 503 | (setq hash (tramp-get-hash-table ,key)) | 493 | (dolist (value values) |
| 504 | (dolist (value values) | 494 | (if (not (eq (cdr value) tramp-cache-undefined)) |
| 505 | (if (not (eq (cdr value) tramp-cache-undefined)) | 495 | (puthash (car value) (cdr value) hash) |
| 506 | (puthash (car value) (cdr value) hash) | 496 | (remhash (car value) hash)))))) |
| 507 | (remhash (car value) hash))))))) | ||
| 508 | 497 | ||
| 509 | ;;;###tramp-autoload | 498 | ;;;###tramp-autoload |
| 510 | (defun tramp-cache-print (table) | 499 | (defun tramp-cache-print (table) |
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 87b20b982f9..98de0dba7ff 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el | |||
| @@ -309,7 +309,7 @@ Also see `ignore'." | |||
| 309 | 309 | ||
| 310 | ;; Macro `connection-local-p' is new in Emacs 30.1. | 310 | ;; Macro `connection-local-p' is new in Emacs 30.1. |
| 311 | (if (macrop 'connection-local-p) | 311 | (if (macrop 'connection-local-p) |
| 312 | (defalias 'tramp-compat-connection-local-p #'connection-local-p) | 312 | (defalias 'tramp-compat-connection-local-p 'connection-local-p) |
| 313 | (defmacro tramp-compat-connection-local-p (variable) | 313 | (defmacro tramp-compat-connection-local-p (variable) |
| 314 | "Non-nil if VARIABLE has a connection-local binding in `default-directory'." | 314 | "Non-nil if VARIABLE has a connection-local binding in `default-directory'." |
| 315 | `(let (connection-local-variables-alist file-local-variables-alist) | 315 | `(let (connection-local-variables-alist file-local-variables-alist) |
| @@ -337,6 +337,8 @@ Also see `ignore'." | |||
| 337 | ;; | 337 | ;; |
| 338 | ;; * Starting with Emacs 29.1, use `buffer-match-p'. | 338 | ;; * Starting with Emacs 29.1, use `buffer-match-p'. |
| 339 | ;; | 339 | ;; |
| 340 | ;; * Starting with Emacs 29.1, use `string-split'. | ||
| 341 | ;; | ||
| 340 | ;; * Starting with Emacs 30.1, there is `handler-bind'. Use it | 342 | ;; * Starting with Emacs 30.1, there is `handler-bind'. Use it |
| 341 | ;; instead of `condition-case' when the origin of an error shall be | 343 | ;; instead of `condition-case' when the origin of an error shall be |
| 342 | ;; kept, for example when the HANDLER propagates the error with | 344 | ;; kept, for example when the HANDLER propagates the error with |
diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 1f578949e4d..30639cbeb85 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el | |||
| @@ -31,15 +31,20 @@ | |||
| 31 | ;; Open a file on a running Docker container: | 31 | ;; Open a file on a running Docker container: |
| 32 | ;; | 32 | ;; |
| 33 | ;; C-x C-f /docker:USER@CONTAINER:/path/to/file | 33 | ;; C-x C-f /docker:USER@CONTAINER:/path/to/file |
| 34 | ;; C-x C-f /dockercp:USER@CONTAINER:/path/to/file | ||
| 34 | ;; | 35 | ;; |
| 35 | ;; or Podman: | 36 | ;; or Podman: |
| 36 | ;; | 37 | ;; |
| 37 | ;; C-x C-f /podman:USER@CONTAINER:/path/to/file | 38 | ;; C-x C-f /podman:USER@CONTAINER:/path/to/file |
| 39 | ;; C-x C-f /podmancp:USER@CONTAINER:/path/to/file | ||
| 38 | ;; | 40 | ;; |
| 39 | ;; Where: | 41 | ;; Where: |
| 40 | ;; USER is the user on the container to connect as (optional). | 42 | ;; USER is the user on the container to connect as (optional). |
| 41 | ;; CONTAINER is the container to connect to. | 43 | ;; CONTAINER is the container to connect to. |
| 42 | ;; | 44 | ;; |
| 45 | ;; "docker" and "podman" are inline methods, "dockercp" and "podmancp" | ||
| 46 | ;; are out-of-band methods. | ||
| 47 | ;; | ||
| 43 | ;; | 48 | ;; |
| 44 | ;; | 49 | ;; |
| 45 | ;; Open file in a Kubernetes container: | 50 | ;; Open file in a Kubernetes container: |
| @@ -142,10 +147,20 @@ If it is nil, the default context will be used." | |||
| 142 | "Tramp method name to use to connect to Docker containers.") | 147 | "Tramp method name to use to connect to Docker containers.") |
| 143 | 148 | ||
| 144 | ;;;###tramp-autoload | 149 | ;;;###tramp-autoload |
| 150 | (defconst tramp-dockercp-method "dockercp" | ||
| 151 | "Tramp method name to use to connect to Docker containers. | ||
| 152 | This is for out-of-band connections.") | ||
| 153 | |||
| 154 | ;;;###tramp-autoload | ||
| 145 | (defconst tramp-podman-method "podman" | 155 | (defconst tramp-podman-method "podman" |
| 146 | "Tramp method name to use to connect to Podman containers.") | 156 | "Tramp method name to use to connect to Podman containers.") |
| 147 | 157 | ||
| 148 | ;;;###tramp-autoload | 158 | ;;;###tramp-autoload |
| 159 | (defconst tramp-podmancp-method "podmancp" | ||
| 160 | "Tramp method name to use to connect to Podman containers. | ||
| 161 | This is for out-of-band connections.") | ||
| 162 | |||
| 163 | ;;;###tramp-autoload | ||
| 149 | (defconst tramp-kubernetes-method "kubernetes" | 164 | (defconst tramp-kubernetes-method "kubernetes" |
| 150 | "Tramp method name to use to connect to Kubernetes containers.") | 165 | "Tramp method name to use to connect to Kubernetes containers.") |
| 151 | 166 | ||
| @@ -183,7 +198,8 @@ BODY is the backend specific code." | |||
| 183 | (defun tramp-container--completion-function (method) | 198 | (defun tramp-container--completion-function (method) |
| 184 | "List running containers available for connection. | 199 | "List running containers available for connection. |
| 185 | METHOD is the Tramp method to be used for \"ps\", either | 200 | METHOD is the Tramp method to be used for \"ps\", either |
| 186 | `tramp-docker-method' or `tramp-podman-method'. | 201 | `tramp-docker-method', `tramp-dockercp-method', `tramp-podman-method', |
| 202 | or `tramp-podmancp-method'. | ||
| 187 | 203 | ||
| 188 | This function is used by `tramp-set-completion-function', please | 204 | This function is used by `tramp-set-completion-function', please |
| 189 | see its function help for a description of the format." | 205 | see its function help for a description of the format." |
| @@ -376,6 +392,23 @@ see its function help for a description of the format." | |||
| 376 | (tramp-remote-shell-args ("-i" "-c")))) | 392 | (tramp-remote-shell-args ("-i" "-c")))) |
| 377 | 393 | ||
| 378 | (add-to-list 'tramp-methods | 394 | (add-to-list 'tramp-methods |
| 395 | `(,tramp-dockercp-method | ||
| 396 | (tramp-login-program ,tramp-docker-program) | ||
| 397 | (tramp-login-args (("exec") | ||
| 398 | ("-it") | ||
| 399 | ("-u" "%u") | ||
| 400 | ("%h") | ||
| 401 | ("%l"))) | ||
| 402 | (tramp-direct-async (,tramp-default-remote-shell "-c")) | ||
| 403 | (tramp-remote-shell ,tramp-default-remote-shell) | ||
| 404 | (tramp-remote-shell-login ("-l")) | ||
| 405 | (tramp-remote-shell-args ("-i" "-c")) | ||
| 406 | (tramp-copy-program ,tramp-docker-program) | ||
| 407 | (tramp-copy-args (("cp"))) | ||
| 408 | (tramp-copy-file-name (("%h" ":") ("%f"))) | ||
| 409 | (tramp-copy-recursive t))) | ||
| 410 | |||
| 411 | (add-to-list 'tramp-methods | ||
| 379 | `(,tramp-podman-method | 412 | `(,tramp-podman-method |
| 380 | (tramp-login-program ,tramp-podman-program) | 413 | (tramp-login-program ,tramp-podman-program) |
| 381 | (tramp-login-args (("exec") | 414 | (tramp-login-args (("exec") |
| @@ -389,6 +422,23 @@ see its function help for a description of the format." | |||
| 389 | (tramp-remote-shell-args ("-i" "-c")))) | 422 | (tramp-remote-shell-args ("-i" "-c")))) |
| 390 | 423 | ||
| 391 | (add-to-list 'tramp-methods | 424 | (add-to-list 'tramp-methods |
| 425 | `(,tramp-podmancp-method | ||
| 426 | (tramp-login-program ,tramp-podman-program) | ||
| 427 | (tramp-login-args (("exec") | ||
| 428 | ("-it") | ||
| 429 | ("-u" "%u") | ||
| 430 | ("%h") | ||
| 431 | ("%l"))) | ||
| 432 | (tramp-direct-async (,tramp-default-remote-shell "-c")) | ||
| 433 | (tramp-remote-shell ,tramp-default-remote-shell) | ||
| 434 | (tramp-remote-shell-login ("-l")) | ||
| 435 | (tramp-remote-shell-args ("-i" "-c")) | ||
| 436 | (tramp-copy-program ,tramp-podman-program) | ||
| 437 | (tramp-copy-args (("cp"))) | ||
| 438 | (tramp-copy-file-name (("%h" ":") ("%f"))) | ||
| 439 | (tramp-copy-recursive t))) | ||
| 440 | |||
| 441 | (add-to-list 'tramp-methods | ||
| 392 | `(,tramp-kubernetes-method | 442 | `(,tramp-kubernetes-method |
| 393 | (tramp-login-program ,tramp-kubernetes-program) | 443 | (tramp-login-program ,tramp-kubernetes-program) |
| 394 | (tramp-login-args (("%x") ; context and namespace. | 444 | (tramp-login-args (("%x") ; context and namespace. |
| @@ -432,10 +482,18 @@ see its function help for a description of the format." | |||
| 432 | `((tramp-container--completion-function ,tramp-docker-method))) | 482 | `((tramp-container--completion-function ,tramp-docker-method))) |
| 433 | 483 | ||
| 434 | (tramp-set-completion-function | 484 | (tramp-set-completion-function |
| 485 | tramp-dockercp-method | ||
| 486 | `((tramp-container--completion-function ,tramp-dockercp-method))) | ||
| 487 | |||
| 488 | (tramp-set-completion-function | ||
| 435 | tramp-podman-method | 489 | tramp-podman-method |
| 436 | `((tramp-container--completion-function ,tramp-podman-method))) | 490 | `((tramp-container--completion-function ,tramp-podman-method))) |
| 437 | 491 | ||
| 438 | (tramp-set-completion-function | 492 | (tramp-set-completion-function |
| 493 | tramp-podmancp-method | ||
| 494 | `((tramp-container--completion-function ,tramp-podmancp-method))) | ||
| 495 | |||
| 496 | (tramp-set-completion-function | ||
| 439 | tramp-kubernetes-method | 497 | tramp-kubernetes-method |
| 440 | `((tramp-kubernetes--completion-function ,tramp-kubernetes-method))) | 498 | `((tramp-kubernetes--completion-function ,tramp-kubernetes-method))) |
| 441 | 499 | ||
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 72589e7ce4a..93071ed7350 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -888,7 +888,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.") | |||
| 888 | "Invoke the GVFS related OPERATION and ARGS. | 888 | "Invoke the GVFS related OPERATION and ARGS. |
| 889 | First arg specifies the OPERATION, second arg is a list of | 889 | First arg specifies the OPERATION, second arg is a list of |
| 890 | arguments to pass to the OPERATION." | 890 | arguments to pass to the OPERATION." |
| 891 | (unless tramp-gvfs-enabled | 891 | ;; `file-remote-p' must not return an error. (Bug#68976) |
| 892 | (unless (or tramp-gvfs-enabled (eq operation 'file-remote-p)) | ||
| 892 | (tramp-user-error nil "Package `tramp-gvfs' not supported")) | 893 | (tramp-user-error nil "Package `tramp-gvfs' not supported")) |
| 893 | (if-let ((filename (apply #'tramp-file-name-for-operation operation args)) | 894 | (if-let ((filename (apply #'tramp-file-name-for-operation operation args)) |
| 894 | (tramp-gvfs-dbus-event-vector | 895 | (tramp-gvfs-dbus-event-vector |
| @@ -2293,8 +2294,8 @@ connection if a previous connection has died for some reason." | |||
| 2293 | ;; indicated by the "mounted" signal, i.e. the | 2294 | ;; indicated by the "mounted" signal, i.e. the |
| 2294 | ;; "fuse-mountpoint" file property. | 2295 | ;; "fuse-mountpoint" file property. |
| 2295 | (with-timeout | 2296 | (with-timeout |
| 2296 | ((or (tramp-get-method-parameter vec 'tramp-connection-timeout) | 2297 | ((tramp-get-method-parameter |
| 2297 | tramp-connection-timeout) | 2298 | vec 'tramp-connection-timeout tramp-connection-timeout) |
| 2298 | (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) | 2299 | (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) |
| 2299 | (tramp-error | 2300 | (tramp-error |
| 2300 | vec 'file-error | 2301 | vec 'file-error |
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index c0b60f57e40..e1f0b2a3495 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el | |||
| @@ -69,7 +69,7 @@ special handling of `substitute-in-file-name'." | |||
| 69 | (when minibuffer-completing-file-name | 69 | (when minibuffer-completing-file-name |
| 70 | (setq tramp-rfn-eshadow-overlay | 70 | (setq tramp-rfn-eshadow-overlay |
| 71 | (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) | 71 | (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) |
| 72 | ;; Copy rfn-eshadow-overlay properties. | 72 | ;; Copy `rfn-eshadow-overlay' properties. |
| 73 | (let ((props (overlay-properties rfn-eshadow-overlay))) | 73 | (let ((props (overlay-properties rfn-eshadow-overlay))) |
| 74 | (while props | 74 | (while props |
| 75 | ;; The `field' property prevents correct minibuffer | 75 | ;; The `field' property prevents correct minibuffer |
diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index 96071e626a5..97e94a51e7a 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el | |||
| @@ -353,6 +353,7 @@ applicable)." | |||
| 353 | If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE | 353 | If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE |
| 354 | forces the backtrace even if `tramp-verbose' is less than 10. | 354 | forces the backtrace even if `tramp-verbose' is less than 10. |
| 355 | This function is meant for debugging purposes." | 355 | This function is meant for debugging purposes." |
| 356 | (declare (tramp-suppress-trace t)) | ||
| 356 | (let ((tramp-verbose (if force 10 tramp-verbose))) | 357 | (let ((tramp-verbose (if force 10 tramp-verbose))) |
| 357 | (when (>= tramp-verbose 10) | 358 | (when (>= tramp-verbose 10) |
| 358 | (tramp-message | 359 | (tramp-message |
| @@ -364,6 +365,7 @@ VEC-OR-PROC identifies the connection to use, SIGNAL is the | |||
| 364 | signal identifier to be raised, remaining arguments passed to | 365 | signal identifier to be raised, remaining arguments passed to |
| 365 | `tramp-message'. Finally, signal SIGNAL is raised with | 366 | `tramp-message'. Finally, signal SIGNAL is raised with |
| 366 | FMT-STRING and ARGUMENTS." | 367 | FMT-STRING and ARGUMENTS." |
| 368 | (declare (tramp-suppress-trace t)) | ||
| 367 | (let (signal-hook-function) | 369 | (let (signal-hook-function) |
| 368 | (tramp-backtrace vec-or-proc) | 370 | (tramp-backtrace vec-or-proc) |
| 369 | (unless arguments | 371 | (unless arguments |
| @@ -391,6 +393,7 @@ tramp-tests.el.") | |||
| 391 | "Emit an error, and show BUF. | 393 | "Emit an error, and show BUF. |
| 392 | If BUF is nil, show the connection buf. Wait for 30\", or until | 394 | If BUF is nil, show the connection buf. Wait for 30\", or until |
| 393 | an input event arrives. The other arguments are passed to `tramp-error'." | 395 | an input event arrives. The other arguments are passed to `tramp-error'." |
| 396 | (declare (tramp-suppress-trace t)) | ||
| 394 | (save-window-excursion | 397 | (save-window-excursion |
| 395 | (let* ((buf (or (and (bufferp buf) buf) | 398 | (let* ((buf (or (and (bufferp buf) buf) |
| 396 | (and (processp vec-or-proc) (process-buffer vec-or-proc)) | 399 | (and (processp vec-or-proc) (process-buffer vec-or-proc)) |
| @@ -424,6 +427,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." | |||
| 424 | 427 | ||
| 425 | (defsubst tramp-user-error (vec-or-proc fmt-string &rest arguments) | 428 | (defsubst tramp-user-error (vec-or-proc fmt-string &rest arguments) |
| 426 | "Signal a user error (or \"pilot error\")." | 429 | "Signal a user error (or \"pilot error\")." |
| 430 | (declare (tramp-suppress-trace t)) | ||
| 427 | (unwind-protect | 431 | (unwind-protect |
| 428 | (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments) | 432 | (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments) |
| 429 | ;; Save exit. | 433 | ;; Save exit. |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6bb1d976ec5..66e648624b2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -38,7 +38,6 @@ | |||
| 38 | (declare-function dired-compress-file "dired-aux") | 38 | (declare-function dired-compress-file "dired-aux") |
| 39 | (declare-function dired-remove-file "dired-aux") | 39 | (declare-function dired-remove-file "dired-aux") |
| 40 | (defvar dired-compress-file-suffixes) | 40 | (defvar dired-compress-file-suffixes) |
| 41 | (defvar ls-lisp-use-insert-directory-program) | ||
| 42 | ;; Added in Emacs 28.1. | 41 | ;; Added in Emacs 28.1. |
| 43 | (defvar process-file-return-signal-string) | 42 | (defvar process-file-return-signal-string) |
| 44 | (defvar vc-handled-backends) | 43 | (defvar vc-handled-backends) |
| @@ -283,6 +282,7 @@ The string is used in `tramp-methods'.") | |||
| 283 | (tramp-copy-program "nc") | 282 | (tramp-copy-program "nc") |
| 284 | ;; We use "-v" for better error tracking. | 283 | ;; We use "-v" for better error tracking. |
| 285 | (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r"))) | 284 | (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r"))) |
| 285 | (tramp-copy-file-name (("%f"))) | ||
| 286 | (tramp-remote-copy-program "nc") | 286 | (tramp-remote-copy-program "nc") |
| 287 | ;; We use "-p" as required for newer busyboxes. For older | 287 | ;; We use "-p" as required for newer busyboxes. For older |
| 288 | ;; busybox/nc versions, the value must be (("-l") ("%r")). This | 288 | ;; busybox/nc versions, the value must be (("-l") ("%r")). This |
| @@ -429,6 +429,9 @@ The string is used in `tramp-methods'.") | |||
| 429 | eos) | 429 | eos) |
| 430 | nil ,(user-login-name)))) | 430 | nil ,(user-login-name)))) |
| 431 | 431 | ||
| 432 | (defconst tramp-default-copy-file-name '(("%u" "@") ("%h" ":") ("%f")) | ||
| 433 | "Default `tramp-copy-file-name' entry for out-of-band methods.") | ||
| 434 | |||
| 432 | ;;;###tramp-autoload | 435 | ;;;###tramp-autoload |
| 433 | (defconst tramp-completion-function-alist-rsh | 436 | (defconst tramp-completion-function-alist-rsh |
| 434 | '((tramp-parse-rhosts "/etc/hosts.equiv") | 437 | '((tramp-parse-rhosts "/etc/hosts.equiv") |
| @@ -548,6 +551,7 @@ shell from reading its init file." | |||
| 548 | (tramp-terminal-prompt-regexp tramp-action-terminal) | 551 | (tramp-terminal-prompt-regexp tramp-action-terminal) |
| 549 | (tramp-antispoof-regexp tramp-action-confirm-message) | 552 | (tramp-antispoof-regexp tramp-action-confirm-message) |
| 550 | (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) | 553 | (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) |
| 554 | (tramp-security-key-pin-regexp tramp-action-otp-password) | ||
| 551 | (tramp-process-alive-regexp tramp-action-process-alive)) | 555 | (tramp-process-alive-regexp tramp-action-process-alive)) |
| 552 | "List of pattern/action pairs. | 556 | "List of pattern/action pairs. |
| 553 | Whenever a pattern matches, the corresponding action is performed. | 557 | Whenever a pattern matches, the corresponding action is performed. |
| @@ -567,6 +571,7 @@ corresponding PATTERN matches, the ACTION function is called.") | |||
| 567 | (tramp-wrong-passwd-regexp tramp-action-permission-denied) | 571 | (tramp-wrong-passwd-regexp tramp-action-permission-denied) |
| 568 | (tramp-copy-failed-regexp tramp-action-permission-denied) | 572 | (tramp-copy-failed-regexp tramp-action-permission-denied) |
| 569 | (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) | 573 | (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) |
| 574 | (tramp-security-key-pin-regexp tramp-action-otp-password) | ||
| 570 | (tramp-process-alive-regexp tramp-action-out-of-band)) | 575 | (tramp-process-alive-regexp tramp-action-out-of-band)) |
| 571 | "List of pattern/action pairs. | 576 | "List of pattern/action pairs. |
| 572 | This list is used for copying/renaming with out-of-band methods. | 577 | This list is used for copying/renaming with out-of-band methods. |
| @@ -2010,7 +2015,7 @@ ID-FORMAT valid values are `string' and `integer'." | |||
| 2010 | #'copy-directory | 2015 | #'copy-directory |
| 2011 | (list dirname newname keep-date parents copy-contents)))) | 2016 | (list dirname newname keep-date parents copy-contents)))) |
| 2012 | 2017 | ||
| 2013 | ;; When newname did exist, we have wrong cached values. | 2018 | ;; NEWNAME has wrong cached values. |
| 2014 | (when t2 | 2019 | (when t2 |
| 2015 | (with-parsed-tramp-file-name (expand-file-name newname) nil | 2020 | (with-parsed-tramp-file-name (expand-file-name newname) nil |
| 2016 | (tramp-flush-file-properties v localname))))))) | 2021 | (tramp-flush-file-properties v localname))))))) |
| @@ -2149,24 +2154,24 @@ file names." | |||
| 2149 | ;; One of them must be a Tramp file. | 2154 | ;; One of them must be a Tramp file. |
| 2150 | (error "Tramp implementation says this cannot happen"))) | 2155 | (error "Tramp implementation says this cannot happen"))) |
| 2151 | 2156 | ||
| 2152 | ;; Handle `preserve-extended-attributes'. We ignore | ||
| 2153 | ;; possible errors, because ACL strings could be | ||
| 2154 | ;; incompatible. | ||
| 2155 | (when-let ((attributes (and preserve-extended-attributes | ||
| 2156 | (file-extended-attributes filename)))) | ||
| 2157 | (ignore-errors | ||
| 2158 | (set-file-extended-attributes newname attributes))) | ||
| 2159 | |||
| 2160 | ;; In case of `rename', we must flush the cache of the source file. | 2157 | ;; In case of `rename', we must flush the cache of the source file. |
| 2161 | (when (and t1 (eq op 'rename)) | 2158 | (when (and t1 (eq op 'rename)) |
| 2162 | (with-parsed-tramp-file-name filename v1 | 2159 | (with-parsed-tramp-file-name filename v1 |
| 2163 | (tramp-flush-file-properties v1 v1-localname))) | 2160 | (tramp-flush-file-properties v1 v1-localname))) |
| 2164 | 2161 | ||
| 2165 | ;; When newname did exist, we have wrong cached values. | 2162 | ;; NEWNAME has wrong cached values. |
| 2166 | (when t2 | 2163 | (when t2 |
| 2167 | (with-parsed-tramp-file-name newname v2 | 2164 | (with-parsed-tramp-file-name newname v2 |
| 2168 | (tramp-flush-file-properties v2 v2-localname))) | 2165 | (tramp-flush-file-properties v2 v2-localname))) |
| 2169 | 2166 | ||
| 2167 | ;; Handle `preserve-extended-attributes'. We ignore | ||
| 2168 | ;; possible errors, because ACL strings could be | ||
| 2169 | ;; incompatible. | ||
| 2170 | (when-let ((attributes (and preserve-extended-attributes | ||
| 2171 | (file-extended-attributes filename)))) | ||
| 2172 | (ignore-errors | ||
| 2173 | (set-file-extended-attributes newname attributes))) | ||
| 2174 | |||
| 2170 | ;; KEEP-DATE handling. | 2175 | ;; KEEP-DATE handling. |
| 2171 | (when (and keep-date (not copy-keep-date)) | 2176 | (when (and keep-date (not copy-keep-date)) |
| 2172 | (tramp-compat-set-file-times | 2177 | (tramp-compat-set-file-times |
| @@ -2398,10 +2403,10 @@ The method used must be an out-of-band method." | |||
| 2398 | #'file-name-as-directory | 2403 | #'file-name-as-directory |
| 2399 | #'identity) | 2404 | #'identity) |
| 2400 | (if v1 | 2405 | (if v1 |
| 2401 | (tramp-make-copy-program-file-name v1) | 2406 | (tramp-make-copy-file-name v1) |
| 2402 | (file-name-unquote filename))) | 2407 | (file-name-unquote filename))) |
| 2403 | target (if v2 | 2408 | target (if v2 |
| 2404 | (tramp-make-copy-program-file-name v2) | 2409 | (tramp-make-copy-file-name v2) |
| 2405 | (file-name-unquote newname))) | 2410 | (file-name-unquote newname))) |
| 2406 | 2411 | ||
| 2407 | ;; Check for listener port. | 2412 | ;; Check for listener port. |
| @@ -2438,9 +2443,9 @@ The method used must be an out-of-band method." | |||
| 2438 | copy-program (tramp-get-method-parameter v 'tramp-copy-program) | 2443 | copy-program (tramp-get-method-parameter v 'tramp-copy-program) |
| 2439 | copy-args | 2444 | copy-args |
| 2440 | ;; " " has either been a replacement of "%k" (when | 2445 | ;; " " has either been a replacement of "%k" (when |
| 2441 | ;; keep-date argument is non-nil), or a replacement for | 2446 | ;; KEEP-DATE argument is non-nil), or a replacement for |
| 2442 | ;; the whole keep-date sublist. | 2447 | ;; the whole keep-date sublist. |
| 2443 | (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec)) | 2448 | (delete " " (apply #'tramp-expand-args v 'tramp-copy-args nil spec)) |
| 2444 | ;; `tramp-ssh-controlmaster-options' is a string instead | 2449 | ;; `tramp-ssh-controlmaster-options' is a string instead |
| 2445 | ;; of a list. Unflatten it. | 2450 | ;; of a list. Unflatten it. |
| 2446 | copy-args | 2451 | copy-args |
| @@ -2449,11 +2454,11 @@ The method used must be an out-of-band method." | |||
| 2449 | (lambda (x) (if (tramp-compat-string-search " " x) | 2454 | (lambda (x) (if (tramp-compat-string-search " " x) |
| 2450 | (split-string x) x)) | 2455 | (split-string x) x)) |
| 2451 | copy-args)) | 2456 | copy-args)) |
| 2452 | copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec) | 2457 | copy-env (apply #'tramp-expand-args v 'tramp-copy-env nil spec) |
| 2453 | remote-copy-program | 2458 | remote-copy-program |
| 2454 | (tramp-get-method-parameter v 'tramp-remote-copy-program) | 2459 | (tramp-get-method-parameter v 'tramp-remote-copy-program) |
| 2455 | remote-copy-args | 2460 | remote-copy-args |
| 2456 | (apply #'tramp-expand-args v 'tramp-remote-copy-args spec)) | 2461 | (apply #'tramp-expand-args v 'tramp-remote-copy-args nil spec)) |
| 2457 | 2462 | ||
| 2458 | ;; Check for local copy program. | 2463 | ;; Check for local copy program. |
| 2459 | (unless (executable-find copy-program) | 2464 | (unless (executable-find copy-program) |
| @@ -2636,7 +2641,7 @@ The method used must be an out-of-band method." | |||
| 2636 | (defun tramp-sh-handle-insert-directory | 2641 | (defun tramp-sh-handle-insert-directory |
| 2637 | (filename switches &optional wildcard full-directory-p) | 2642 | (filename switches &optional wildcard full-directory-p) |
| 2638 | "Like `insert-directory' for Tramp files." | 2643 | "Like `insert-directory' for Tramp files." |
| 2639 | (if (and (featurep 'ls-lisp) | 2644 | (if (and (boundp 'ls-lisp-use-insert-directory-program) |
| 2640 | (not ls-lisp-use-insert-directory-program)) | 2645 | (not ls-lisp-use-insert-directory-program)) |
| 2641 | (tramp-handle-insert-directory | 2646 | (tramp-handle-insert-directory |
| 2642 | filename switches wildcard full-directory-p) | 2647 | filename switches wildcard full-directory-p) |
| @@ -5289,7 +5294,8 @@ connection if a previous connection has died for some reason." | |||
| 5289 | (tramp-get-method-parameter hop 'tramp-async-args))) | 5294 | (tramp-get-method-parameter hop 'tramp-async-args))) |
| 5290 | (connection-timeout | 5295 | (connection-timeout |
| 5291 | (tramp-get-method-parameter | 5296 | (tramp-get-method-parameter |
| 5292 | hop 'tramp-connection-timeout)) | 5297 | hop 'tramp-connection-timeout |
| 5298 | tramp-connection-timeout)) | ||
| 5293 | (command | 5299 | (command |
| 5294 | (tramp-get-method-parameter | 5300 | (tramp-get-method-parameter |
| 5295 | hop 'tramp-login-program)) | 5301 | hop 'tramp-login-program)) |
| @@ -5347,14 +5353,14 @@ connection if a previous connection has died for some reason." | |||
| 5347 | ;; Add arguments for asynchronous processes. | 5353 | ;; Add arguments for asynchronous processes. |
| 5348 | (when process-name async-args) | 5354 | (when process-name async-args) |
| 5349 | (tramp-expand-args | 5355 | (tramp-expand-args |
| 5350 | hop 'tramp-login-args | 5356 | hop 'tramp-login-args nil |
| 5351 | ?h (or l-host "") ?u (or l-user "") ?p (or l-port "") | 5357 | ?h (or l-host "") ?u (or l-user "") ?p (or l-port "") |
| 5352 | ?c (format-spec options (format-spec-make ?t tmpfile)) | 5358 | ?c (format-spec options (format-spec-make ?t tmpfile)) |
| 5353 | ?n (concat | 5359 | ?n (concat |
| 5354 | "2>" (tramp-get-remote-null-device previous-hop)) | 5360 | "2>" (tramp-get-remote-null-device previous-hop)) |
| 5355 | ?l (concat remote-shell " " extra-args " -i")) | 5361 | ?l (concat remote-shell " " extra-args " -i")) |
| 5356 | ;; A restricted shell does not allow "exec". | 5362 | ;; A restricted shell does not allow "exec". |
| 5357 | (when r-shell '("&&" "exit")) '("||" "exit")) | 5363 | (when r-shell '("&&" "exit")) '("||" "exit")) |
| 5358 | " ")) | 5364 | " ")) |
| 5359 | 5365 | ||
| 5360 | ;; Send the command. | 5366 | ;; Send the command. |
| @@ -5364,8 +5370,7 @@ connection if a previous connection has died for some reason." | |||
| 5364 | p vec | 5370 | p vec |
| 5365 | (min | 5371 | (min |
| 5366 | pos (with-current-buffer (process-buffer p) (point-max))) | 5372 | pos (with-current-buffer (process-buffer p) (point-max))) |
| 5367 | tramp-actions-before-shell | 5373 | tramp-actions-before-shell connection-timeout) |
| 5368 | (or connection-timeout tramp-connection-timeout)) | ||
| 5369 | (tramp-message | 5374 | (tramp-message |
| 5370 | vec 3 "Found remote shell prompt on `%s'" l-host) | 5375 | vec 3 "Found remote shell prompt on `%s'" l-host) |
| 5371 | 5376 | ||
| @@ -5558,8 +5563,8 @@ raises an error." | |||
| 5558 | string | 5563 | string |
| 5559 | "")) | 5564 | "")) |
| 5560 | 5565 | ||
| 5561 | (defun tramp-make-copy-program-file-name (vec) | 5566 | (defun tramp-make-copy-file-name (vec) |
| 5562 | "Create a file name suitable for `scp', `pscp', or `nc' and workalikes." | 5567 | "Create a file name suitable for out-of-band methods." |
| 5563 | (let ((method (tramp-file-name-method vec)) | 5568 | (let ((method (tramp-file-name-method vec)) |
| 5564 | (user (tramp-file-name-user vec)) | 5569 | (user (tramp-file-name-user vec)) |
| 5565 | (host (tramp-file-name-host vec)) | 5570 | (host (tramp-file-name-host vec)) |
| @@ -5570,13 +5575,13 @@ raises an error." | |||
| 5570 | ;; This does not work for MS Windows scp, if there are characters | 5575 | ;; This does not work for MS Windows scp, if there are characters |
| 5571 | ;; to be quoted. OpenSSH 8 supports disabling of strict file name | 5576 | ;; to be quoted. OpenSSH 8 supports disabling of strict file name |
| 5572 | ;; checking in scp, we use it when available. | 5577 | ;; checking in scp, we use it when available. |
| 5573 | (unless (string-match-p (rx "ftp" eos) method) | 5578 | (unless (string-match-p (rx (| "dockercp" "podmancp" "ftp") eos) method) |
| 5574 | (setq localname (tramp-unquote-shell-quote-argument localname))) | 5579 | (setq localname (tramp-unquote-shell-quote-argument localname))) |
| 5575 | (cond | 5580 | (string-join |
| 5576 | ((tramp-get-method-parameter vec 'tramp-remote-copy-program) | 5581 | (apply #'tramp-expand-args vec |
| 5577 | localname) | 5582 | 'tramp-copy-file-name tramp-default-copy-file-name |
| 5578 | ((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname)) | 5583 | (list ?h (or host "") ?u (or user "") ?f localname)) |
| 5579 | (t (format "%s@%s:%s" user host localname))))) | 5584 | ""))) |
| 5580 | 5585 | ||
| 5581 | (defun tramp-method-out-of-band-p (vec size) | 5586 | (defun tramp-method-out-of-band-p (vec size) |
| 5582 | "Return t if this is an out-of-band method, nil otherwise." | 5587 | "Return t if this is an out-of-band method, nil otherwise." |
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 8dad599c7e7..d0d56b8967e 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el | |||
| @@ -322,7 +322,7 @@ arguments to pass to the OPERATION." | |||
| 322 | v (tramp-get-method-parameter v 'tramp-login-program) | 322 | v (tramp-get-method-parameter v 'tramp-login-program) |
| 323 | nil outbuf display | 323 | nil outbuf display |
| 324 | (tramp-expand-args | 324 | (tramp-expand-args |
| 325 | v 'tramp-login-args | 325 | v 'tramp-login-args nil |
| 326 | ?h (or (tramp-file-name-host v) "") | 326 | ?h (or (tramp-file-name-host v) "") |
| 327 | ?u (or (tramp-file-name-user v) "") | 327 | ?u (or (tramp-file-name-user v) "") |
| 328 | ?p (or (tramp-file-name-port v) "") | 328 | ?p (or (tramp-file-name-port v) "") |
| @@ -424,7 +424,7 @@ connection if a previous connection has died for some reason." | |||
| 424 | (tramp-fuse-mount-spec vec) | 424 | (tramp-fuse-mount-spec vec) |
| 425 | (tramp-fuse-mount-point vec) | 425 | (tramp-fuse-mount-point vec) |
| 426 | (tramp-expand-args | 426 | (tramp-expand-args |
| 427 | vec 'tramp-mount-args | 427 | vec 'tramp-mount-args nil |
| 428 | ?p (or (tramp-file-name-port vec) "")))))) | 428 | ?p (or (tramp-file-name-port vec) "")))))) |
| 429 | (tramp-error | 429 | (tramp-error |
| 430 | vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec))) | 430 | vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec))) |
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 0c717c4a5aa..7bbfec62753 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el | |||
| @@ -771,7 +771,7 @@ in case of error, t otherwise." | |||
| 771 | (tramp-get-connection-name vec) (current-buffer) | 771 | (tramp-get-connection-name vec) (current-buffer) |
| 772 | (append | 772 | (append |
| 773 | (tramp-expand-args | 773 | (tramp-expand-args |
| 774 | vec 'tramp-sudo-login | 774 | vec 'tramp-sudo-login nil |
| 775 | ?h (or (tramp-file-name-host vec) "") | 775 | ?h (or (tramp-file-name-host vec) "") |
| 776 | ?u (or (tramp-file-name-user vec) "")) | 776 | ?u (or (tramp-file-name-user vec) "")) |
| 777 | (flatten-tree args)))) | 777 | (flatten-tree args)))) |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 74d95757e46..5b101000926 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -67,11 +67,6 @@ | |||
| 67 | (declare-function file-notify-rm-watch "filenotify") | 67 | (declare-function file-notify-rm-watch "filenotify") |
| 68 | (declare-function netrc-parse "netrc") | 68 | (declare-function netrc-parse "netrc") |
| 69 | (defvar auto-save-file-name-transforms) | 69 | (defvar auto-save-file-name-transforms) |
| 70 | (defvar ls-lisp-dirs-first) | ||
| 71 | (defvar ls-lisp-emulation) | ||
| 72 | (defvar ls-lisp-ignore-case) | ||
| 73 | (defvar ls-lisp-use-insert-directory-program) | ||
| 74 | (defvar ls-lisp-verbosity) | ||
| 75 | (defvar tramp-prefix-format) | 70 | (defvar tramp-prefix-format) |
| 76 | (defvar tramp-prefix-regexp) | 71 | (defvar tramp-prefix-regexp) |
| 77 | (defvar tramp-method-regexp) | 72 | (defvar tramp-method-regexp) |
| @@ -306,6 +301,15 @@ pair of the form (KEY VALUE). The following KEYs are defined: | |||
| 306 | This specifies the list of parameters to pass to the above mentioned | 301 | This specifies the list of parameters to pass to the above mentioned |
| 307 | program, the hints for `tramp-login-args' also apply here. | 302 | program, the hints for `tramp-login-args' also apply here. |
| 308 | 303 | ||
| 304 | * `tramp-copy-file-name' | ||
| 305 | The remote source or destination file name for out-of-band methods. | ||
| 306 | You can use \"%u\" and \"%h\" like in `tramp-login-args'. | ||
| 307 | Additionally, \"%f\" denotes the local file name part. This list | ||
| 308 | will be expanded to a string without spaces between the elements of | ||
| 309 | the list. | ||
| 310 | |||
| 311 | The default value is `tramp-default-copy-file-name'. | ||
| 312 | |||
| 309 | * `tramp-copy-env' | 313 | * `tramp-copy-env' |
| 310 | A list of environment variables and their values, which will | 314 | A list of environment variables and their values, which will |
| 311 | be set when calling `tramp-copy-program'. | 315 | be set when calling `tramp-copy-program'. |
| @@ -320,8 +324,8 @@ pair of the form (KEY VALUE). The following KEYs are defined: | |||
| 320 | chosen port for the remote listener. | 324 | chosen port for the remote listener. |
| 321 | 325 | ||
| 322 | * `tramp-copy-keep-date' | 326 | * `tramp-copy-keep-date' |
| 323 | This specifies whether the copying program when the preserves the | 327 | This specifies whether the copying program preserves the timestamp |
| 324 | timestamp of the original file. | 328 | of the original file. |
| 325 | 329 | ||
| 326 | * `tramp-copy-keep-tmpfile' | 330 | * `tramp-copy-keep-tmpfile' |
| 327 | This specifies whether a temporary local file shall be kept | 331 | This specifies whether a temporary local file shall be kept |
| @@ -562,7 +566,7 @@ host runs a restricted shell, it shall be added to this list, too." | |||
| 562 | eos) | 566 | eos) |
| 563 | "Host names which are regarded as local host. | 567 | "Host names which are regarded as local host. |
| 564 | If the local host runs a chrooted environment, set this to nil." | 568 | If the local host runs a chrooted environment, set this to nil." |
| 565 | :version "30.1" | 569 | :version "29.3" |
| 566 | :type '(choice (const :tag "Chrooted environment" nil) | 570 | :type '(choice (const :tag "Chrooted environment" nil) |
| 567 | (regexp :tag "Host regexp"))) | 571 | (regexp :tag "Host regexp"))) |
| 568 | 572 | ||
| @@ -750,9 +754,8 @@ The regexp should match at end of buffer." | |||
| 750 | 754 | ||
| 751 | ;; A security key requires the user physically to touch the device | 755 | ;; A security key requires the user physically to touch the device |
| 752 | ;; with their finger. We must tell it to the user. | 756 | ;; with their finger. We must tell it to the user. |
| 753 | ;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey and | 757 | ;; Added in OpenSSH 8.2. I've tested it with Nitrokey, Titankey, and |
| 754 | ;; Titankey, which have also passed the tests, do not show such a | 758 | ;; Yubikey. |
| 755 | ;; message. | ||
| 756 | (defcustom tramp-security-key-confirm-regexp | 759 | (defcustom tramp-security-key-confirm-regexp |
| 757 | (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) | 760 | (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) |
| 758 | "Regular expression matching security key confirmation message. | 761 | "Regular expression matching security key confirmation message. |
| @@ -775,6 +778,14 @@ The regexp should match at end of buffer." | |||
| 775 | :version "28.1" | 778 | :version "28.1" |
| 776 | :type 'regexp) | 779 | :type 'regexp) |
| 777 | 780 | ||
| 781 | ;; Needed only for FIDO2 (residential) keys. Tested with Nitrokey and Yubikey. | ||
| 782 | (defcustom tramp-security-key-pin-regexp | ||
| 783 | (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n"))) | ||
| 784 | "Regular expression matching security key PIN prompt. | ||
| 785 | The regexp should match at end of buffer." | ||
| 786 | :version "29.3" | ||
| 787 | :type 'regexp) | ||
| 788 | |||
| 778 | (defcustom tramp-operation-not-permitted-regexp | 789 | (defcustom tramp-operation-not-permitted-regexp |
| 779 | (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank) | 790 | (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank) |
| 780 | "Operation not permitted") | 791 | "Operation not permitted") |
| @@ -1543,21 +1554,23 @@ LOCALNAME and HOP do not count." | |||
| 1543 | (equal (tramp-file-name-unify vec1) | 1554 | (equal (tramp-file-name-unify vec1) |
| 1544 | (tramp-file-name-unify vec2)))) | 1555 | (tramp-file-name-unify vec2)))) |
| 1545 | 1556 | ||
| 1546 | (defun tramp-get-method-parameter (vec param) | 1557 | (defun tramp-get-method-parameter (vec param &optional default) |
| 1547 | "Return the method parameter PARAM. | 1558 | "Return the method parameter PARAM. |
| 1548 | If VEC is a vector, check first in connection properties. | 1559 | If VEC is a vector, check first in connection properties. |
| 1549 | Afterwards, check in `tramp-methods'. If the `tramp-methods' | 1560 | Afterwards, check in `tramp-methods'. If the `tramp-methods' |
| 1550 | entry does not exist, return nil." | 1561 | entry does not exist, return DEFAULT." |
| 1551 | (let ((hash-entry | 1562 | (let ((hash-entry |
| 1552 | (replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param)))) | 1563 | (replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param)))) |
| 1553 | (if (tramp-connection-property-p vec hash-entry) | 1564 | (if (tramp-connection-property-p vec hash-entry) |
| 1554 | ;; We use the cached property. | 1565 | ;; We use the cached property. |
| 1555 | (tramp-get-connection-property vec hash-entry) | 1566 | (tramp-get-connection-property vec hash-entry) |
| 1556 | ;; Use the static value from `tramp-methods'. | 1567 | ;; Use the static value from `tramp-methods'. |
| 1557 | (when-let ((methods-entry | 1568 | (if-let ((methods-entry |
| 1558 | (assoc | 1569 | (assoc |
| 1559 | param (assoc (tramp-file-name-method vec) tramp-methods)))) | 1570 | param (assoc (tramp-file-name-method vec) tramp-methods)))) |
| 1560 | (cadr methods-entry))))) | 1571 | (cadr methods-entry) |
| 1572 | ;; Return the default value. | ||
| 1573 | default)))) | ||
| 1561 | 1574 | ||
| 1562 | ;; The localname can be quoted with "/:". Extract this. | 1575 | ;; The localname can be quoted with "/:". Extract this. |
| 1563 | (defun tramp-file-name-unquote-localname (vec) | 1576 | (defun tramp-file-name-unquote-localname (vec) |
| @@ -3941,6 +3954,9 @@ Let-bind it when necessary.") | |||
| 3941 | (tramp-get-method-parameter v 'tramp-case-insensitive) | 3954 | (tramp-get-method-parameter v 'tramp-case-insensitive) |
| 3942 | 3955 | ||
| 3943 | ;; There isn't. So we must check, in case there's a connection already. | 3956 | ;; There isn't. So we must check, in case there's a connection already. |
| 3957 | ;; Note: We cannot use it as DEFAULT value of | ||
| 3958 | ;; `tramp-get-method-parameter', because it would be evalled | ||
| 3959 | ;; during the call. | ||
| 3944 | (and (let ((non-essential t)) (tramp-connectable-p v)) | 3960 | (and (let ((non-essential t)) (tramp-connectable-p v)) |
| 3945 | (with-tramp-connection-property v "case-insensitive" | 3961 | (with-tramp-connection-property v "case-insensitive" |
| 3946 | (ignore-errors | 3962 | (ignore-errors |
| @@ -4189,6 +4205,11 @@ Let-bind it when necessary.") | |||
| 4189 | (filename switches &optional wildcard full-directory-p) | 4205 | (filename switches &optional wildcard full-directory-p) |
| 4190 | "Like `insert-directory' for Tramp files." | 4206 | "Like `insert-directory' for Tramp files." |
| 4191 | (require 'ls-lisp) | 4207 | (require 'ls-lisp) |
| 4208 | (defvar ls-lisp-dirs-first) | ||
| 4209 | (defvar ls-lisp-emulation) | ||
| 4210 | (defvar ls-lisp-ignore-case) | ||
| 4211 | (defvar ls-lisp-use-insert-directory-program) | ||
| 4212 | (defvar ls-lisp-verbosity) | ||
| 4192 | (unless switches (setq switches "")) | 4213 | (unless switches (setq switches "")) |
| 4193 | ;; Mark trailing "/". | 4214 | ;; Mark trailing "/". |
| 4194 | (when (and (directory-name-p filename) | 4215 | (when (and (directory-name-p filename) |
| @@ -4745,15 +4766,15 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") | |||
| 4745 | (defvar tramp-extra-expand-args nil | 4766 | (defvar tramp-extra-expand-args nil |
| 4746 | "Method specific arguments.") | 4767 | "Method specific arguments.") |
| 4747 | 4768 | ||
| 4748 | (defun tramp-expand-args (vec parameter &rest spec-list) | 4769 | (defun tramp-expand-args (vec parameter default &rest spec-list) |
| 4749 | "Expand login arguments as given by PARAMETER in `tramp-methods'. | 4770 | "Expand login arguments as given by PARAMETER in `tramp-methods'. |
| 4750 | PARAMETER is a symbol like `tramp-login-args', denoting a list of | 4771 | PARAMETER is a symbol like `tramp-login-args', denoting a list of |
| 4751 | list of strings from `tramp-methods', containing %-sequences for | 4772 | list of strings from `tramp-methods', containing %-sequences for |
| 4752 | substitution. | 4773 | substitution. DEFAULT is used when PARAMETER is not specified. |
| 4753 | SPEC-LIST is a list of char/value pairs used for | 4774 | SPEC-LIST is a list of char/value pairs used for |
| 4754 | `format-spec-make'. It is appended by `tramp-extra-expand-args', | 4775 | `format-spec-make'. It is appended by `tramp-extra-expand-args', |
| 4755 | a connection-local variable." | 4776 | a connection-local variable." |
| 4756 | (let ((args (tramp-get-method-parameter vec parameter)) | 4777 | (let ((args (tramp-get-method-parameter vec parameter default)) |
| 4757 | (extra-spec-list | 4778 | (extra-spec-list |
| 4758 | (mapcar | 4779 | (mapcar |
| 4759 | #'eval | 4780 | #'eval |
| @@ -4932,7 +4953,7 @@ a connection-local variable." | |||
| 4932 | (mapcar | 4953 | (mapcar |
| 4933 | (lambda (x) (split-string x " ")) | 4954 | (lambda (x) (split-string x " ")) |
| 4934 | (tramp-expand-args | 4955 | (tramp-expand-args |
| 4935 | v 'tramp-login-args | 4956 | v 'tramp-login-args nil |
| 4936 | ?h (or host "") ?u (or user "") ?p (or port "") | 4957 | ?h (or host "") ?u (or user "") ?p (or port "") |
| 4937 | ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) | 4958 | ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) |
| 4938 | ?d (or device "") ?a (or pta "") ?l "")))) | 4959 | ?d (or device "") ?a (or pta "") ?l "")))) |
| @@ -5435,7 +5456,7 @@ of." | |||
| 5435 | prompt) | 5456 | prompt) |
| 5436 | (goto-char (point-min)) | 5457 | (goto-char (point-min)) |
| 5437 | (tramp-check-for-regexp proc tramp-process-action-regexp) | 5458 | (tramp-check-for-regexp proc tramp-process-action-regexp) |
| 5438 | (setq prompt (concat (match-string 1) " ")) | 5459 | (setq prompt (concat (string-trim (match-string 1)) " ")) |
| 5439 | (tramp-message vec 3 "Sending %s" (match-string 1)) | 5460 | (tramp-message vec 3 "Sending %s" (match-string 1)) |
| 5440 | ;; We don't call `tramp-send-string' in order to hide the | 5461 | ;; We don't call `tramp-send-string' in order to hide the |
| 5441 | ;; password from the debug buffer and the traces. | 5462 | ;; password from the debug buffer and the traces. |
| @@ -5511,14 +5532,16 @@ Wait, until the connection buffer changes." | |||
| 5511 | (ignore set-message-function clear-message-function) | 5532 | (ignore set-message-function clear-message-function) |
| 5512 | (tramp-message vec 6 "\n%s" (buffer-string)) | 5533 | (tramp-message vec 6 "\n%s" (buffer-string)) |
| 5513 | (tramp-check-for-regexp proc tramp-process-action-regexp) | 5534 | (tramp-check-for-regexp proc tramp-process-action-regexp) |
| 5514 | (with-temp-message | 5535 | (with-temp-message (concat (string-trim (match-string 0)) " ") |
| 5515 | (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0)) | ||
| 5516 | ;; Hide message in buffer. | 5536 | ;; Hide message in buffer. |
| 5517 | (narrow-to-region (point-max) (point-max)) | 5537 | (narrow-to-region (point-max) (point-max)) |
| 5518 | ;; Wait for new output. | 5538 | ;; Wait for new output. |
| 5519 | (while (not (ignore-error file-error | 5539 | (while (not (ignore-error file-error |
| 5520 | (tramp-wait-for-regexp | 5540 | (tramp-wait-for-regexp |
| 5521 | proc 0.1 tramp-security-key-confirmed-regexp))) | 5541 | proc 0.1 |
| 5542 | (rx (| (regexp tramp-security-key-confirmed-regexp) | ||
| 5543 | (regexp tramp-security-key-pin-regexp) | ||
| 5544 | (regexp tramp-security-key-timeout-regexp)))))) | ||
| 5522 | (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) | 5545 | (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) |
| 5523 | (throw 'tramp-action 'timeout)) | 5546 | (throw 'tramp-action 'timeout)) |
| 5524 | (redisplay 'force)))))) | 5547 | (redisplay 'force)))))) |
| @@ -6317,9 +6340,8 @@ This handles also chrooted environments, which are not regarded as local." | |||
| 6317 | (defun tramp-get-remote-tmpdir (vec) | 6340 | (defun tramp-get-remote-tmpdir (vec) |
| 6318 | "Return directory for temporary files on the remote host identified by VEC." | 6341 | "Return directory for temporary files on the remote host identified by VEC." |
| 6319 | (with-tramp-connection-property (tramp-get-process vec) "remote-tmpdir" | 6342 | (with-tramp-connection-property (tramp-get-process vec) "remote-tmpdir" |
| 6320 | (let ((dir | 6343 | (let ((dir (tramp-make-tramp-file-name |
| 6321 | (tramp-make-tramp-file-name | 6344 | vec (tramp-get-method-parameter vec 'tramp-tmpdir "/tmp")))) |
| 6322 | vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) | ||
| 6323 | (or (and (file-directory-p dir) (file-writable-p dir) | 6345 | (or (and (file-directory-p dir) (file-writable-p dir) |
| 6324 | (tramp-file-local-name dir)) | 6346 | (tramp-file-local-name dir)) |
| 6325 | (tramp-error vec 'file-error "Directory %s not accessible" dir)) | 6347 | (tramp-error vec 'file-error "Directory %s not accessible" dir)) |
| @@ -6564,12 +6586,13 @@ Consults the auth-source package." | |||
| 6564 | (tramp-get-connection-property key "login-as"))) | 6586 | (tramp-get-connection-property key "login-as"))) |
| 6565 | (host (tramp-file-name-host-port vec)) | 6587 | (host (tramp-file-name-host-port vec)) |
| 6566 | (pw-prompt | 6588 | (pw-prompt |
| 6567 | (or prompt | 6589 | (string-trim-left |
| 6568 | (with-current-buffer (process-buffer proc) | 6590 | (or prompt |
| 6569 | (tramp-check-for-regexp proc tramp-password-prompt-regexp) | 6591 | (with-current-buffer (process-buffer proc) |
| 6570 | (if (string-match-p "passphrase" (match-string 1)) | 6592 | (tramp-check-for-regexp proc tramp-password-prompt-regexp) |
| 6571 | (match-string 0) | 6593 | (if (string-match-p "passphrase" (match-string 1)) |
| 6572 | (format "%s for %s " (capitalize (match-string 1)) key))))) | 6594 | (match-string 0) |
| 6595 | (format "%s for %s " (capitalize (match-string 1)) key)))))) | ||
| 6573 | (auth-source-creation-prompts `((secret . ,pw-prompt))) | 6596 | (auth-source-creation-prompts `((secret . ,pw-prompt))) |
| 6574 | ;; Use connection-local value. | 6597 | ;; Use connection-local value. |
| 6575 | (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) | 6598 | (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) |
diff --git a/lisp/obarray.el b/lisp/obarray.el index a26992df8e2..e6e51c1382a 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el | |||
| @@ -27,24 +27,12 @@ | |||
| 27 | 27 | ||
| 28 | ;;; Code: | 28 | ;;; Code: |
| 29 | 29 | ||
| 30 | (defconst obarray-default-size 59 | 30 | (defconst obarray-default-size 4) |
| 31 | "The value 59 is an arbitrary prime number that gives a good hash.") | 31 | (make-obsolete-variable 'obarray-default-size |
| 32 | 32 | "obarrays now grow automatically" "30.1") | |
| 33 | (defun obarray-make (&optional size) | 33 | |
| 34 | "Return a new obarray of size SIZE or `obarray-default-size'." | 34 | (defun obarray-size (_ob) obarray-default-size) |
| 35 | (let ((size (or size obarray-default-size))) | 35 | (make-obsolete 'obarray-size "obarrays now grow automatically" "30.1") |
| 36 | (if (< 0 size) | ||
| 37 | (make-vector size 0) | ||
| 38 | (signal 'wrong-type-argument '(size 0))))) | ||
| 39 | |||
| 40 | (defun obarray-size (ob) | ||
| 41 | "Return the number of slots of obarray OB." | ||
| 42 | (length ob)) | ||
| 43 | |||
| 44 | (defun obarrayp (object) | ||
| 45 | "Return t if OBJECT is an obarray." | ||
| 46 | (and (vectorp object) | ||
| 47 | (< 0 (length object)))) | ||
| 48 | 36 | ||
| 49 | ;; Don’t use obarray as a variable name to avoid shadowing. | 37 | ;; Don’t use obarray as a variable name to avoid shadowing. |
| 50 | (defun obarray-get (ob name) | 38 | (defun obarray-get (ob name) |
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 3f05b7fe7ac..e1ea9141f0d 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el | |||
| @@ -370,7 +370,7 @@ See documentation of `walk-windows' for useful values." | |||
| 370 | This hook is run during minibuffer setup if `iswitchb' is active. | 370 | This hook is run during minibuffer setup if `iswitchb' is active. |
| 371 | For instance: | 371 | For instance: |
| 372 | \(add-hook \\='iswitchb-minibuffer-setup-hook | 372 | \(add-hook \\='iswitchb-minibuffer-setup-hook |
| 373 | \\='\(lambda () (set (make-local-variable \\='max-mini-window-height) 3))) | 373 | \\='\(lambda () (setq-local max-mini-window-height 3))) |
| 374 | will constrain the minibuffer to a maximum height of 3 lines when | 374 | will constrain the minibuffer to a maximum height of 3 lines when |
| 375 | iswitchb is running." | 375 | iswitchb is running." |
| 376 | :type 'hook) | 376 | :type 'hook) |
| @@ -1262,7 +1262,7 @@ Modified from `icomplete-completions'." | |||
| 1262 | "Set up minibuffer for `iswitchb-buffer'. | 1262 | "Set up minibuffer for `iswitchb-buffer'. |
| 1263 | Copied from `icomplete-minibuffer-setup-hook'." | 1263 | Copied from `icomplete-minibuffer-setup-hook'." |
| 1264 | (when (iswitchb-entryfn-p) | 1264 | (when (iswitchb-entryfn-p) |
| 1265 | (set (make-local-variable 'iswitchb-use-mycompletion) t) | 1265 | (setq-local iswitchb-use-mycompletion t) |
| 1266 | (add-hook 'pre-command-hook #'iswitchb-pre-command nil t) | 1266 | (add-hook 'pre-command-hook #'iswitchb-pre-command nil t) |
| 1267 | (add-hook 'post-command-hook #'iswitchb-post-command nil t) | 1267 | (add-hook 'post-command-hook #'iswitchb-post-command nil t) |
| 1268 | (run-hooks 'iswitchb-minibuffer-setup-hook))) | 1268 | (run-hooks 'iswitchb-minibuffer-setup-hook))) |
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index 6aa388805f2..f065bcaff26 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el | |||
| @@ -116,17 +116,14 @@ newlines are indicated with a symbol." | |||
| 116 | ;; Turn on longlines mode | 116 | ;; Turn on longlines mode |
| 117 | (progn | 117 | (progn |
| 118 | (use-hard-newlines 1 'never) | 118 | (use-hard-newlines 1 'never) |
| 119 | (set (make-local-variable 'require-final-newline) nil) | 119 | (setq-local require-final-newline nil) |
| 120 | (add-to-list 'buffer-file-format 'longlines) | 120 | (add-to-list 'buffer-file-format 'longlines) |
| 121 | (add-hook 'change-major-mode-hook #'longlines-mode-off nil t) | 121 | (add-hook 'change-major-mode-hook #'longlines-mode-off nil t) |
| 122 | (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t) | 122 | (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t) |
| 123 | (make-local-variable 'longlines-auto-wrap) | 123 | (make-local-variable 'longlines-auto-wrap) |
| 124 | (set (make-local-variable 'isearch-search-fun-function) | 124 | (setq-local isearch-search-fun-function #'longlines-search-function) |
| 125 | #'longlines-search-function) | 125 | (setq-local replace-search-function #'longlines-search-forward) |
| 126 | (set (make-local-variable 'replace-search-function) | 126 | (setq-local replace-re-search-function #'longlines-re-search-forward) |
| 127 | #'longlines-search-forward) | ||
| 128 | (set (make-local-variable 'replace-re-search-function) | ||
| 129 | #'longlines-re-search-forward) | ||
| 130 | (add-function :filter-return (local 'filter-buffer-substring-function) | 127 | (add-function :filter-return (local 'filter-buffer-substring-function) |
| 131 | #'longlines-encode-string) | 128 | #'longlines-encode-string) |
| 132 | (when longlines-wrap-follows-window-size | 129 | (when longlines-wrap-follows-window-size |
| @@ -136,8 +133,7 @@ newlines are indicated with a symbol." | |||
| 136 | (window-width))) | 133 | (window-width))) |
| 137 | longlines-wrap-follows-window-size | 134 | longlines-wrap-follows-window-size |
| 138 | 2))) | 135 | 2))) |
| 139 | (set (make-local-variable 'fill-column) | 136 | (setq-local fill-column (- (window-width) dw))) |
| 140 | (- (window-width) dw))) | ||
| 141 | (add-hook 'window-configuration-change-hook | 137 | (add-hook 'window-configuration-change-hook |
| 142 | #'longlines-window-change-function nil t)) | 138 | #'longlines-window-change-function nil t)) |
| 143 | (let ((buffer-undo-list t) | 139 | (let ((buffer-undo-list t) |
diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el index 6c00ad201f1..4c7b653155e 100644 --- a/lisp/obsolete/pgg.el +++ b/lisp/obsolete/pgg.el | |||
| @@ -85,9 +85,9 @@ is true, or else the output buffer is displayed." | |||
| 85 | (set-buffer standard-output) | 85 | (set-buffer standard-output) |
| 86 | (insert-buffer-substring pgg-errors-buffer)))) | 86 | (insert-buffer-substring pgg-errors-buffer)))) |
| 87 | 87 | ||
| 88 | (defvar pgg-passphrase-cache (make-vector 7 0)) | 88 | (defvar pgg-passphrase-cache (obarray-make 7)) |
| 89 | 89 | ||
| 90 | (defvar pgg-pending-timers (make-vector 7 0) | 90 | (defvar pgg-pending-timers (obarray-make 7) |
| 91 | "Hash table for managing scheduled pgg cache management timers. | 91 | "Hash table for managing scheduled pgg cache management timers. |
| 92 | 92 | ||
| 93 | We associate key and timer, so the timer can be canceled if a new | 93 | We associate key and timer, so the timer can be canceled if a new |
diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el index e0826475e32..258b2b519d9 100644 --- a/lisp/obsolete/rcompile.el +++ b/lisp/obsolete/rcompile.el | |||
| @@ -169,12 +169,12 @@ See \\[compile]." | |||
| 169 | ;; compilation-parse-errors will find referenced files by Tramp. | 169 | ;; compilation-parse-errors will find referenced files by Tramp. |
| 170 | (with-current-buffer next-error-last-buffer | 170 | (with-current-buffer next-error-last-buffer |
| 171 | (when (fboundp 'tramp-make-tramp-file-name) | 171 | (when (fboundp 'tramp-make-tramp-file-name) |
| 172 | (set (make-local-variable 'comint-file-name-prefix) | 172 | (setq-local comint-file-name-prefix |
| 173 | (funcall | 173 | (funcall |
| 174 | #'tramp-make-tramp-file-name | 174 | #'tramp-make-tramp-file-name |
| 175 | nil ;; method. | 175 | nil ;; method. |
| 176 | remote-compile-user | 176 | remote-compile-user |
| 177 | remote-compile-host | 177 | remote-compile-host |
| 178 | "")))))) | 178 | "")))))) |
| 179 | 179 | ||
| 180 | ;;; rcompile.el ends here | 180 | ;;; rcompile.el ends here |
diff --git a/lisp/org/org.el b/lisp/org/org.el index 2c5de69a36c..d361408eaca 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el | |||
| @@ -4685,7 +4685,7 @@ returns non-nil if any of them match." | |||
| 4685 | (if (and (= char ?f) current-file) | 4685 | (if (and (= char ?f) current-file) |
| 4686 | (concat "file://" current-file) uri)) | 4686 | (concat "file://" current-file) uri)) |
| 4687 | "\\'"))))) | 4687 | "\\'"))))) |
| 4688 | (prog1 (memq char '(?y ?n ?! ?d ?\s ?f)) | 4688 | (prog1 (memq char '(?y ?! ?d ?\s ?f)) |
| 4689 | (quit-window t))))))) | 4689 | (quit-window t))))))) |
| 4690 | 4690 | ||
| 4691 | (defun org-extract-log-state-settings (x) | 4691 | (defun org-extract-log-state-settings (x) |
diff --git a/lisp/outline.el b/lisp/outline.el index b50708c1a7b..40a75701cbf 100644 --- a/lisp/outline.el +++ b/lisp/outline.el | |||
| @@ -318,8 +318,8 @@ Using the value `insert' is not recommended in editable | |||
| 318 | buffers because it modifies them. | 318 | buffers because it modifies them. |
| 319 | When the value is `in-margins', then clickable buttons are | 319 | When the value is `in-margins', then clickable buttons are |
| 320 | displayed in the margins before the headings. | 320 | displayed in the margins before the headings. |
| 321 | When the value is `t', clickable buttons are displayed | 321 | When the value is t, clickable buttons are displayed |
| 322 | in the buffer before the headings. The values `t' and | 322 | in the buffer before the headings. The values t and |
| 323 | `in-margins' can be used in editing buffers because they | 323 | `in-margins' can be used in editing buffers because they |
| 324 | don't modify the buffer." | 324 | don't modify the buffer." |
| 325 | ;; The value `insert' is not intended to be customizable. | 325 | ;; The value `insert' is not intended to be customizable. |
| @@ -686,7 +686,7 @@ If POS is nil, use `point' instead." | |||
| 686 | (defun outline-back-to-heading (&optional invisible-ok) | 686 | (defun outline-back-to-heading (&optional invisible-ok) |
| 687 | "Move to previous heading line, or beg of this line if it's a heading. | 687 | "Move to previous heading line, or beg of this line if it's a heading. |
| 688 | Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." | 688 | Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." |
| 689 | (beginning-of-line) | 689 | (forward-line 0) |
| 690 | (or (outline-on-heading-p invisible-ok) | 690 | (or (outline-on-heading-p invisible-ok) |
| 691 | (let (found) | 691 | (let (found) |
| 692 | (save-excursion | 692 | (save-excursion |
| @@ -705,7 +705,7 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." | |||
| 705 | "Return t if point is on a (visible) heading line. | 705 | "Return t if point is on a (visible) heading line. |
| 706 | If INVISIBLE-OK is non-nil, an invisible heading line is ok too." | 706 | If INVISIBLE-OK is non-nil, an invisible heading line is ok too." |
| 707 | (save-excursion | 707 | (save-excursion |
| 708 | (beginning-of-line) | 708 | (forward-line 0) |
| 709 | (and (bolp) (or invisible-ok (not (outline-invisible-p))) | 709 | (and (bolp) (or invisible-ok (not (outline-invisible-p))) |
| 710 | (if outline-search-function | 710 | (if outline-search-function |
| 711 | (funcall outline-search-function nil nil nil t) | 711 | (funcall outline-search-function nil nil nil t) |
| @@ -725,7 +725,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too." | |||
| 725 | (not (string-match (concat "\\`\\(?:" outline-regexp "\\)") | 725 | (not (string-match (concat "\\`\\(?:" outline-regexp "\\)") |
| 726 | (concat head " ")))) | 726 | (concat head " ")))) |
| 727 | (setq head (concat head " "))) | 727 | (setq head (concat head " "))) |
| 728 | (unless (bolp) (end-of-line) (newline)) | 728 | (unless (bolp) (goto-char (pos-eol)) (newline)) |
| 729 | (insert head) | 729 | (insert head) |
| 730 | (unless (eolp) | 730 | (unless (eolp) |
| 731 | (save-excursion (newline-and-indent))) | 731 | (save-excursion (newline-and-indent))) |
| @@ -941,9 +941,7 @@ With ARG, repeats or can move backward if negative. | |||
| 941 | A heading line is one that starts with a `*' (or that | 941 | A heading line is one that starts with a `*' (or that |
| 942 | `outline-regexp' matches)." | 942 | `outline-regexp' matches)." |
| 943 | (interactive "p") | 943 | (interactive "p") |
| 944 | (if (< arg 0) | 944 | (goto-char (if (< arg 0) (pos-bol) (pos-eol))) |
| 945 | (beginning-of-line) | ||
| 946 | (end-of-line)) | ||
| 947 | (let ((regexp (unless outline-search-function | 945 | (let ((regexp (unless outline-search-function |
| 948 | (concat "^\\(?:" outline-regexp "\\)"))) | 946 | (concat "^\\(?:" outline-regexp "\\)"))) |
| 949 | found-heading-p) | 947 | found-heading-p) |
| @@ -963,7 +961,7 @@ A heading line is one that starts with a `*' (or that | |||
| 963 | (re-search-forward regexp nil 'move))) | 961 | (re-search-forward regexp nil 'move))) |
| 964 | (outline-invisible-p (match-beginning 0)))) | 962 | (outline-invisible-p (match-beginning 0)))) |
| 965 | (setq arg (1- arg))) | 963 | (setq arg (1- arg))) |
| 966 | (if found-heading-p (beginning-of-line)))) | 964 | (if found-heading-p (forward-line 0)))) |
| 967 | 965 | ||
| 968 | (defun outline-previous-visible-heading (arg) | 966 | (defun outline-previous-visible-heading (arg) |
| 969 | "Move to the previous heading line. | 967 | "Move to the previous heading line. |
| @@ -980,7 +978,7 @@ This puts point at the start of the current subtree, and mark at the end." | |||
| 980 | (let ((beg)) | 978 | (let ((beg)) |
| 981 | (if (outline-on-heading-p) | 979 | (if (outline-on-heading-p) |
| 982 | ;; we are already looking at a heading | 980 | ;; we are already looking at a heading |
| 983 | (beginning-of-line) | 981 | (forward-line 0) |
| 984 | ;; else go back to previous heading | 982 | ;; else go back to previous heading |
| 985 | (outline-previous-visible-heading 1)) | 983 | (outline-previous-visible-heading 1)) |
| 986 | (setq beg (point)) | 984 | (setq beg (point)) |
| @@ -1183,7 +1181,7 @@ of the current heading, or to 1 if the current line is not a heading." | |||
| 1183 | (cond | 1181 | (cond |
| 1184 | (current-prefix-arg (prefix-numeric-value current-prefix-arg)) | 1182 | (current-prefix-arg (prefix-numeric-value current-prefix-arg)) |
| 1185 | ((save-excursion | 1183 | ((save-excursion |
| 1186 | (beginning-of-line) | 1184 | (forward-line 0) |
| 1187 | (if outline-search-function | 1185 | (if outline-search-function |
| 1188 | (funcall outline-search-function nil nil nil t) | 1186 | (funcall outline-search-function nil nil nil t) |
| 1189 | (looking-at outline-regexp))) | 1187 | (looking-at outline-regexp))) |
| @@ -1243,7 +1241,7 @@ This also unhides the top heading-less body, if any." | |||
| 1243 | (interactive) | 1241 | (interactive) |
| 1244 | (save-excursion | 1242 | (save-excursion |
| 1245 | (outline-back-to-heading) | 1243 | (outline-back-to-heading) |
| 1246 | (if (not (outline-invisible-p (line-end-position))) | 1244 | (if (not (outline-invisible-p (pos-eol))) |
| 1247 | (outline-hide-subtree) | 1245 | (outline-hide-subtree) |
| 1248 | (outline-show-children) | 1246 | (outline-show-children) |
| 1249 | (outline-show-entry)))) | 1247 | (outline-show-entry)))) |
| @@ -1834,7 +1832,7 @@ With a prefix argument, show headings up to that LEVEL." | |||
| 1834 | (defun outline--insert-button (type) | 1832 | (defun outline--insert-button (type) |
| 1835 | (with-silent-modifications | 1833 | (with-silent-modifications |
| 1836 | (save-excursion | 1834 | (save-excursion |
| 1837 | (beginning-of-line) | 1835 | (forward-line 0) |
| 1838 | (let ((icon (nth (if (eq type 'close) 1 0) outline--button-icons)) | 1836 | (let ((icon (nth (if (eq type 'close) 1 0) outline--button-icons)) |
| 1839 | (o (seq-find (lambda (o) (overlay-get o 'outline-button)) | 1837 | (o (seq-find (lambda (o) (overlay-get o 'outline-button)) |
| 1840 | (overlays-at (point))))) | 1838 | (overlays-at (point))))) |
| @@ -1842,7 +1840,7 @@ With a prefix argument, show headings up to that LEVEL." | |||
| 1842 | (when (eq outline-minor-mode-use-buttons 'insert) | 1840 | (when (eq outline-minor-mode-use-buttons 'insert) |
| 1843 | (let ((inhibit-read-only t)) | 1841 | (let ((inhibit-read-only t)) |
| 1844 | (insert (apply #'propertize " " (text-properties-at (point)))) | 1842 | (insert (apply #'propertize " " (text-properties-at (point)))) |
| 1845 | (beginning-of-line))) | 1843 | (forward-line 0))) |
| 1846 | (setq o (make-overlay (point) (1+ (point)))) | 1844 | (setq o (make-overlay (point) (1+ (point)))) |
| 1847 | (overlay-put o 'outline-button t) | 1845 | (overlay-put o 'outline-button t) |
| 1848 | (overlay-put o 'evaporate t)) | 1846 | (overlay-put o 'evaporate t)) |
| @@ -1866,7 +1864,7 @@ With a prefix argument, show headings up to that LEVEL." | |||
| 1866 | (when from | 1864 | (when from |
| 1867 | (save-excursion | 1865 | (save-excursion |
| 1868 | (goto-char from) | 1866 | (goto-char from) |
| 1869 | (setq from (line-beginning-position)))) | 1867 | (setq from (pos-bol)))) |
| 1870 | (outline-map-region | 1868 | (outline-map-region |
| 1871 | (lambda () | 1869 | (lambda () |
| 1872 | (let ((close-p (save-excursion | 1870 | (let ((close-p (save-excursion |
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index c8e9d097a5f..c4697a0d3b9 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el | |||
| @@ -65,7 +65,7 @@ | |||
| 65 | (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" | 65 | (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" |
| 66 | "Delimiter used to separate cookie file entries.") | 66 | "Delimiter used to separate cookie file entries.") |
| 67 | 67 | ||
| 68 | (defvar cookie-cache (make-vector 511 0) | 68 | (defvar cookie-cache (obarray-make 511) |
| 69 | "Cache of cookie files that have already been snarfed.") | 69 | "Cache of cookie files that have already been snarfed.") |
| 70 | 70 | ||
| 71 | (defun cookie-check-file (file) | 71 | (defun cookie-check-file (file) |
diff --git a/lisp/proced.el b/lisp/proced.el index 3435f1ab8cd..7d7de1e2ce3 100644 --- a/lisp/proced.el +++ b/lisp/proced.el | |||
| @@ -2261,7 +2261,7 @@ If LOG is a string and there are more args, it is formatted with | |||
| 2261 | those ARGS. Usually the LOG string ends with a \\n. | 2261 | those ARGS. Usually the LOG string ends with a \\n. |
| 2262 | End each bunch of errors with (proced-log t signal): | 2262 | End each bunch of errors with (proced-log t signal): |
| 2263 | this inserts the current time, buffer and signal at the start of the page, | 2263 | this inserts the current time, buffer and signal at the start of the page, |
| 2264 | and \f (formfeed) at the end." | 2264 | and \\f (formfeed) at the end." |
| 2265 | (let ((obuf (current-buffer))) | 2265 | (let ((obuf (current-buffer))) |
| 2266 | (with-current-buffer (get-buffer-create proced-log-buffer) | 2266 | (with-current-buffer (get-buffer-create proced-log-buffer) |
| 2267 | (goto-char (point-max)) | 2267 | (goto-char (point-max)) |
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index e5835bdb62d..4ef17daf876 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el | |||
| @@ -922,6 +922,17 @@ Return nil if NODE is not a defun node or doesn't have a name." | |||
| 922 | name))) | 922 | name))) |
| 923 | t)) | 923 | t)) |
| 924 | 924 | ||
| 925 | ;;; Outline minor mode | ||
| 926 | |||
| 927 | (defun c-ts-mode--outline-predicate (node) | ||
| 928 | "Match outlines on lines with function names." | ||
| 929 | (or (and (equal (treesit-node-type node) "function_declarator") | ||
| 930 | (equal (treesit-node-type (treesit-node-parent node)) | ||
| 931 | "function_definition")) | ||
| 932 | ;; DEFUNs in Emacs sources. | ||
| 933 | (and c-ts-mode-emacs-sources-support | ||
| 934 | (c-ts-mode--emacs-defun-p node)))) | ||
| 935 | |||
| 925 | ;;; Defun navigation | 936 | ;;; Defun navigation |
| 926 | 937 | ||
| 927 | (defun c-ts-mode--defun-valid-p (node) | 938 | (defun c-ts-mode--defun-valid-p (node) |
| @@ -1259,6 +1270,10 @@ BEG and END are described in `treesit-range-rules'." | |||
| 1259 | eos) | 1270 | eos) |
| 1260 | c-ts-mode--defun-for-class-in-imenu-p nil)))) | 1271 | c-ts-mode--defun-for-class-in-imenu-p nil)))) |
| 1261 | 1272 | ||
| 1273 | ;; Outline minor mode | ||
| 1274 | (setq-local treesit-outline-predicate | ||
| 1275 | #'c-ts-mode--outline-predicate) | ||
| 1276 | |||
| 1262 | (setq-local treesit-font-lock-feature-list | 1277 | (setq-local treesit-font-lock-feature-list |
| 1263 | c-ts-mode--feature-list)) | 1278 | c-ts-mode--feature-list)) |
| 1264 | 1279 | ||
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index f84d95dbc94..2c793c8a99d 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el | |||
| @@ -2425,7 +2425,7 @@ system." | |||
| 2425 | (error "Unknown base mode `%s'" base-mode)) | 2425 | (error "Unknown base mode `%s'" base-mode)) |
| 2426 | (put mode 'c-fallback-mode base-mode)) | 2426 | (put mode 'c-fallback-mode base-mode)) |
| 2427 | 2427 | ||
| 2428 | (defvar c-lang-constants (make-vector 151 0)) | 2428 | (defvar c-lang-constants (obarray-make 151)) |
| 2429 | ;; Obarray used as a cache to keep track of the language constants. | 2429 | ;; Obarray used as a cache to keep track of the language constants. |
| 2430 | ;; The constants stored are those defined by `c-lang-defconst' and the values | 2430 | ;; The constants stored are those defined by `c-lang-defconst' and the values |
| 2431 | ;; computed by `c-lang-const'. It's mostly used at compile time but it's not | 2431 | ;; computed by `c-lang-const'. It's mostly used at compile time but it's not |
| @@ -2579,7 +2579,8 @@ constant. A file is identified by its base name." | |||
| 2579 | ;; dependencies on the `c-lang-const's in VAL.) | 2579 | ;; dependencies on the `c-lang-const's in VAL.) |
| 2580 | (setq val (c--macroexpand-all val)) | 2580 | (setq val (c--macroexpand-all val)) |
| 2581 | 2581 | ||
| 2582 | (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings) | 2582 | (setq bindings `(cons (cons ',assigned-mode (lambda () nil ,val)) |
| 2583 | ,bindings) | ||
| 2583 | args (cdr args)))) | 2584 | args (cdr args)))) |
| 2584 | 2585 | ||
| 2585 | ;; Compile in the other files that have provided source | 2586 | ;; Compile in the other files that have provided source |
| @@ -2630,7 +2631,7 @@ constant. A file is identified by its base name." | |||
| 2630 | 2631 | ||
| 2631 | ;; Clear the evaluated values that depend on this source. | 2632 | ;; Clear the evaluated values that depend on this source. |
| 2632 | (let ((agenda (get sym 'dependents)) | 2633 | (let ((agenda (get sym 'dependents)) |
| 2633 | (visited (make-vector 101 0)) | 2634 | (visited (obarray-make 101)) |
| 2634 | ptr) | 2635 | ptr) |
| 2635 | (while agenda | 2636 | (while agenda |
| 2636 | (setq sym (car agenda) | 2637 | (setq sym (car agenda) |
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ba0d1d0fc49..ae2389c75c2 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el | |||
| @@ -3511,7 +3511,7 @@ Note that Java specific rules are currently applied to tell this from | |||
| 3511 | 3511 | ||
| 3512 | (let* ((alist (c-lang-const c-keyword-member-alist)) | 3512 | (let* ((alist (c-lang-const c-keyword-member-alist)) |
| 3513 | kwd lang-const-list | 3513 | kwd lang-const-list |
| 3514 | (obarray (make-vector (* (length alist) 2) 0))) | 3514 | (obarray (obarray-make (* (length alist) 2)))) |
| 3515 | (while alist | 3515 | (while alist |
| 3516 | (setq kwd (caar alist) | 3516 | (setq kwd (caar alist) |
| 3517 | lang-const-list (cdar alist) | 3517 | lang-const-list (cdar alist) |
diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index 29c9e957d3c..45c4882d873 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el | |||
| @@ -193,13 +193,13 @@ Check if a node type is available, then return the right font lock rules." | |||
| 193 | '((ERROR) @font-lock-warning-face)) | 193 | '((ERROR) @font-lock-warning-face)) |
| 194 | "Tree-sitter font-lock settings for `cmake-ts-mode'.") | 194 | "Tree-sitter font-lock settings for `cmake-ts-mode'.") |
| 195 | 195 | ||
| 196 | (defun cmake-ts-mode--function-name (node) | 196 | (defun cmake-ts-mode--defun-name (node) |
| 197 | "Return the function name of NODE. | 197 | "Return the defun name of NODE. |
| 198 | Return nil if there is no name or if NODE is not a function node." | 198 | Return nil if there is no name or if NODE is not a defun node." |
| 199 | (pcase (treesit-node-type node) | 199 | (pcase (treesit-node-type node) |
| 200 | ("function_command" | 200 | ((or "function_def" "macro_def") |
| 201 | (treesit-node-text | 201 | (treesit-node-text |
| 202 | (treesit-search-subtree node "^argument$" nil nil 2) | 202 | (treesit-search-subtree node "^argument$" nil nil 3) |
| 203 | t)))) | 203 | t)))) |
| 204 | 204 | ||
| 205 | ;;;###autoload | 205 | ;;;###autoload |
| @@ -216,9 +216,15 @@ Return nil if there is no name or if NODE is not a function node." | |||
| 216 | (setq-local comment-end "") | 216 | (setq-local comment-end "") |
| 217 | (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) | 217 | (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) |
| 218 | 218 | ||
| 219 | ;; Defuns. | ||
| 220 | (setq-local treesit-defun-type-regexp (rx (or "function" "macro") | ||
| 221 | "_def")) | ||
| 222 | (setq-local treesit-defun-name-function #'cmake-ts-mode--defun-name) | ||
| 223 | |||
| 219 | ;; Imenu. | 224 | ;; Imenu. |
| 220 | (setq-local treesit-simple-imenu-settings | 225 | (setq-local treesit-simple-imenu-settings |
| 221 | `(("Function" "\\`function_command\\'" nil cmake-ts-mode--function-name))) | 226 | `(("Function" "^function_def$") |
| 227 | ("Macro" "^macro_def$"))) | ||
| 222 | (setq-local which-func-functions nil) | 228 | (setq-local which-func-functions nil) |
| 223 | 229 | ||
| 224 | ;; Indent. | 230 | ;; Indent. |
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 51c81b9d2f6..11d400e145a 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -1890,6 +1890,12 @@ process from additional information inserted by Emacs." | |||
| 1890 | (defvar-local compilation--start-time nil | 1890 | (defvar-local compilation--start-time nil |
| 1891 | "The time when the compilation started as returned by `float-time'.") | 1891 | "The time when the compilation started as returned by `float-time'.") |
| 1892 | 1892 | ||
| 1893 | (defun compilation--downcase-mode-name (mode) | ||
| 1894 | "Downcase the name of major MODE, even if MODE is not a string. | ||
| 1895 | The function `downcase' will barf if passed the name of a `major-mode' | ||
| 1896 | which is not a string, but instead a symbol or a list." | ||
| 1897 | (downcase (format-mode-line mode))) | ||
| 1898 | |||
| 1893 | ;;;###autoload | 1899 | ;;;###autoload |
| 1894 | (defun compilation-start (command &optional mode name-function highlight-regexp | 1900 | (defun compilation-start (command &optional mode name-function highlight-regexp |
| 1895 | continue) | 1901 | continue) |
| @@ -2081,11 +2087,12 @@ Returns the compilation buffer created." | |||
| 2081 | (get-buffer-process | 2087 | (get-buffer-process |
| 2082 | (with-no-warnings | 2088 | (with-no-warnings |
| 2083 | (comint-exec | 2089 | (comint-exec |
| 2084 | outbuf (downcase mode-name) | 2090 | outbuf (compilation--downcase-mode-name mode-name) |
| 2085 | shell-file-name | 2091 | shell-file-name |
| 2086 | nil `(,shell-command-switch ,command))))) | 2092 | nil `(,shell-command-switch ,command))))) |
| 2087 | (start-file-process-shell-command (downcase mode-name) | 2093 | (start-file-process-shell-command |
| 2088 | outbuf command)))) | 2094 | (compilation--downcase-mode-name mode-name) |
| 2095 | outbuf command)))) | ||
| 2089 | ;; Make the buffer's mode line show process state. | 2096 | ;; Make the buffer's mode line show process state. |
| 2090 | (setq mode-line-process | 2097 | (setq mode-line-process |
| 2091 | '((:propertize ":%s" face compilation-mode-line-run) | 2098 | '((:propertize ":%s" face compilation-mode-line-run) |
| @@ -2790,7 +2797,8 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)." | |||
| 2790 | (let ((buffer (compilation-find-buffer))) | 2797 | (let ((buffer (compilation-find-buffer))) |
| 2791 | (if (get-buffer-process buffer) | 2798 | (if (get-buffer-process buffer) |
| 2792 | (interrupt-process (get-buffer-process buffer)) | 2799 | (interrupt-process (get-buffer-process buffer)) |
| 2793 | (error "The %s process is not running" (downcase mode-name))))) | 2800 | (error "The %s process is not running" |
| 2801 | (compilation--downcase-mode-name mode-name))))) | ||
| 2794 | 2802 | ||
| 2795 | (defalias 'compile-mouse-goto-error 'compile-goto-error) | 2803 | (defalias 'compile-mouse-goto-error 'compile-goto-error) |
| 2796 | 2804 | ||
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index bfc1742610c..113eed64917 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el | |||
| @@ -6557,7 +6557,7 @@ and \"Whitesmith\"." | |||
| 6557 | (let ((option (car setting)) | 6557 | (let ((option (car setting)) |
| 6558 | (value (cdr setting))) | 6558 | (value (cdr setting))) |
| 6559 | (set (make-local-variable option) value))) | 6559 | (set (make-local-variable option) value))) |
| 6560 | (set (make-local-variable 'cperl-file-style) style)) | 6560 | (setq-local cperl-file-style style)) |
| 6561 | 6561 | ||
| 6562 | (declare-function Info-find-node "info" | 6562 | (declare-function Info-find-node "info" |
| 6563 | (filename nodename &optional no-going-back strict-case | 6563 | (filename nodename &optional no-going-back strict-case |
| @@ -6612,14 +6612,13 @@ and \"Whitesmith\"." | |||
| 6612 | read)))) | 6612 | read)))) |
| 6613 | 6613 | ||
| 6614 | (let ((cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" | 6614 | (let ((cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" |
| 6615 | pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner | 6615 | pos isvar height iniheight frheight buf win iniwin not-loner |
| 6616 | max-height char-height buf-list) | 6616 | max-height char-height buf-list) |
| 6617 | (if (string-match "^-[a-zA-Z]$" command) | 6617 | (if (string-match "^-[a-zA-Z]$" command) |
| 6618 | (setq cmd-desc "^-X[ \t\n]")) | 6618 | (setq cmd-desc "^-X[ \t\n]")) |
| 6619 | (setq isvar (string-match "^[$@%]" command) | 6619 | (setq isvar (string-match "^[$@%]" command) |
| 6620 | buf (cperl-info-buffer isvar) | 6620 | buf (cperl-info-buffer isvar) |
| 6621 | iniwin (selected-window) | 6621 | iniwin (selected-window)) |
| 6622 | fr1 (window-frame iniwin)) | ||
| 6623 | (set-buffer buf) | 6622 | (set-buffer buf) |
| 6624 | (goto-char (point-min)) | 6623 | (goto-char (point-min)) |
| 6625 | (or isvar | 6624 | (or isvar |
| @@ -6640,11 +6639,7 @@ and \"Whitesmith\"." | |||
| 6640 | (or (not win) | 6639 | (or (not win) |
| 6641 | (eq (window-buffer win) buf) | 6640 | (eq (window-buffer win) buf) |
| 6642 | (set-window-buffer win buf)) | 6641 | (set-window-buffer win buf)) |
| 6643 | (and win (setq fr2 (window-frame win))) | 6642 | (pop-to-buffer buf) |
| 6644 | (if (or (not fr2) (eq fr1 fr2)) | ||
| 6645 | (pop-to-buffer buf) | ||
| 6646 | (special-display-popup-frame buf) ; Make it visible | ||
| 6647 | (select-window win)) | ||
| 6648 | (goto-char pos) ; Needed (?!). | 6643 | (goto-char pos) ; Needed (?!). |
| 6649 | ;; Resize | 6644 | ;; Resize |
| 6650 | (setq iniheight (window-height) | 6645 | (setq iniheight (window-height) |
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index beba268f923..f341428cac3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el | |||
| @@ -243,7 +243,7 @@ automatically)." | |||
| 243 | (typescript-mode :language-id "typescript")) | 243 | (typescript-mode :language-id "typescript")) |
| 244 | . ("typescript-language-server" "--stdio")) | 244 | . ("typescript-language-server" "--stdio")) |
| 245 | ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) | 245 | ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) |
| 246 | ((php-mode phps-mode) | 246 | ((php-mode phps-mode php-ts-mode) |
| 247 | . ,(eglot-alternatives | 247 | . ,(eglot-alternatives |
| 248 | '(("phpactor" "language-server") | 248 | '(("phpactor" "language-server") |
| 249 | ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) | 249 | ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) |
| @@ -259,7 +259,7 @@ automatically)." | |||
| 259 | . ("haskell-language-server-wrapper" "--lsp")) | 259 | . ("haskell-language-server-wrapper" "--lsp")) |
| 260 | (elm-mode . ("elm-language-server")) | 260 | (elm-mode . ("elm-language-server")) |
| 261 | (mint-mode . ("mint" "ls")) | 261 | (mint-mode . ("mint" "ls")) |
| 262 | (kotlin-mode . ("kotlin-language-server")) | 262 | ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) |
| 263 | ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) | 263 | ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) |
| 264 | . ("gopls")) | 264 | . ("gopls")) |
| 265 | ((R-mode ess-r-mode) . ("R" "--slave" "-e" | 265 | ((R-mode ess-r-mode) . ("R" "--slave" "-e" |
| @@ -284,6 +284,7 @@ automatically)." | |||
| 284 | ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) | 284 | ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) |
| 285 | (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) | 285 | (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) |
| 286 | (nickel-mode . ("nls")) | 286 | (nickel-mode . ("nls")) |
| 287 | ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) | ||
| 287 | (gdscript-mode . ("localhost" 6008)) | 288 | (gdscript-mode . ("localhost" 6008)) |
| 288 | ((fortran-mode f90-mode) . ("fortls")) | 289 | ((fortran-mode f90-mode) . ("fortls")) |
| 289 | (futhark-mode . ("futhark" "lsp")) | 290 | (futhark-mode . ("futhark" "lsp")) |
| @@ -309,7 +310,10 @@ automatically)." | |||
| 309 | ("vscode-markdown-language-server" "--stdio")))) | 310 | ("vscode-markdown-language-server" "--stdio")))) |
| 310 | (graphviz-dot-mode . ("dot-language-server" "--stdio")) | 311 | (graphviz-dot-mode . ("dot-language-server" "--stdio")) |
| 311 | (terraform-mode . ("terraform-ls" "serve")) | 312 | (terraform-mode . ("terraform-ls" "serve")) |
| 312 | ((uiua-ts-mode uiua-mode) . ("uiua" "lsp"))) | 313 | ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")) |
| 314 | (sml-mode | ||
| 315 | . ,(lambda (_interactive project) | ||
| 316 | (list "millet-ls" (project-root project))))) | ||
| 313 | "How the command `eglot' guesses the server to start. | 317 | "How the command `eglot' guesses the server to start. |
| 314 | An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE | 318 | An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE |
| 315 | identifies the buffers that are to be managed by a specific | 319 | identifies the buffers that are to be managed by a specific |
| @@ -590,7 +594,7 @@ It is nil if Eglot is not byte-complied.") | |||
| 590 | (let ((vec (copy-sequence url-path-allowed-chars))) | 594 | (let ((vec (copy-sequence url-path-allowed-chars))) |
| 591 | (aset vec ?: nil) ;; see github#639 | 595 | (aset vec ?: nil) ;; see github#639 |
| 592 | vec) | 596 | vec) |
| 593 | "Like `url-path-allows-chars' but more restrictive.") | 597 | "Like `url-path-allowed-chars' but more restrictive.") |
| 594 | 598 | ||
| 595 | 599 | ||
| 596 | ;;; Message verification helpers | 600 | ;;; Message verification helpers |
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index da0cb96e1cf..8a713bd19a2 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el | |||
| @@ -221,7 +221,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map." | |||
| 221 | (load (byte-compile-dest-file buffer-file-name))) | 221 | (load (byte-compile-dest-file buffer-file-name))) |
| 222 | 222 | ||
| 223 | (declare-function native-compile "comp") | 223 | (declare-function native-compile "comp") |
| 224 | (declare-function comp-write-bytecode-file "comp") | 224 | (declare-function comp--write-bytecode-file "comp") |
| 225 | 225 | ||
| 226 | (defun emacs-lisp-native-compile () | 226 | (defun emacs-lisp-native-compile () |
| 227 | "Native-compile the current buffer's file (if it has changed). | 227 | "Native-compile the current buffer's file (if it has changed). |
| @@ -233,7 +233,7 @@ visited by the current buffer." | |||
| 233 | (byte-to-native-output-buffer-file nil) | 233 | (byte-to-native-output-buffer-file nil) |
| 234 | (eln (native-compile buffer-file-name))) | 234 | (eln (native-compile buffer-file-name))) |
| 235 | (when eln | 235 | (when eln |
| 236 | (comp-write-bytecode-file eln)))) | 236 | (comp--write-bytecode-file eln)))) |
| 237 | 237 | ||
| 238 | (defun emacs-lisp-native-compile-and-load () | 238 | (defun emacs-lisp-native-compile-and-load () |
| 239 | "Native-compile the current buffer's file (if it has changed), then load it. | 239 | "Native-compile the current buffer's file (if it has changed), then load it. |
| @@ -309,7 +309,7 @@ Comments in the form will be lost." | |||
| 309 | INTERACTIVE non-nil means ask the user for confirmation; this | 309 | INTERACTIVE non-nil means ask the user for confirmation; this |
| 310 | happens in interactive invocations." | 310 | happens in interactive invocations." |
| 311 | (interactive "p") | 311 | (interactive "p") |
| 312 | (if lexical-binding | 312 | (if (and (local-variable-p 'lexical-binding) lexical-binding) |
| 313 | (when interactive | 313 | (when interactive |
| 314 | (message "lexical-binding already enabled!") | 314 | (message "lexical-binding already enabled!") |
| 315 | (ding)) | 315 | (ding)) |
| @@ -371,6 +371,12 @@ be used instead. | |||
| 371 | 371 | ||
| 372 | ;; Font-locking support. | 372 | ;; Font-locking support. |
| 373 | 373 | ||
| 374 | (defun elisp--font-lock-shorthand (_limit) | ||
| 375 | ;; Add faces on shorthands between point and LIMIT. | ||
| 376 | ;; ... | ||
| 377 | ;; Return nil to tell font-lock, that there's nothing left to do. | ||
| 378 | nil) | ||
| 379 | |||
| 374 | (defun elisp--font-lock-flush-elisp-buffers (&optional file) | 380 | (defun elisp--font-lock-flush-elisp-buffers (&optional file) |
| 375 | ;; We're only ever called from after-load-functions, load-in-progress can | 381 | ;; We're only ever called from after-load-functions, load-in-progress can |
| 376 | ;; still be t in case of nested loads. | 382 | ;; still be t in case of nested loads. |
| @@ -1582,9 +1588,6 @@ character)." | |||
| 1582 | (buffer-substring-no-properties beg end)) | 1588 | (buffer-substring-no-properties beg end)) |
| 1583 | )))) | 1589 | )))) |
| 1584 | 1590 | ||
| 1585 | |||
| 1586 | (defvar elisp--eval-last-sexp-fake-value (make-symbol "t")) | ||
| 1587 | |||
| 1588 | (defun eval-sexp-add-defvars (exp &optional pos) | 1591 | (defun eval-sexp-add-defvars (exp &optional pos) |
| 1589 | "Prepend EXP with all the `defvar's that precede it in the buffer. | 1592 | "Prepend EXP with all the `defvar's that precede it in the buffer. |
| 1590 | POS specifies the starting position where EXP was found and defaults to point." | 1593 | POS specifies the starting position where EXP was found and defaults to point." |
| @@ -1626,16 +1629,10 @@ integer value is also printed as a character of that codepoint. | |||
| 1626 | If `eval-expression-debug-on-error' is non-nil, which is the default, | 1629 | If `eval-expression-debug-on-error' is non-nil, which is the default, |
| 1627 | this command arranges for all errors to enter the debugger." | 1630 | this command arranges for all errors to enter the debugger." |
| 1628 | (interactive "P") | 1631 | (interactive "P") |
| 1629 | (if (null eval-expression-debug-on-error) | 1632 | (values--store-value |
| 1630 | (values--store-value | 1633 | (handler-bind ((error (if eval-expression-debug-on-error |
| 1631 | (elisp--eval-last-sexp eval-last-sexp-arg-internal)) | 1634 | #'eval-expression--debug #'ignore))) |
| 1632 | (let ((value | 1635 | (elisp--eval-last-sexp eval-last-sexp-arg-internal)))) |
| 1633 | (let ((debug-on-error elisp--eval-last-sexp-fake-value)) | ||
| 1634 | (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal) | ||
| 1635 | debug-on-error)))) | ||
| 1636 | (unless (eq (cdr value) elisp--eval-last-sexp-fake-value) | ||
| 1637 | (setq debug-on-error (cdr value))) | ||
| 1638 | (car value)))) | ||
| 1639 | 1636 | ||
| 1640 | (defun elisp--eval-defun-1 (form) | 1637 | (defun elisp--eval-defun-1 (form) |
| 1641 | "Treat some expressions in FORM specially. | 1638 | "Treat some expressions in FORM specially. |
| @@ -1694,8 +1691,7 @@ Return the result of evaluation." | |||
| 1694 | ;; FIXME: the print-length/level bindings should only be applied while | 1691 | ;; FIXME: the print-length/level bindings should only be applied while |
| 1695 | ;; printing, not while evaluating. | 1692 | ;; printing, not while evaluating. |
| 1696 | (defvar elisp--eval-defun-result) | 1693 | (defvar elisp--eval-defun-result) |
| 1697 | (let ((debug-on-error eval-expression-debug-on-error) | 1694 | (let ((edebugging edebug-all-defs) |
| 1698 | (edebugging edebug-all-defs) | ||
| 1699 | elisp--eval-defun-result) | 1695 | elisp--eval-defun-result) |
| 1700 | (save-excursion | 1696 | (save-excursion |
| 1701 | ;; Arrange for eval-region to "read" the (possibly) altered form. | 1697 | ;; Arrange for eval-region to "read" the (possibly) altered form. |
| @@ -1774,15 +1770,9 @@ which see." | |||
| 1774 | (defvar edebug-all-defs) | 1770 | (defvar edebug-all-defs) |
| 1775 | (eval-defun (not edebug-all-defs))) | 1771 | (eval-defun (not edebug-all-defs))) |
| 1776 | (t | 1772 | (t |
| 1777 | (if (null eval-expression-debug-on-error) | 1773 | (handler-bind ((error (if eval-expression-debug-on-error |
| 1778 | (elisp--eval-defun) | 1774 | #'eval-expression--debug #'ignore))) |
| 1779 | (let (new-value value) | 1775 | (elisp--eval-defun))))) |
| 1780 | (let ((debug-on-error elisp--eval-last-sexp-fake-value)) | ||
| 1781 | (setq value (elisp--eval-defun)) | ||
| 1782 | (setq new-value debug-on-error)) | ||
| 1783 | (unless (eq elisp--eval-last-sexp-fake-value new-value) | ||
| 1784 | (setq debug-on-error new-value)) | ||
| 1785 | value))))) | ||
| 1786 | 1776 | ||
| 1787 | ;;; ElDoc Support | 1777 | ;;; ElDoc Support |
| 1788 | 1778 | ||
diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index b493195eedd..f26c3a49203 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el | |||
| @@ -360,13 +360,19 @@ | |||
| 360 | (defvar elixir-ts--font-lock-settings | 360 | (defvar elixir-ts--font-lock-settings |
| 361 | (treesit-font-lock-rules | 361 | (treesit-font-lock-rules |
| 362 | :language 'elixir | 362 | :language 'elixir |
| 363 | :feature 'elixir-function-name | 363 | :feature 'elixir-definition |
| 364 | `((call target: (identifier) @target-identifier | 364 | `((call target: (identifier) @target-identifier |
| 365 | (arguments | ||
| 366 | (call target: (identifier) @font-lock-function-name-face | ||
| 367 | (arguments))) | ||
| 368 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) | ||
| 369 | (call target: (identifier) @target-identifier | ||
| 365 | (arguments (identifier) @font-lock-function-name-face) | 370 | (arguments (identifier) @font-lock-function-name-face) |
| 366 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) | 371 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) |
| 367 | (call target: (identifier) @target-identifier | 372 | (call target: (identifier) @target-identifier |
| 368 | (arguments | 373 | (arguments |
| 369 | (call target: (identifier) @font-lock-function-name-face)) | 374 | (call target: (identifier) @font-lock-function-name-face |
| 375 | (arguments ((identifier)) @font-lock-variable-name-face))) | ||
| 370 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) | 376 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) |
| 371 | (call target: (identifier) @target-identifier | 377 | (call target: (identifier) @target-identifier |
| 372 | (arguments | 378 | (arguments |
| @@ -379,13 +385,15 @@ | |||
| 379 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) | 385 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) |
| 380 | (call target: (identifier) @target-identifier | 386 | (call target: (identifier) @target-identifier |
| 381 | (arguments | 387 | (arguments |
| 382 | (call target: (identifier) @font-lock-function-name-face)) | 388 | (call target: (identifier) @font-lock-function-name-face |
| 389 | (arguments ((identifier)) @font-lock-variable-name-face))) | ||
| 383 | (do_block) | 390 | (do_block) |
| 384 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) | 391 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) |
| 385 | (call target: (identifier) @target-identifier | 392 | (call target: (identifier) @target-identifier |
| 386 | (arguments | 393 | (arguments |
| 387 | (binary_operator | 394 | (binary_operator |
| 388 | left: (call target: (identifier) @font-lock-function-name-face))) | 395 | left: (call target: (identifier) @font-lock-function-name-face |
| 396 | (arguments ((identifier)) @font-lock-variable-name-face)))) | ||
| 389 | (do_block) | 397 | (do_block) |
| 390 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) | 398 | (:match ,elixir-ts--definition-keywords-re @target-identifier)) |
| 391 | (unary_operator | 399 | (unary_operator |
| @@ -521,8 +529,8 @@ | |||
| 521 | operator: "/" right: (integer))) | 529 | operator: "/" right: (integer))) |
| 522 | (call | 530 | (call |
| 523 | target: (dot right: (identifier) @font-lock-function-call-face)) | 531 | target: (dot right: (identifier) @font-lock-function-call-face)) |
| 524 | (unary_operator operator: "&" @font-lock-variable-name-face | 532 | (unary_operator operator: "&" @font-lock-variable-use-face |
| 525 | operand: (integer) @font-lock-variable-name-face) | 533 | operand: (integer) @font-lock-variable-use-face) |
| 526 | (unary_operator operator: "&" @font-lock-operator-face | 534 | (unary_operator operator: "&" @font-lock-operator-face |
| 527 | operand: (list))) | 535 | operand: (list))) |
| 528 | 536 | ||
| @@ -537,16 +545,18 @@ | |||
| 537 | 545 | ||
| 538 | :language 'elixir | 546 | :language 'elixir |
| 539 | :feature 'elixir-variable | 547 | :feature 'elixir-variable |
| 540 | '((binary_operator left: (identifier) @font-lock-variable-name-face) | 548 | '((binary_operator left: (identifier) @font-lock-variable-use-face) |
| 541 | (binary_operator right: (identifier) @font-lock-variable-name-face) | 549 | (binary_operator right: (identifier) @font-lock-variable-use-face) |
| 542 | (arguments ( (identifier) @font-lock-variable-name-face)) | 550 | (arguments ( (identifier) @font-lock-variable-use-face)) |
| 543 | (tuple (identifier) @font-lock-variable-name-face) | 551 | (tuple (identifier) @font-lock-variable-use-face) |
| 544 | (list (identifier) @font-lock-variable-name-face) | 552 | (list (identifier) @font-lock-variable-use-face) |
| 545 | (pair value: (identifier) @font-lock-variable-name-face) | 553 | (pair value: (identifier) @font-lock-variable-use-face) |
| 546 | (body (identifier) @font-lock-variable-name-face) | 554 | (body (identifier) @font-lock-variable-use-face) |
| 547 | (unary_operator operand: (identifier) @font-lock-variable-name-face) | 555 | (unary_operator operand: (identifier) @font-lock-variable-use-face) |
| 548 | (interpolation (identifier) @font-lock-variable-name-face) | 556 | (interpolation (identifier) @font-lock-variable-use-face) |
| 549 | (do_block (identifier) @font-lock-variable-name-face)) | 557 | (do_block (identifier) @font-lock-variable-use-face) |
| 558 | (access_call target: (identifier) @font-lock-variable-use-face) | ||
| 559 | (access_call "[" key: (identifier) @font-lock-variable-use-face "]")) | ||
| 550 | 560 | ||
| 551 | :language 'elixir | 561 | :language 'elixir |
| 552 | :feature 'elixir-builtin | 562 | :feature 'elixir-builtin |
| @@ -697,11 +707,10 @@ Return nil if NODE is not a defun node or doesn't have a name." | |||
| 697 | ;; Font-lock. | 707 | ;; Font-lock. |
| 698 | (setq-local treesit-font-lock-settings elixir-ts--font-lock-settings) | 708 | (setq-local treesit-font-lock-settings elixir-ts--font-lock-settings) |
| 699 | (setq-local treesit-font-lock-feature-list | 709 | (setq-local treesit-font-lock-feature-list |
| 700 | '(( elixir-comment elixir-doc elixir-function-name) | 710 | '(( elixir-comment elixir-doc elixir-definition) |
| 701 | ( elixir-string elixir-keyword elixir-data-type) | 711 | ( elixir-string elixir-keyword elixir-data-type) |
| 702 | ( elixir-sigil elixir-variable elixir-builtin | 712 | ( elixir-sigil elixir-builtin elixir-string-escape) |
| 703 | elixir-string-escape) | 713 | ( elixir-function-call elixir-variable elixir-operator elixir-number ))) |
| 704 | ( elixir-function-call elixir-operator elixir-number ))) | ||
| 705 | 714 | ||
| 706 | 715 | ||
| 707 | ;; Imenu. | 716 | ;; Imenu. |
| @@ -734,13 +743,12 @@ Return nil if NODE is not a defun node or doesn't have a name." | |||
| 734 | heex-ts--indent-rules)) | 743 | heex-ts--indent-rules)) |
| 735 | 744 | ||
| 736 | (setq-local treesit-font-lock-feature-list | 745 | (setq-local treesit-font-lock-feature-list |
| 737 | '(( elixir-comment elixir-doc elixir-function-name | 746 | '(( elixir-comment elixir-doc elixir-definition |
| 738 | heex-comment heex-keyword heex-doctype ) | 747 | heex-comment heex-keyword heex-doctype ) |
| 739 | ( elixir-string elixir-keyword elixir-data-type | 748 | ( elixir-string elixir-keyword elixir-data-type |
| 740 | heex-component heex-tag heex-attribute heex-string ) | 749 | heex-component heex-tag heex-attribute heex-string ) |
| 741 | ( elixir-sigil elixir-variable elixir-builtin | 750 | ( elixir-sigil elixir-builtin elixir-string-escape) |
| 742 | elixir-string-escape) | 751 | ( elixir-function-call elixir-variable elixir-operator elixir-number )))) |
| 743 | ( elixir-function-call elixir-operator elixir-number )))) | ||
| 744 | 752 | ||
| 745 | (treesit-major-mode-setup) | 753 | (treesit-major-mode-setup) |
| 746 | (setq-local syntax-propertize-function #'elixir-ts--syntax-propertize))) | 754 | (setq-local syntax-propertize-function #'elixir-ts--syntax-propertize))) |
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index b9bd772ddfc..476037eb8bd 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el | |||
| @@ -1488,7 +1488,7 @@ hits the start of file." | |||
| 1488 | (setq symbs (symbol-value symbs)) | 1488 | (setq symbs (symbol-value symbs)) |
| 1489 | (insert (format-message "symbol `%s' has no value\n" symbs)) | 1489 | (insert (format-message "symbol `%s' has no value\n" symbs)) |
| 1490 | (setq symbs nil))) | 1490 | (setq symbs nil))) |
| 1491 | (if (vectorp symbs) | 1491 | (if (obarrayp symbs) |
| 1492 | (mapatoms ins-symb symbs) | 1492 | (mapatoms ins-symb symbs) |
| 1493 | (dolist (sy symbs) | 1493 | (dolist (sy symbs) |
| 1494 | (funcall ins-symb (car sy)))) | 1494 | (funcall ins-symb (car sy)))) |
| @@ -2183,7 +2183,7 @@ file name, add `tag-partial-file-name-match-p' to the list value.") | |||
| 2183 | (setq symbs (symbol-value symbs)) | 2183 | (setq symbs (symbol-value symbs)) |
| 2184 | (warn "symbol `%s' has no value" symbs) | 2184 | (warn "symbol `%s' has no value" symbs) |
| 2185 | (setq symbs nil)) | 2185 | (setq symbs nil)) |
| 2186 | (if (vectorp symbs) | 2186 | (if (obarrayp symbs) |
| 2187 | (mapatoms add-xref symbs) | 2187 | (mapatoms add-xref symbs) |
| 2188 | (dolist (sy symbs) | 2188 | (dolist (sy symbs) |
| 2189 | (funcall add-xref (car sy)))) | 2189 | (funcall add-xref (car sy)))) |
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 5974f076556..db00cc59c0e 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el | |||
| @@ -1569,13 +1569,19 @@ correctly.") | |||
| 1569 | ,flymake-mode-line-lighter | 1569 | ,flymake-mode-line-lighter |
| 1570 | mouse-face mode-line-highlight | 1570 | mouse-face mode-line-highlight |
| 1571 | help-echo | 1571 | help-echo |
| 1572 | ,(lambda (&rest _) | 1572 | ,(lambda (w &rest _) |
| 1573 | (concat | 1573 | (with-current-buffer (window-buffer w) |
| 1574 | (format "%s known backends\n" (hash-table-count flymake--state)) | 1574 | ;; Mouse can activate tool-tip without window being active. |
| 1575 | (format "%s running\n" (length (flymake-running-backends))) | 1575 | ;; `flymake--state' is buffer local and is null when line |
| 1576 | (format "%s disabled\n" (length (flymake-disabled-backends))) | 1576 | ;; lighter appears in *Help* `describe-mode'. |
| 1577 | "mouse-1: Display minor mode menu\n" | 1577 | (concat |
| 1578 | "mouse-2: Show help for minor mode")) | 1578 | (unless (null flymake--state) |
| 1579 | (concat | ||
| 1580 | (format "%s known backends\n" (hash-table-count flymake--state)) | ||
| 1581 | (format "%s running\n" (length (flymake-running-backends))) | ||
| 1582 | (format "%s disabled\n" (length (flymake-disabled-backends))))) | ||
| 1583 | "mouse-1: Display minor mode menu\n" | ||
| 1584 | "mouse-2: Show help for minor mode"))) | ||
| 1579 | keymap | 1585 | keymap |
| 1580 | ,(let ((map (make-sparse-keymap))) | 1586 | ,(let ((map (make-sparse-keymap))) |
| 1581 | (define-key map [mode-line down-mouse-1] | 1587 | (define-key map [mode-line down-mouse-1] |
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index be6357f4139..b7c85fe7f43 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el | |||
| @@ -243,7 +243,7 @@ Check it when `gud-running' is t") | |||
| 243 | :visible (eq gud-minor-mode 'gdbmi)] | 243 | :visible (eq gud-minor-mode 'gdbmi)] |
| 244 | ["Print Expression" gud-print | 244 | ["Print Expression" gud-print |
| 245 | :enable (not gud-running)] | 245 | :enable (not gud-running)] |
| 246 | ["Dump object-Derefenrece" gud-pstar | 246 | ["Dump object-Dereference" gud-pstar |
| 247 | :label (if (eq gud-minor-mode 'jdb) | 247 | :label (if (eq gud-minor-mode 'jdb) |
| 248 | "Dump object" | 248 | "Dump object" |
| 249 | "Print Dereference") | 249 | "Print Dereference") |
diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el index 7b53a44deb2..22e8956661d 100644 --- a/lisp/progmodes/heex-ts-mode.el +++ b/lisp/progmodes/heex-ts-mode.el | |||
| @@ -166,6 +166,16 @@ With ARG, do it many times. Negative ARG means move backward." | |||
| 166 | ("Slot" "\\`slot\\'" nil nil) | 166 | ("Slot" "\\`slot\\'" nil nil) |
| 167 | ("Tag" "\\`tag\\'" nil nil))) | 167 | ("Tag" "\\`tag\\'" nil nil))) |
| 168 | 168 | ||
| 169 | ;; Outline minor mode | ||
| 170 | ;; `heex-ts-mode' inherits from `html-mode' that sets | ||
| 171 | ;; regexp-based outline variables. So need to restore | ||
| 172 | ;; the default values of outline variables to be able | ||
| 173 | ;; to use `treesit-outline-predicate' derived | ||
| 174 | ;; from `treesit-simple-imenu-settings' above. | ||
| 175 | (kill-local-variable 'outline-heading-end-regexp) | ||
| 176 | (kill-local-variable 'outline-regexp) | ||
| 177 | (kill-local-variable 'outline-level) | ||
| 178 | |||
| 169 | (setq-local treesit-font-lock-settings heex-ts--font-lock-settings) | 179 | (setq-local treesit-font-lock-settings heex-ts--font-lock-settings) |
| 170 | 180 | ||
| 171 | (setq-local treesit-simple-indent-rules heex-ts--indent-rules) | 181 | (setq-local treesit-simple-indent-rules heex-ts--indent-rules) |
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 71f55379d96..98e567299a1 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el | |||
| @@ -390,7 +390,7 @@ If there is a marked region from START to END it only shows the symbols within." | |||
| 390 | (defun hif-after-revert-function () | 390 | (defun hif-after-revert-function () |
| 391 | (and hide-ifdef-mode hide-ifdef-hiding | 391 | (and hide-ifdef-mode hide-ifdef-hiding |
| 392 | (hide-ifdefs nil nil t))) | 392 | (hide-ifdefs nil nil t))) |
| 393 | (add-hook 'after-revert-hook 'hif-after-revert-function) | 393 | (add-hook 'after-revert-hook #'hif-after-revert-function) |
| 394 | 394 | ||
| 395 | (defun hif-end-of-line () | 395 | (defun hif-end-of-line () |
| 396 | "Find the end-point of line concatenation." | 396 | "Find the end-point of line concatenation." |
| @@ -474,7 +474,7 @@ Everything including these lines is made invisible." | |||
| 474 | 474 | ||
| 475 | (defun hif-eval (form) | 475 | (defun hif-eval (form) |
| 476 | "Evaluate hideif internal representation." | 476 | "Evaluate hideif internal representation." |
| 477 | (let ((val (eval form))) | 477 | (let ((val (eval form t))) |
| 478 | (if (stringp val) | 478 | (if (stringp val) |
| 479 | (or (get-text-property 0 'hif-value val) | 479 | (or (get-text-property 0 'hif-value val) |
| 480 | val) | 480 | val) |
| @@ -542,7 +542,7 @@ that form should be displayed.") | |||
| 542 | (defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*") | 542 | (defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*") |
| 543 | (defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) | 543 | (defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) |
| 544 | (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) | 544 | (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) |
| 545 | (defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) | 545 | (defvar hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) |
| 546 | (defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) | 546 | (defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) |
| 547 | (defconst hif-else-regexp (concat hif-cpp-prefix "else")) | 547 | (defconst hif-else-regexp (concat hif-cpp-prefix "else")) |
| 548 | (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) | 548 | (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) |
| @@ -679,7 +679,7 @@ that form should be displayed.") | |||
| 679 | ("..." . hif-etc) | 679 | ("..." . hif-etc) |
| 680 | ("defined" . hif-defined))) | 680 | ("defined" . hif-defined))) |
| 681 | 681 | ||
| 682 | (defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) | 682 | (defconst hif-valid-token-list (mapcar #'cdr hif-token-alist)) |
| 683 | 683 | ||
| 684 | (defconst hif-token-regexp | 684 | (defconst hif-token-regexp |
| 685 | ;; The ordering of regexp grouping is crucial to `hif-strtok' | 685 | ;; The ordering of regexp grouping is crucial to `hif-strtok' |
| @@ -690,7 +690,7 @@ that form should be displayed.") | |||
| 690 | ;; decimal/octal: | 690 | ;; decimal/octal: |
| 691 | "\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?" | 691 | "\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?" |
| 692 | hif-numtype-suffix-regexp "?\\)" | 692 | hif-numtype-suffix-regexp "?\\)" |
| 693 | "\\|" (regexp-opt (mapcar 'car hif-token-alist) t) | 693 | "\\|" (regexp-opt (mapcar #'car hif-token-alist) t) |
| 694 | "\\|\\(\\w+\\)")) | 694 | "\\|\\(\\w+\\)")) |
| 695 | 695 | ||
| 696 | ;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"") | 696 | ;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"") |
| @@ -867,7 +867,7 @@ Assuming we've just performed a `hif-token-regexp' lookup." | |||
| 867 | 867 | ||
| 868 | (t | 868 | (t |
| 869 | (setq hif-simple-token-only nil) | 869 | (setq hif-simple-token-only nil) |
| 870 | (intern-safe string))))) | 870 | (hif--intern-safe string))))) |
| 871 | 871 | ||
| 872 | (defun hif-backward-comment (&optional start end) | 872 | (defun hif-backward-comment (&optional start end) |
| 873 | "If we're currently within a C(++) comment, skip them backwards." | 873 | "If we're currently within a C(++) comment, skip them backwards." |
| @@ -1448,7 +1448,7 @@ This macro cannot be evaluated alone without parameters input." | |||
| 1448 | (t | 1448 | (t |
| 1449 | (error "Invalid token to stringify")))) | 1449 | (error "Invalid token to stringify")))) |
| 1450 | 1450 | ||
| 1451 | (defun intern-safe (str) | 1451 | (defun hif--intern-safe (str) |
| 1452 | (if (stringp str) | 1452 | (if (stringp str) |
| 1453 | (intern str))) | 1453 | (intern str))) |
| 1454 | 1454 | ||
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 0f11103cf02..b5d91f46b17 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el | |||
| @@ -96,8 +96,8 @@ | |||
| 96 | 96 | ||
| 97 | (defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> " | 97 | (defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> " |
| 98 | "Regexp to match IDL prompt at beginning of a line. | 98 | "Regexp to match IDL prompt at beginning of a line. |
| 99 | For example, \"^\r?IDL> \" or \"^\r?WAVE> \". | 99 | For example, \"^\\r?IDL> \" or \"^\\r?WAVE> \". |
| 100 | The \"^\r?\" is needed, to indicate the beginning of the line, with | 100 | The \"^\\r?\" is needed, to indicate the beginning of the line, with |
| 101 | optional return character (which IDL seems to output randomly). | 101 | optional return character (which IDL seems to output randomly). |
| 102 | This variable is used to initialize `comint-prompt-regexp' in the | 102 | This variable is used to initialize `comint-prompt-regexp' in the |
| 103 | process buffer." | 103 | process buffer." |
diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 0b1ac49b99f..00d7d0d75a1 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el | |||
| @@ -74,7 +74,12 @@ | |||
| 74 | ((parent-is "program") column-0 0) | 74 | ((parent-is "program") column-0 0) |
| 75 | ((match "}" "element_value_array_initializer") | 75 | ((match "}" "element_value_array_initializer") |
| 76 | parent-bol 0) | 76 | parent-bol 0) |
| 77 | ((node-is "}") column-0 c-ts-common-statement-offset) | 77 | ((node-is |
| 78 | ,(format "\\`%s\\'" | ||
| 79 | (regexp-opt '("constructor_body" "class_body" "interface_body" | ||
| 80 | "block" "switch_block" "array_initializer")))) | ||
| 81 | parent-bol 0) | ||
| 82 | ((node-is "}") standalone-parent 0) | ||
| 78 | ((node-is ")") parent-bol 0) | 83 | ((node-is ")") parent-bol 0) |
| 79 | ((node-is "else") parent-bol 0) | 84 | ((node-is "else") parent-bol 0) |
| 80 | ((node-is "]") parent-bol 0) | 85 | ((node-is "]") parent-bol 0) |
| @@ -86,10 +91,10 @@ | |||
| 86 | ((parent-is "array_initializer") parent-bol java-ts-mode-indent-offset) | 91 | ((parent-is "array_initializer") parent-bol java-ts-mode-indent-offset) |
| 87 | ((parent-is "annotation_type_body") column-0 c-ts-common-statement-offset) | 92 | ((parent-is "annotation_type_body") column-0 c-ts-common-statement-offset) |
| 88 | ((parent-is "interface_body") column-0 c-ts-common-statement-offset) | 93 | ((parent-is "interface_body") column-0 c-ts-common-statement-offset) |
| 89 | ((parent-is "constructor_body") column-0 c-ts-common-statement-offset) | 94 | ((parent-is "constructor_body") standalone-parent java-ts-mode-indent-offset) |
| 90 | ((parent-is "enum_body_declarations") parent-bol 0) | 95 | ((parent-is "enum_body_declarations") parent-bol 0) |
| 91 | ((parent-is "enum_body") column-0 c-ts-common-statement-offset) | 96 | ((parent-is "enum_body") column-0 c-ts-common-statement-offset) |
| 92 | ((parent-is "switch_block") column-0 c-ts-common-statement-offset) | 97 | ((parent-is "switch_block") standalone-parent java-ts-mode-indent-offset) |
| 93 | ((parent-is "record_declaration_body") column-0 c-ts-common-statement-offset) | 98 | ((parent-is "record_declaration_body") column-0 c-ts-common-statement-offset) |
| 94 | ((query "(method_declaration (block _ @indent))") parent-bol java-ts-mode-indent-offset) | 99 | ((query "(method_declaration (block _ @indent))") parent-bol java-ts-mode-indent-offset) |
| 95 | ((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset) | 100 | ((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset) |
| @@ -125,7 +130,7 @@ | |||
| 125 | ((parent-is "case_statement") parent-bol java-ts-mode-indent-offset) | 130 | ((parent-is "case_statement") parent-bol java-ts-mode-indent-offset) |
| 126 | ((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset) | 131 | ((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset) |
| 127 | ((parent-is "do_statement") parent-bol java-ts-mode-indent-offset) | 132 | ((parent-is "do_statement") parent-bol java-ts-mode-indent-offset) |
| 128 | ((parent-is "block") column-0 c-ts-common-statement-offset))) | 133 | ((parent-is "block") standalone-parent java-ts-mode-indent-offset))) |
| 129 | "Tree-sitter indent rules.") | 134 | "Tree-sitter indent rules.") |
| 130 | 135 | ||
| 131 | (defvar java-ts-mode--keywords | 136 | (defvar java-ts-mode--keywords |
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 947d91c9b1a..ebc098e6a75 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el | |||
| @@ -3418,6 +3418,26 @@ This function is intended for use in `after-change-functions'." | |||
| 3418 | 3418 | ||
| 3419 | ;;; Tree sitter integration | 3419 | ;;; Tree sitter integration |
| 3420 | 3420 | ||
| 3421 | (defun js--treesit-font-lock-compatibility-definition-feature () | ||
| 3422 | "Font lock helper, to handle different releases of tree-sitter-javascript. | ||
| 3423 | Check if a node type is available, then return the right font lock rules | ||
| 3424 | for \"definition\" feature." | ||
| 3425 | (condition-case nil | ||
| 3426 | (progn (treesit-query-capture 'javascript '((function_expression) @cap)) | ||
| 3427 | ;; Starting from version 0.20.2 of the grammar. | ||
| 3428 | '((function_expression | ||
| 3429 | name: (identifier) @font-lock-function-name-face) | ||
| 3430 | (variable_declarator | ||
| 3431 | name: (identifier) @font-lock-function-name-face | ||
| 3432 | value: [(function_expression) (arrow_function)]))) | ||
| 3433 | (error | ||
| 3434 | ;; An older version of the grammar. | ||
| 3435 | '((function | ||
| 3436 | name: (identifier) @font-lock-function-name-face) | ||
| 3437 | (variable_declarator | ||
| 3438 | name: (identifier) @font-lock-function-name-face | ||
| 3439 | value: [(function) (arrow_function)]))))) | ||
| 3440 | |||
| 3421 | (defun js-jsx--treesit-indent-compatibility-bb1f97b () | 3441 | (defun js-jsx--treesit-indent-compatibility-bb1f97b () |
| 3422 | "Indent rules helper, to handle different releases of tree-sitter-javascript. | 3442 | "Indent rules helper, to handle different releases of tree-sitter-javascript. |
| 3423 | Check if a node type is available, then return the right indent rules." | 3443 | Check if a node type is available, then return the right indent rules." |
| @@ -3529,8 +3549,7 @@ Check if a node type is available, then return the right indent rules." | |||
| 3529 | 3549 | ||
| 3530 | :language 'javascript | 3550 | :language 'javascript |
| 3531 | :feature 'definition | 3551 | :feature 'definition |
| 3532 | '((function | 3552 | `(,@(js--treesit-font-lock-compatibility-definition-feature) |
| 3533 | name: (identifier) @font-lock-function-name-face) | ||
| 3534 | 3553 | ||
| 3535 | (class_declaration | 3554 | (class_declaration |
| 3536 | name: (identifier) @font-lock-type-face) | 3555 | name: (identifier) @font-lock-type-face) |
| @@ -3550,10 +3569,6 @@ Check if a node type is available, then return the right indent rules." | |||
| 3550 | name: (identifier) @font-lock-variable-name-face) | 3569 | name: (identifier) @font-lock-variable-name-face) |
| 3551 | 3570 | ||
| 3552 | (variable_declarator | 3571 | (variable_declarator |
| 3553 | name: (identifier) @font-lock-function-name-face | ||
| 3554 | value: [(function) (arrow_function)]) | ||
| 3555 | |||
| 3556 | (variable_declarator | ||
| 3557 | name: [(array_pattern (identifier) @font-lock-variable-name-face) | 3572 | name: [(array_pattern (identifier) @font-lock-variable-name-face) |
| 3558 | (object_pattern | 3573 | (object_pattern |
| 3559 | (shorthand_property_identifier_pattern) @font-lock-variable-name-face)]) | 3574 | (shorthand_property_identifier_pattern) @font-lock-variable-name-face)]) |
diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 05a3ff6d7c6..8bd3db2b75f 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el | |||
| @@ -26,8 +26,8 @@ | |||
| 26 | ;; This package provides `lua-ts-mode' which is a major mode for Lua | 26 | ;; This package provides `lua-ts-mode' which is a major mode for Lua |
| 27 | ;; files that uses Tree Sitter to parse the language. | 27 | ;; files that uses Tree Sitter to parse the language. |
| 28 | ;; | 28 | ;; |
| 29 | ;; This package is compatible with and tested against the grammar | 29 | ;; This package is compatible with and tested against the grammar for |
| 30 | ;; for Lua found at https://github.com/MunifTanjim/tree-sitter-lua | 30 | ;; Lua found at https://github.com/tree-sitter-grammars/tree-sitter-lua |
| 31 | 31 | ||
| 32 | ;;; Code: | 32 | ;;; Code: |
| 33 | 33 | ||
| @@ -317,6 +317,8 @@ values of OVERRIDE." | |||
| 317 | (node-is ")") | 317 | (node-is ")") |
| 318 | (node-is "}")) | 318 | (node-is "}")) |
| 319 | standalone-parent 0) | 319 | standalone-parent 0) |
| 320 | ((match null "table_constructor") | ||
| 321 | standalone-parent lua-ts-indent-offset) | ||
| 320 | ((or (and (parent-is "arguments") lua-ts--first-child-matcher) | 322 | ((or (and (parent-is "arguments") lua-ts--first-child-matcher) |
| 321 | (and (parent-is "parameters") lua-ts--first-child-matcher) | 323 | (and (parent-is "parameters") lua-ts--first-child-matcher) |
| 322 | (and (parent-is "table_constructor") lua-ts--first-child-matcher)) | 324 | (and (parent-is "table_constructor") lua-ts--first-child-matcher)) |
| @@ -774,7 +776,7 @@ Calls REPORT-FN directly." | |||
| 774 | "vararg_expression")))) | 776 | "vararg_expression")))) |
| 775 | (text "comment")))) | 777 | (text "comment")))) |
| 776 | 778 | ||
| 777 | ;; Imenu. | 779 | ;; Imenu/Outline. |
| 778 | (setq-local treesit-simple-imenu-settings | 780 | (setq-local treesit-simple-imenu-settings |
| 779 | `(("Requires" | 781 | `(("Requires" |
| 780 | "\\`function_call\\'" | 782 | "\\`function_call\\'" |
| @@ -789,16 +791,6 @@ Calls REPORT-FN directly." | |||
| 789 | ;; Which-function. | 791 | ;; Which-function. |
| 790 | (setq-local which-func-functions (treesit-defun-at-point)) | 792 | (setq-local which-func-functions (treesit-defun-at-point)) |
| 791 | 793 | ||
| 792 | ;; Outline. | ||
| 793 | (setq-local outline-regexp | ||
| 794 | (rx (seq (0+ space) | ||
| 795 | (or (seq "--[[" (0+ space) eol) | ||
| 796 | (seq symbol-start | ||
| 797 | (or "do" "for" "if" "repeat" "while" | ||
| 798 | (seq (? (seq "local" (1+ space))) | ||
| 799 | "function")) | ||
| 800 | symbol-end))))) | ||
| 801 | |||
| 802 | ;; Align. | 794 | ;; Align. |
| 803 | (setq-local align-indent-before-aligning t) | 795 | (setq-local align-indent-before-aligning t) |
| 804 | 796 | ||
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 09cb848fd52..2bb31988290 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el | |||
| @@ -325,20 +325,20 @@ followed by the first character of the construct. | |||
| 325 | ;; | 325 | ;; |
| 326 | ;; Module definitions. | 326 | ;; Module definitions. |
| 327 | ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?" | 327 | ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?" |
| 328 | (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) | 328 | (1 'font-lock-keyword-face) (2 'font-lock-function-name-face nil t)) |
| 329 | ;; | 329 | ;; |
| 330 | ;; Import directives. | 330 | ;; Import directives. |
| 331 | ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>" | 331 | ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>" |
| 332 | (1 font-lock-keyword-face) | 332 | (1 'font-lock-keyword-face) |
| 333 | (font-lock-match-c-style-declaration-item-and-skip-to-next | 333 | (font-lock-match-c-style-declaration-item-and-skip-to-next |
| 334 | nil (goto-char (match-end 0)) | 334 | nil (goto-char (match-end 0)) |
| 335 | (1 font-lock-constant-face))) | 335 | (1 'font-lock-constant-face))) |
| 336 | ;; | 336 | ;; |
| 337 | ;; Pragmas as warnings. | 337 | ;; Pragmas as warnings. |
| 338 | ;; Spencer Allain <sallain@teknowledge.com> says do them as comments... | 338 | ;; Spencer Allain <sallain@teknowledge.com> says do them as comments... |
| 339 | ;; ("<\\*.*\\*>" . font-lock-warning-face) | 339 | ;; ("<\\*.*\\*>" . font-lock-warning-face) |
| 340 | ;; ... but instead we fontify the first word. | 340 | ;; ... but instead we fontify the first word. |
| 341 | ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend) | 341 | ("<\\*[ \t]*\\(\\sw+\\)" 1 'font-lock-warning-face prepend) |
| 342 | ) | 342 | ) |
| 343 | "Subdued level highlighting for Modula-3 modes.") | 343 | "Subdued level highlighting for Modula-3 modes.") |
| 344 | 344 | ||
| @@ -366,26 +366,29 @@ followed by the first character of the construct. | |||
| 366 | "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD" | 366 | "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD" |
| 367 | "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL"))) | 367 | "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL"))) |
| 368 | ) | 368 | ) |
| 369 | (list | 369 | `( |
| 370 | ;; | 370 | ;; |
| 371 | ;; Keywords except those fontified elsewhere. | 371 | ;; Keywords except those fontified elsewhere. |
| 372 | (concat "\\<\\(" m3-keywords "\\)\\>") | 372 | ,(concat "\\<\\(" m3-keywords "\\)\\>") |
| 373 | ;; | 373 | ;; |
| 374 | ;; Builtins. | 374 | ;; Builtins. |
| 375 | (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face) | 375 | (,(concat "\\<\\(" m3-builtins "\\)\\>") |
| 376 | ;; | 376 | (0 'font-lock-builtin-face)) |
| 377 | ;; Type names. | 377 | ;; |
| 378 | (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face) | 378 | ;; Type names. |
| 379 | ;; | 379 | (,(concat "\\<\\(" m3-types "\\)\\>") |
| 380 | ;; Fontify tokens as function names. | 380 | (0 'font-lock-type-face)) |
| 381 | '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" | 381 | ;; |
| 382 | (1 font-lock-keyword-face) | 382 | ;; Fontify tokens as function names. |
| 383 | ("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" | ||
| 384 | (1 'font-lock-keyword-face) | ||
| 383 | (font-lock-match-c-style-declaration-item-and-skip-to-next | 385 | (font-lock-match-c-style-declaration-item-and-skip-to-next |
| 384 | nil (goto-char (match-end 0)) | 386 | nil (goto-char (match-end 0)) |
| 385 | (1 font-lock-function-name-face))) | 387 | (1 'font-lock-function-name-face))) |
| 386 | ;; | 388 | ;; |
| 387 | ;; Fontify constants as references. | 389 | ;; Fontify constants as references. |
| 388 | '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face) | 390 | ("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" |
| 391 | (0 'font-lock-constant-face)) | ||
| 389 | )))) | 392 | )))) |
| 390 | "Gaudy level highlighting for Modula-3 modes.") | 393 | "Gaudy level highlighting for Modula-3 modes.") |
| 391 | 394 | ||
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 5e8263cb646..a80e12b8129 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el | |||
| @@ -281,7 +281,7 @@ nested routine.") | |||
| 281 | 281 | ||
| 282 | (eval-when-compile | 282 | (eval-when-compile |
| 283 | (pcase-defmacro opascal--in (set) | 283 | (pcase-defmacro opascal--in (set) |
| 284 | `(pred (pcase--flip memq ,set)))) | 284 | `(pred (memq _ ,set)))) |
| 285 | 285 | ||
| 286 | (defun opascal-string-of (start end) | 286 | (defun opascal-string-of (start end) |
| 287 | ;; Returns the buffer string from start to end. | 287 | ;; Returns the buffer string from start to end. |
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index da782ad5537..9622b1b6768 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el | |||
| @@ -992,9 +992,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." | |||
| 992 | 992 | ||
| 993 | ;;;###autoload | 993 | ;;;###autoload |
| 994 | (defun project-or-external-find-regexp (regexp) | 994 | (defun project-or-external-find-regexp (regexp) |
| 995 | "Find all matches for REGEXP in the project roots or external roots. | 995 | "Find all matches for REGEXP in the project roots or external roots." |
| 996 | With \\[universal-argument] prefix, you can specify the file name | ||
| 997 | pattern to search for." | ||
| 998 | (interactive (list (project--read-regexp))) | 996 | (interactive (list (project--read-regexp))) |
| 999 | (require 'xref) | 997 | (require 'xref) |
| 1000 | (let* ((pr (project-current t)) | 998 | (let* ((pr (project-current t)) |
| @@ -1515,7 +1513,8 @@ ARG, show only buffers that are visiting files." | |||
| 1515 | (lambda (buffer) | 1513 | (lambda (buffer) |
| 1516 | (let ((name (buffer-name buffer)) | 1514 | (let ((name (buffer-name buffer)) |
| 1517 | (file (buffer-file-name buffer))) | 1515 | (file (buffer-file-name buffer))) |
| 1518 | (and (or (not (string= (substring name 0 1) " ")) | 1516 | (and (or Buffer-menu-show-internal |
| 1517 | (not (string= (substring name 0 1) " ")) | ||
| 1519 | file) | 1518 | file) |
| 1520 | (not (eq buffer (current-buffer))) | 1519 | (not (eq buffer (current-buffer))) |
| 1521 | (or file (not Buffer-menu-files-only))))) | 1520 | (or file (not Buffer-menu-files-only))))) |
| @@ -1525,6 +1524,7 @@ ARG, show only buffers that are visiting files." | |||
| 1525 | (let ((buf (list-buffers-noselect | 1524 | (let ((buf (list-buffers-noselect |
| 1526 | arg (with-current-buffer | 1525 | arg (with-current-buffer |
| 1527 | (get-buffer-create "*Buffer List*") | 1526 | (get-buffer-create "*Buffer List*") |
| 1527 | (setq-local Buffer-menu-show-internal nil) | ||
| 1528 | (let ((Buffer-menu-files-only arg)) | 1528 | (let ((Buffer-menu-files-only arg)) |
| 1529 | (funcall buffer-list-function)))))) | 1529 | (funcall buffer-list-function)))))) |
| 1530 | (with-current-buffer buf | 1530 | (with-current-buffer buf |
| @@ -1866,12 +1866,12 @@ Otherwise, `default-directory' is temporarily set to the current | |||
| 1866 | project's root. | 1866 | project's root. |
| 1867 | 1867 | ||
| 1868 | If OVERRIDING-MAP is non-nil, it will be used as | 1868 | If OVERRIDING-MAP is non-nil, it will be used as |
| 1869 | `overriding-local-map' to provide shorter bindings from that map | 1869 | `overriding-terminal-local-map' to provide shorter bindings |
| 1870 | which will take priority over the global ones." | 1870 | from that map which will take priority over the global ones." |
| 1871 | (interactive) | 1871 | (interactive) |
| 1872 | (let* ((pr (project-current t)) | 1872 | (let* ((pr (project-current t)) |
| 1873 | (prompt-format (or prompt-format "[execute in %s]:")) | 1873 | (prompt-format (or prompt-format "[execute in %s]:")) |
| 1874 | (command (let ((overriding-local-map overriding-map)) | 1874 | (command (let ((overriding-terminal-local-map overriding-map)) |
| 1875 | (key-binding (read-key-sequence | 1875 | (key-binding (read-key-sequence |
| 1876 | (format prompt-format (project-root pr))) | 1876 | (format prompt-format (project-root pr))) |
| 1877 | t))) | 1877 | t))) |
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 9d840efb9da..bedc61408ef 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el | |||
| @@ -5,7 +5,7 @@ | |||
| 5 | ;; Author: Fabián E. Gallina <fgallina@gnu.org> | 5 | ;; Author: Fabián E. Gallina <fgallina@gnu.org> |
| 6 | ;; URL: https://github.com/fgallina/python.el | 6 | ;; URL: https://github.com/fgallina/python.el |
| 7 | ;; Version: 0.28 | 7 | ;; Version: 0.28 |
| 8 | ;; Package-Requires: ((emacs "24.4") (compat "28.1.2.1") (seq "2.23")) | 8 | ;; Package-Requires: ((emacs "24.4") (compat "29.1.1.0") (seq "2.23")) |
| 9 | ;; Maintainer: emacs-devel@gnu.org | 9 | ;; Maintainer: emacs-devel@gnu.org |
| 10 | ;; Created: Jul 2010 | 10 | ;; Created: Jul 2010 |
| 11 | ;; Keywords: languages | 11 | ;; Keywords: languages |
| @@ -128,9 +128,9 @@ | |||
| 128 | ;; receiving escape sequences (with some limitations, i.e. completion | 128 | ;; receiving escape sequences (with some limitations, i.e. completion |
| 129 | ;; in blocks does not work). The code executed for the "fallback" | 129 | ;; in blocks does not work). The code executed for the "fallback" |
| 130 | ;; completion can be found in `python-shell-completion-setup-code' and | 130 | ;; completion can be found in `python-shell-completion-setup-code' and |
| 131 | ;; `python-shell-completion-string-code' variables. Their default | 131 | ;; `python-shell-completion-get-completions'. Their default values |
| 132 | ;; values enable completion for both CPython and IPython, and probably | 132 | ;; enable completion for both CPython and IPython, and probably any |
| 133 | ;; any readline based shell (it's known to work with PyPy). If your | 133 | ;; readline based shell (it's known to work with PyPy). If your |
| 134 | ;; Python installation lacks readline (like CPython for Windows), | 134 | ;; Python installation lacks readline (like CPython for Windows), |
| 135 | ;; installing pyreadline (URL `https://ipython.org/pyreadline.html') | 135 | ;; installing pyreadline (URL `https://ipython.org/pyreadline.html') |
| 136 | ;; should suffice. To troubleshoot why you are not getting any | 136 | ;; should suffice. To troubleshoot why you are not getting any |
| @@ -141,6 +141,12 @@ | |||
| 141 | ;; If you see an error, then you need to either install pyreadline or | 141 | ;; If you see an error, then you need to either install pyreadline or |
| 142 | ;; setup custom code that avoids that dependency. | 142 | ;; setup custom code that avoids that dependency. |
| 143 | 143 | ||
| 144 | ;; By default, the "native" completion uses the built-in rlcompleter. | ||
| 145 | ;; To use other readline completer (e.g. Jedi) or a custom one, you just | ||
| 146 | ;; need to set it in the PYTHONSTARTUP file. You can set an | ||
| 147 | ;; Emacs-specific completer by testing the environment variable | ||
| 148 | ;; INSIDE_EMACS. | ||
| 149 | |||
| 144 | ;; Shell virtualenv support: The shell also contains support for | 150 | ;; Shell virtualenv support: The shell also contains support for |
| 145 | ;; virtualenvs and other special environment modifications thanks to | 151 | ;; virtualenvs and other special environment modifications thanks to |
| 146 | ;; `python-shell-process-environment' and `python-shell-exec-path'. | 152 | ;; `python-shell-process-environment' and `python-shell-exec-path'. |
| @@ -267,7 +273,7 @@ | |||
| 267 | (eval-when-compile (require 'subr-x)) ;For `string-empty-p' and `string-join'. | 273 | (eval-when-compile (require 'subr-x)) ;For `string-empty-p' and `string-join'. |
| 268 | (require 'treesit) | 274 | (require 'treesit) |
| 269 | (require 'pcase) | 275 | (require 'pcase) |
| 270 | (require 'compat nil 'noerror) | 276 | (require 'compat) |
| 271 | (require 'project nil 'noerror) | 277 | (require 'project nil 'noerror) |
| 272 | (require 'seq) | 278 | (require 'seq) |
| 273 | 279 | ||
| @@ -3515,6 +3521,16 @@ eventually provide a shell." | |||
| 3515 | :version "25.1" | 3521 | :version "25.1" |
| 3516 | :type 'hook) | 3522 | :type 'hook) |
| 3517 | 3523 | ||
| 3524 | (defconst python-shell-setup-code | ||
| 3525 | "\ | ||
| 3526 | try: | ||
| 3527 | import tty | ||
| 3528 | except ImportError: | ||
| 3529 | pass | ||
| 3530 | else: | ||
| 3531 | tty.setraw(0)" | ||
| 3532 | "Code used to setup the inferior Python processes.") | ||
| 3533 | |||
| 3518 | (defconst python-shell-eval-setup-code | 3534 | (defconst python-shell-eval-setup-code |
| 3519 | "\ | 3535 | "\ |
| 3520 | def __PYTHON_EL_eval(source, filename): | 3536 | def __PYTHON_EL_eval(source, filename): |
| @@ -3580,6 +3596,7 @@ The coding cookie regexp is specified in PEP 263.") | |||
| 3580 | (format "exec(%s)\n" (python-shell--encode-string string)))))) | 3596 | (format "exec(%s)\n" (python-shell--encode-string string)))))) |
| 3581 | ;; Bootstrap: the normal definition of `python-shell-send-string' | 3597 | ;; Bootstrap: the normal definition of `python-shell-send-string' |
| 3582 | ;; depends on the Python code sent here. | 3598 | ;; depends on the Python code sent here. |
| 3599 | (python-shell-send-string-no-output python-shell-setup-code) | ||
| 3583 | (python-shell-send-string-no-output python-shell-eval-setup-code) | 3600 | (python-shell-send-string-no-output python-shell-eval-setup-code) |
| 3584 | (python-shell-send-string-no-output python-shell-eval-file-setup-code)) | 3601 | (python-shell-send-string-no-output python-shell-eval-file-setup-code)) |
| 3585 | (with-current-buffer (current-buffer) | 3602 | (with-current-buffer (current-buffer) |
| @@ -3604,7 +3621,6 @@ interpreter is run. Variables | |||
| 3604 | `python-shell-prompt-block-regexp', | 3621 | `python-shell-prompt-block-regexp', |
| 3605 | `python-shell-font-lock-enable', | 3622 | `python-shell-font-lock-enable', |
| 3606 | `python-shell-completion-setup-code', | 3623 | `python-shell-completion-setup-code', |
| 3607 | `python-shell-completion-string-code', | ||
| 3608 | `python-eldoc-setup-code', | 3624 | `python-eldoc-setup-code', |
| 3609 | `python-ffap-setup-code' can | 3625 | `python-ffap-setup-code' can |
| 3610 | customize this mode for different Python interpreters. | 3626 | customize this mode for different Python interpreters. |
| @@ -4244,8 +4260,9 @@ def __PYTHON_EL_get_completions(text): | |||
| 4244 | completions = [] | 4260 | completions = [] |
| 4245 | completer = None | 4261 | completer = None |
| 4246 | 4262 | ||
| 4263 | import json | ||
| 4247 | try: | 4264 | try: |
| 4248 | import readline | 4265 | import readline, re |
| 4249 | 4266 | ||
| 4250 | try: | 4267 | try: |
| 4251 | import __builtin__ | 4268 | import __builtin__ |
| @@ -4256,16 +4273,29 @@ def __PYTHON_EL_get_completions(text): | |||
| 4256 | 4273 | ||
| 4257 | is_ipython = ('__IPYTHON__' in builtins or | 4274 | is_ipython = ('__IPYTHON__' in builtins or |
| 4258 | '__IPYTHON__active' in builtins) | 4275 | '__IPYTHON__active' in builtins) |
| 4259 | splits = text.split() | 4276 | |
| 4260 | is_module = splits and splits[0] in ('from', 'import') | 4277 | if is_ipython and 'get_ipython' in builtins: |
| 4261 | 4278 | def filter_c(prefix, c): | |
| 4262 | if is_ipython and is_module: | 4279 | if re.match('_+(i?[0-9]+)?$', c): |
| 4263 | from IPython.core.completerlib import module_completion | 4280 | return False |
| 4264 | completions = module_completion(text.strip()) | 4281 | elif c[0] == '%' and not re.match('[%a-zA-Z]+$', prefix): |
| 4265 | elif is_ipython and '__IP' in builtins: | 4282 | return False |
| 4266 | completions = __IP.complete(text) | 4283 | return True |
| 4267 | elif is_ipython and 'get_ipython' in builtins: | 4284 | |
| 4268 | completions = get_ipython().Completer.all_completions(text) | 4285 | import IPython |
| 4286 | try: | ||
| 4287 | if IPython.version_info[0] >= 6: | ||
| 4288 | from IPython.core.completer import provisionalcompleter | ||
| 4289 | with provisionalcompleter(): | ||
| 4290 | completions = [ | ||
| 4291 | [c.text, c.start, c.end, c.type or '?', c.signature or ''] | ||
| 4292 | for c in get_ipython().Completer.completions(text, len(text)) | ||
| 4293 | if filter_c(text, c.text)] | ||
| 4294 | else: | ||
| 4295 | part, matches = get_ipython().Completer.complete(line_buffer=text) | ||
| 4296 | completions = [text + m[len(part):] for m in matches if filter_c(text, m)] | ||
| 4297 | except: | ||
| 4298 | pass | ||
| 4269 | else: | 4299 | else: |
| 4270 | # Try to reuse current completer. | 4300 | # Try to reuse current completer. |
| 4271 | completer = readline.get_completer() | 4301 | completer = readline.get_completer() |
| @@ -4288,7 +4318,7 @@ def __PYTHON_EL_get_completions(text): | |||
| 4288 | finally: | 4318 | finally: |
| 4289 | if getattr(completer, 'PYTHON_EL_WRAPPED', False): | 4319 | if getattr(completer, 'PYTHON_EL_WRAPPED', False): |
| 4290 | completer.print_mode = True | 4320 | completer.print_mode = True |
| 4291 | return completions" | 4321 | return json.dumps(completions)" |
| 4292 | "Code used to setup completion in inferior Python processes." | 4322 | "Code used to setup completion in inferior Python processes." |
| 4293 | :type 'string) | 4323 | :type 'string) |
| 4294 | 4324 | ||
| @@ -4329,6 +4359,10 @@ When a match is found, native completion is disabled." | |||
| 4329 | :version "25.1" | 4359 | :version "25.1" |
| 4330 | :type 'float) | 4360 | :type 'float) |
| 4331 | 4361 | ||
| 4362 | (defvar python-shell-readline-completer-delims nil | ||
| 4363 | "Word delimiters used by the readline completer. | ||
| 4364 | It is automatically set by Python shell.") | ||
| 4365 | |||
| 4332 | (defvar python-shell-completion-native-redirect-buffer | 4366 | (defvar python-shell-completion-native-redirect-buffer |
| 4333 | " *Python completions redirect*" | 4367 | " *Python completions redirect*" |
| 4334 | "Buffer to be used to redirect output of readline commands.") | 4368 | "Buffer to be used to redirect output of readline commands.") |
| @@ -4467,6 +4501,10 @@ def __PYTHON_EL_native_completion_setup(): | |||
| 4467 | __PYTHON_EL_native_completion_setup()" process))) | 4501 | __PYTHON_EL_native_completion_setup()" process))) |
| 4468 | (when (string-match-p "python\\.el: native completion setup loaded" | 4502 | (when (string-match-p "python\\.el: native completion setup loaded" |
| 4469 | output) | 4503 | output) |
| 4504 | (setq-local python-shell-readline-completer-delims | ||
| 4505 | (string-trim-right | ||
| 4506 | (python-shell-send-string-no-output | ||
| 4507 | "import readline; print(readline.get_completer_delims())"))) | ||
| 4470 | (python-shell-completion-native-try)))) | 4508 | (python-shell-completion-native-try)))) |
| 4471 | 4509 | ||
| 4472 | (defun python-shell-completion-native-turn-off (&optional msg) | 4510 | (defun python-shell-completion-native-turn-off (&optional msg) |
| @@ -4498,18 +4536,11 @@ With argument MSG show activation/deactivation message." | |||
| 4498 | ((python-shell-completion-native-setup) | 4536 | ((python-shell-completion-native-setup) |
| 4499 | (when msg | 4537 | (when msg |
| 4500 | (message "Shell native completion is enabled."))) | 4538 | (message "Shell native completion is enabled."))) |
| 4501 | (t (lwarn | 4539 | (t |
| 4502 | '(python python-shell-completion-native-turn-on-maybe) | 4540 | (when msg |
| 4503 | :warning | 4541 | (message (concat "Python does not use GNU readline;" |
| 4504 | (concat | 4542 | " no completion in multi-line commands."))) |
| 4505 | "Your `python-shell-interpreter' doesn't seem to " | 4543 | (python-shell-completion-native-turn-off nil)))))) |
| 4506 | "support readline, yet `python-shell-completion-native-enable' " | ||
| 4507 | (format "was t and %S is not part of the " | ||
| 4508 | (file-name-nondirectory python-shell-interpreter)) | ||
| 4509 | "`python-shell-completion-native-disabled-interpreters' " | ||
| 4510 | "list. Native completions have been disabled locally. " | ||
| 4511 | "Consider installing the python package \"readline\". ")) | ||
| 4512 | (python-shell-completion-native-turn-off msg)))))) | ||
| 4513 | 4544 | ||
| 4514 | (defun python-shell-completion-native-turn-on-maybe-with-msg () | 4545 | (defun python-shell-completion-native-turn-on-maybe-with-msg () |
| 4515 | "Like `python-shell-completion-native-turn-on-maybe' but force messages." | 4546 | "Like `python-shell-completion-native-turn-on-maybe' but force messages." |
| @@ -4534,6 +4565,8 @@ With argument MSG show activation/deactivation message." | |||
| 4534 | (let* ((original-filter-fn (process-filter process)) | 4565 | (let* ((original-filter-fn (process-filter process)) |
| 4535 | (redirect-buffer (get-buffer-create | 4566 | (redirect-buffer (get-buffer-create |
| 4536 | python-shell-completion-native-redirect-buffer)) | 4567 | python-shell-completion-native-redirect-buffer)) |
| 4568 | (sep (if (string= python-shell-readline-completer-delims "") | ||
| 4569 | "[\n\r]+" "[ \f\t\n\r\v()]+")) | ||
| 4537 | (trigger "\t") | 4570 | (trigger "\t") |
| 4538 | (new-input (concat input trigger)) | 4571 | (new-input (concat input trigger)) |
| 4539 | (input-length | 4572 | (input-length |
| @@ -4576,28 +4609,80 @@ With argument MSG show activation/deactivation message." | |||
| 4576 | process python-shell-completion-native-output-timeout | 4609 | process python-shell-completion-native-output-timeout |
| 4577 | comint-redirect-finished-regexp) | 4610 | comint-redirect-finished-regexp) |
| 4578 | (re-search-backward "0__dummy_completion__" nil t) | 4611 | (re-search-backward "0__dummy_completion__" nil t) |
| 4579 | (cl-remove-duplicates | 4612 | (let ((str (buffer-substring-no-properties |
| 4580 | (split-string | 4613 | (line-beginning-position) (point-min)))) |
| 4581 | (buffer-substring-no-properties | 4614 | ;; The readline completer is allowed to return a list |
| 4582 | (line-beginning-position) (point-min)) | 4615 | ;; of (text start end type signature) as a JSON |
| 4583 | "[ \f\t\n\r\v()]+" t) | 4616 | ;; string. See the return value for IPython in |
| 4584 | :test #'string=)))) | 4617 | ;; `python-shell-completion-setup-code'. |
| 4618 | (if (string= "[" (substring str 0 1)) | ||
| 4619 | (condition-case nil | ||
| 4620 | (python--parse-json-array str) | ||
| 4621 | (t (cl-remove-duplicates (split-string str sep t) | ||
| 4622 | :test #'string=))) | ||
| 4623 | (cl-remove-duplicates (split-string str sep t) | ||
| 4624 | :test #'string=)))))) | ||
| 4585 | (set-process-filter process original-filter-fn))))) | 4625 | (set-process-filter process original-filter-fn))))) |
| 4586 | 4626 | ||
| 4587 | (defun python-shell-completion-get-completions (process input) | 4627 | (defun python-shell-completion-get-completions (process input) |
| 4588 | "Get completions of INPUT using PROCESS." | 4628 | "Get completions of INPUT using PROCESS." |
| 4589 | (with-current-buffer (process-buffer process) | 4629 | (with-current-buffer (process-buffer process) |
| 4590 | (let ((completions | 4630 | (python--parse-json-array |
| 4591 | (python-util-strip-string | 4631 | (python-shell-send-string-no-output |
| 4592 | (python-shell-send-string-no-output | 4632 | (format "%s\nprint(__PYTHON_EL_get_completions(%s))" |
| 4593 | (format | ||
| 4594 | "%s\nprint(';'.join(__PYTHON_EL_get_completions(%s)))" | ||
| 4595 | python-shell-completion-setup-code | 4633 | python-shell-completion-setup-code |
| 4596 | (python-shell--encode-string input)) | 4634 | (python-shell--encode-string input)) |
| 4597 | process)))) | 4635 | process)))) |
| 4598 | (when (> (length completions) 2) | 4636 | |
| 4599 | (split-string completions | 4637 | (defun python-shell--get-multiline-input () |
| 4600 | "^'\\|^\"\\|;\\|'$\\|\"$" t))))) | 4638 | "Return lines at a multi-line input in Python shell." |
| 4639 | (save-excursion | ||
| 4640 | (let ((p (point)) lines) | ||
| 4641 | (when (progn | ||
| 4642 | (beginning-of-line) | ||
| 4643 | (looking-back python-shell-prompt-block-regexp (pos-bol))) | ||
| 4644 | (push (buffer-substring-no-properties (point) p) lines) | ||
| 4645 | (while (progn (comint-previous-prompt 1) | ||
| 4646 | (looking-back python-shell-prompt-block-regexp (pos-bol))) | ||
| 4647 | (push (buffer-substring-no-properties (point) (pos-eol)) lines)) | ||
| 4648 | (push (buffer-substring-no-properties (point) (pos-eol)) lines)) | ||
| 4649 | lines))) | ||
| 4650 | |||
| 4651 | (defun python-shell--extra-completion-context () | ||
| 4652 | "Get extra completion context of current input in Python shell." | ||
| 4653 | (let ((lines (python-shell--get-multiline-input)) | ||
| 4654 | (python-indent-guess-indent-offset nil)) | ||
| 4655 | (when (not (zerop (length lines))) | ||
| 4656 | (with-temp-buffer | ||
| 4657 | (delay-mode-hooks | ||
| 4658 | (insert (string-join lines "\n")) | ||
| 4659 | (python-mode) | ||
| 4660 | (python-shell-completion-extra-context)))))) | ||
| 4661 | |||
| 4662 | (defun python-shell-completion-extra-context (&optional pos) | ||
| 4663 | "Get extra completion context at position POS in Python buffer. | ||
| 4664 | If optional argument POS is nil, use current position. | ||
| 4665 | |||
| 4666 | Readline completers could use current line as the completion | ||
| 4667 | context, which may be insufficient. In this function, extra | ||
| 4668 | context (e.g. multi-line function call) is found and reformatted | ||
| 4669 | as one line, which is required by native completion." | ||
| 4670 | (let (bound p) | ||
| 4671 | (save-excursion | ||
| 4672 | (and pos (goto-char pos)) | ||
| 4673 | (setq bound (pos-bol)) | ||
| 4674 | (python-nav-up-list -1) | ||
| 4675 | (when (and (< (point) bound) | ||
| 4676 | (or | ||
| 4677 | (looking-back | ||
| 4678 | (python-rx (group (+ (or "." symbol-name)))) (pos-bol) t) | ||
| 4679 | (progn | ||
| 4680 | (forward-line 0) | ||
| 4681 | (looking-at "^[ \t]*\\(from \\)")))) | ||
| 4682 | (setq p (match-beginning 1)))) | ||
| 4683 | (when p | ||
| 4684 | (replace-regexp-in-string | ||
| 4685 | "\n[ \t]*" "" (buffer-substring-no-properties p (1- bound)))))) | ||
| 4601 | 4686 | ||
| 4602 | (defvar-local python-shell--capf-cache nil | 4687 | (defvar-local python-shell--capf-cache nil |
| 4603 | "Variable to store cached completions and invalidation keys.") | 4688 | "Variable to store cached completions and invalidation keys.") |
| @@ -4612,21 +4697,26 @@ using that one instead of current buffer's process." | |||
| 4612 | ;; Working on a shell buffer: use prompt end. | 4697 | ;; Working on a shell buffer: use prompt end. |
| 4613 | (cdr (python-util-comint-last-prompt)) | 4698 | (cdr (python-util-comint-last-prompt)) |
| 4614 | (line-beginning-position))) | 4699 | (line-beginning-position))) |
| 4615 | (import-statement | 4700 | (no-delims |
| 4616 | (when (string-match-p | 4701 | (and (not (if is-shell-buffer |
| 4617 | (rx (* space) word-start (or "from" "import") word-end space) | 4702 | (eq 'font-lock-comment-face |
| 4618 | (buffer-substring-no-properties line-start (point))) | 4703 | (get-text-property (1- (point)) 'face)) |
| 4619 | (buffer-substring-no-properties line-start (point)))) | 4704 | (python-syntax-context 'comment))) |
| 4705 | (with-current-buffer (process-buffer process) | ||
| 4706 | (if python-shell-completion-native-enable | ||
| 4707 | (string= python-shell-readline-completer-delims "") | ||
| 4708 | (string-match-p "ipython[23]?\\'" python-shell-interpreter))))) | ||
| 4620 | (start | 4709 | (start |
| 4621 | (if (< (point) line-start) | 4710 | (if (< (point) line-start) |
| 4622 | (point) | 4711 | (point) |
| 4623 | (save-excursion | 4712 | (save-excursion |
| 4624 | (if (not (re-search-backward | 4713 | (if (or no-delims |
| 4625 | (python-rx | 4714 | (not (re-search-backward |
| 4626 | (or whitespace open-paren close-paren | 4715 | (python-rx |
| 4627 | string-delimiter simple-operator)) | 4716 | (or whitespace open-paren close-paren |
| 4628 | line-start | 4717 | string-delimiter simple-operator)) |
| 4629 | t 1)) | 4718 | line-start |
| 4719 | t 1))) | ||
| 4630 | line-start | 4720 | line-start |
| 4631 | (forward-char (length (match-string-no-properties 0))) | 4721 | (forward-char (length (match-string-no-properties 0))) |
| 4632 | (point))))) | 4722 | (point))))) |
| @@ -4666,18 +4756,56 @@ using that one instead of current buffer's process." | |||
| 4666 | (t #'python-shell-completion-native-get-completions)))) | 4756 | (t #'python-shell-completion-native-get-completions)))) |
| 4667 | (prev-prompt (car python-shell--capf-cache)) | 4757 | (prev-prompt (car python-shell--capf-cache)) |
| 4668 | (re (or (cadr python-shell--capf-cache) regexp-unmatchable)) | 4758 | (re (or (cadr python-shell--capf-cache) regexp-unmatchable)) |
| 4669 | (prefix (buffer-substring-no-properties start end))) | 4759 | (prefix (buffer-substring-no-properties start end)) |
| 4760 | (prefix-offset 0) | ||
| 4761 | (extra-context (when no-delims | ||
| 4762 | (if is-shell-buffer | ||
| 4763 | (python-shell--extra-completion-context) | ||
| 4764 | (python-shell-completion-extra-context)))) | ||
| 4765 | (extra-offset (length extra-context))) | ||
| 4766 | (unless (zerop extra-offset) | ||
| 4767 | (setq prefix (concat extra-context prefix))) | ||
| 4670 | ;; To invalidate the cache, we check if the prompt position or the | 4768 | ;; To invalidate the cache, we check if the prompt position or the |
| 4671 | ;; completion prefix changed. | 4769 | ;; completion prefix changed. |
| 4672 | (unless (and (equal prev-prompt (car prompt-boundaries)) | 4770 | (unless (and (equal prev-prompt (car prompt-boundaries)) |
| 4673 | (string-match re prefix)) | 4771 | (string-match re prefix) |
| 4772 | (setq prefix-offset (- (length prefix) (match-end 1)))) | ||
| 4674 | (setq python-shell--capf-cache | 4773 | (setq python-shell--capf-cache |
| 4675 | `(,(car prompt-boundaries) | 4774 | `(,(car prompt-boundaries) |
| 4676 | ,(if (string-empty-p prefix) | 4775 | ,(if (string-empty-p prefix) |
| 4677 | regexp-unmatchable | 4776 | regexp-unmatchable |
| 4678 | (concat "\\`" (regexp-quote prefix) "\\(?:\\sw\\|\\s_\\)*\\'")) | 4777 | (concat "\\`\\(" (regexp-quote prefix) "\\)\\(?:\\sw\\|\\s_\\)*\\'")) |
| 4679 | ,@(funcall completion-fn process (or import-statement prefix))))) | 4778 | ,@(funcall completion-fn process prefix)))) |
| 4680 | (list start end (cddr python-shell--capf-cache)))) | 4779 | (let ((cands (cddr python-shell--capf-cache))) |
| 4780 | (cond | ||
| 4781 | ((stringp (car cands)) | ||
| 4782 | (if no-delims | ||
| 4783 | ;; Reduce completion candidates due to long prefix. | ||
| 4784 | (if-let ((Lp (length prefix)) | ||
| 4785 | ((string-match "\\(\\sw\\|\\s_\\)+\\'" prefix)) | ||
| 4786 | (L (match-beginning 0))) | ||
| 4787 | ;; If extra-offset is not zero: | ||
| 4788 | ;; start end | ||
| 4789 | ;; o------------------o---------o-------o | ||
| 4790 | ;; |<- extra-offset ->| | ||
| 4791 | ;; |<----------- L ------------>| | ||
| 4792 | ;; new-start | ||
| 4793 | (list (+ start L (- extra-offset)) end | ||
| 4794 | (mapcar (lambda (s) (substring s L)) cands)) | ||
| 4795 | (list end end (mapcar (lambda (s) (substring s Lp)) cands))) | ||
| 4796 | (list start end cands))) | ||
| 4797 | ;; python-shell-completion(-native)-get-completions may produce a | ||
| 4798 | ;; list of (text start end type signature) for completion. | ||
| 4799 | ((consp (car cands)) | ||
| 4800 | (list (+ start (nth 1 (car cands)) (- extra-offset)) | ||
| 4801 | ;; Candidates may be cached, so the end position should | ||
| 4802 | ;; be adjusted according to current completion prefix. | ||
| 4803 | (+ start (nth 2 (car cands)) (- extra-offset) prefix-offset) | ||
| 4804 | cands | ||
| 4805 | :annotation-function | ||
| 4806 | (lambda (c) (concat " " (nth 3 (assoc c cands)))) | ||
| 4807 | :company-docsig | ||
| 4808 | (lambda (c) (nth 4 (assoc c cands))))))))) | ||
| 4681 | 4809 | ||
| 4682 | (define-obsolete-function-alias | 4810 | (define-obsolete-function-alias |
| 4683 | 'python-shell-completion-complete-at-point | 4811 | 'python-shell-completion-complete-at-point |
diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 598eaa461ff..426ae248cac 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el | |||
| @@ -1133,6 +1133,7 @@ leading double colon is not added." | |||
| 1133 | "singleton_class" | 1133 | "singleton_class" |
| 1134 | "module" | 1134 | "module" |
| 1135 | "method" | 1135 | "method" |
| 1136 | "singleton_method" | ||
| 1136 | "array" | 1137 | "array" |
| 1137 | "hash" | 1138 | "hash" |
| 1138 | "parenthesized_statements" | 1139 | "parenthesized_statements" |
| @@ -1178,6 +1179,19 @@ leading double colon is not added." | |||
| 1178 | ;; Imenu. | 1179 | ;; Imenu. |
| 1179 | (setq-local imenu-create-index-function #'ruby-ts--imenu) | 1180 | (setq-local imenu-create-index-function #'ruby-ts--imenu) |
| 1180 | 1181 | ||
| 1182 | ;; Outline minor mode. | ||
| 1183 | (setq-local treesit-outline-predicate | ||
| 1184 | (rx bos (or "singleton_method" | ||
| 1185 | "method" | ||
| 1186 | "alias" | ||
| 1187 | "class" | ||
| 1188 | "module") | ||
| 1189 | eos)) | ||
| 1190 | ;; Restore default values of outline variables | ||
| 1191 | ;; to use `treesit-outline-predicate'. | ||
| 1192 | (kill-local-variable 'outline-regexp) | ||
| 1193 | (kill-local-variable 'outline-level) | ||
| 1194 | |||
| 1181 | (setq-local treesit-simple-indent-rules (ruby-ts--indent-rules)) | 1195 | (setq-local treesit-simple-indent-rules (ruby-ts--indent-rules)) |
| 1182 | 1196 | ||
| 1183 | ;; Font-lock. | 1197 | ;; Font-lock. |
diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index e9c6afff440..9ee9432e4ee 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el | |||
| @@ -199,183 +199,197 @@ Argument LANGUAGE is either `typescript' or `tsx'." | |||
| 199 | [(nested_identifier (identifier)) (identifier)] | 199 | [(nested_identifier (identifier)) (identifier)] |
| 200 | @typescript-ts-jsx-tag-face))))) | 200 | @typescript-ts-jsx-tag-face))))) |
| 201 | 201 | ||
| 202 | (defun tsx-ts-mode--font-lock-compatibility-function-expression (language) | ||
| 203 | "Handle tree-sitter grammar breaking change for `function' expression. | ||
| 204 | |||
| 205 | LANGUAGE can be `typescript' or `tsx'. Starting from version 0.20.4 of the | ||
| 206 | typescript/tsx grammar, `function' becomes `function_expression'." | ||
| 207 | (condition-case nil | ||
| 208 | (progn (treesit-query-capture language '((function_expression) @cap)) | ||
| 209 | ;; New version of the grammar | ||
| 210 | 'function_expression) | ||
| 211 | (treesit-query-error | ||
| 212 | ;; Old version of the grammar | ||
| 213 | 'function))) | ||
| 214 | |||
| 202 | (defun typescript-ts-mode--font-lock-settings (language) | 215 | (defun typescript-ts-mode--font-lock-settings (language) |
| 203 | "Tree-sitter font-lock settings. | 216 | "Tree-sitter font-lock settings. |
| 204 | Argument LANGUAGE is either `typescript' or `tsx'." | 217 | Argument LANGUAGE is either `typescript' or `tsx'." |
| 205 | (treesit-font-lock-rules | 218 | (let ((func-exp (tsx-ts-mode--font-lock-compatibility-function-expression language))) |
| 206 | :language language | 219 | (treesit-font-lock-rules |
| 207 | :feature 'comment | 220 | :language language |
| 208 | `([(comment) (hash_bang_line)] @font-lock-comment-face) | 221 | :feature 'comment |
| 209 | 222 | `([(comment) (hash_bang_line)] @font-lock-comment-face) | |
| 210 | :language language | 223 | |
| 211 | :feature 'constant | 224 | :language language |
| 212 | `(((identifier) @font-lock-constant-face | 225 | :feature 'constant |
| 213 | (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) | 226 | `(((identifier) @font-lock-constant-face |
| 214 | [(true) (false) (null)] @font-lock-constant-face) | 227 | (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) |
| 215 | 228 | [(true) (false) (null)] @font-lock-constant-face) | |
| 216 | :language language | 229 | |
| 217 | :feature 'keyword | 230 | :language language |
| 218 | `([,@typescript-ts-mode--keywords] @font-lock-keyword-face | 231 | :feature 'keyword |
| 219 | [(this) (super)] @font-lock-keyword-face) | 232 | `([,@typescript-ts-mode--keywords] @font-lock-keyword-face |
| 220 | 233 | [(this) (super)] @font-lock-keyword-face) | |
| 221 | :language language | 234 | |
| 222 | :feature 'string | 235 | :language language |
| 223 | `((regex pattern: (regex_pattern)) @font-lock-regexp-face | 236 | :feature 'string |
| 224 | (string) @font-lock-string-face | 237 | `((regex pattern: (regex_pattern)) @font-lock-regexp-face |
| 225 | (template_string) @js--fontify-template-string | 238 | (string) @font-lock-string-face |
| 226 | (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) | 239 | (template_string) @js--fontify-template-string |
| 227 | 240 | (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) | |
| 228 | :language language | 241 | |
| 229 | :override t ;; for functions assigned to variables | 242 | :language language |
| 230 | :feature 'declaration | 243 | :override t ;; for functions assigned to variables |
| 231 | `((function | 244 | :feature 'declaration |
| 232 | name: (identifier) @font-lock-function-name-face) | 245 | `((,func-exp |
| 233 | (function_declaration | 246 | name: (identifier) @font-lock-function-name-face) |
| 234 | name: (identifier) @font-lock-function-name-face) | 247 | (function_declaration |
| 235 | (function_signature | 248 | name: (identifier) @font-lock-function-name-face) |
| 236 | name: (identifier) @font-lock-function-name-face) | 249 | (function_signature |
| 237 | 250 | name: (identifier) @font-lock-function-name-face) | |
| 238 | (method_definition | 251 | |
| 239 | name: (property_identifier) @font-lock-function-name-face) | 252 | (method_definition |
| 240 | (method_signature | 253 | name: (property_identifier) @font-lock-function-name-face) |
| 241 | name: (property_identifier) @font-lock-function-name-face) | 254 | (method_signature |
| 242 | (required_parameter (identifier) @font-lock-variable-name-face) | 255 | name: (property_identifier) @font-lock-function-name-face) |
| 243 | (optional_parameter (identifier) @font-lock-variable-name-face) | 256 | (required_parameter (identifier) @font-lock-variable-name-face) |
| 244 | 257 | (optional_parameter (identifier) @font-lock-variable-name-face) | |
| 245 | (variable_declarator | 258 | |
| 246 | name: (identifier) @font-lock-function-name-face | 259 | (variable_declarator |
| 247 | value: [(function) (arrow_function)]) | 260 | name: (identifier) @font-lock-function-name-face |
| 248 | 261 | value: [(,func-exp) (arrow_function)]) | |
| 249 | (variable_declarator | 262 | |
| 250 | name: (identifier) @font-lock-variable-name-face) | 263 | (variable_declarator |
| 251 | 264 | name: (identifier) @font-lock-variable-name-face) | |
| 252 | (enum_declaration (identifier) @font-lock-type-face) | 265 | |
| 253 | 266 | (enum_declaration (identifier) @font-lock-type-face) | |
| 254 | (extends_clause value: (identifier) @font-lock-type-face) | 267 | |
| 255 | ;; extends React.Component<T> | 268 | (extends_clause value: (identifier) @font-lock-type-face) |
| 256 | (extends_clause value: (member_expression | 269 | ;; extends React.Component<T> |
| 257 | object: (identifier) @font-lock-type-face | 270 | (extends_clause value: (member_expression |
| 258 | property: (property_identifier) @font-lock-type-face)) | 271 | object: (identifier) @font-lock-type-face |
| 259 | 272 | property: (property_identifier) @font-lock-type-face)) | |
| 260 | (arrow_function | 273 | |
| 261 | parameter: (identifier) @font-lock-variable-name-face) | 274 | (arrow_function |
| 262 | 275 | parameter: (identifier) @font-lock-variable-name-face) | |
| 263 | (variable_declarator | 276 | |
| 264 | name: (array_pattern | 277 | (variable_declarator |
| 265 | (identifier) | 278 | name: (array_pattern |
| 266 | (identifier) @font-lock-function-name-face) | 279 | (identifier) |
| 267 | value: (array (number) (function))) | 280 | (identifier) @font-lock-function-name-face) |
| 268 | 281 | value: (array (number) (,func-exp))) | |
| 269 | (catch_clause | 282 | |
| 270 | parameter: (identifier) @font-lock-variable-name-face) | 283 | (catch_clause |
| 271 | 284 | parameter: (identifier) @font-lock-variable-name-face) | |
| 272 | ;; full module imports | 285 | |
| 273 | (import_clause (identifier) @font-lock-variable-name-face) | 286 | ;; full module imports |
| 274 | ;; named imports with aliasing | 287 | (import_clause (identifier) @font-lock-variable-name-face) |
| 275 | (import_clause (named_imports (import_specifier | 288 | ;; named imports with aliasing |
| 276 | alias: (identifier) @font-lock-variable-name-face))) | 289 | (import_clause (named_imports (import_specifier |
| 277 | ;; named imports without aliasing | 290 | alias: (identifier) @font-lock-variable-name-face))) |
| 278 | (import_clause (named_imports (import_specifier | 291 | ;; named imports without aliasing |
| 279 | !alias | 292 | (import_clause (named_imports (import_specifier |
| 280 | name: (identifier) @font-lock-variable-name-face))) | 293 | !alias |
| 281 | 294 | name: (identifier) @font-lock-variable-name-face))) | |
| 282 | ;; full namespace import (* as alias) | 295 | |
| 283 | (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) | 296 | ;; full namespace import (* as alias) |
| 284 | 297 | (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) | |
| 285 | :language language | 298 | |
| 286 | :feature 'identifier | 299 | :language language |
| 287 | `((nested_type_identifier | 300 | :feature 'identifier |
| 288 | module: (identifier) @font-lock-type-face) | 301 | `((nested_type_identifier |
| 289 | 302 | module: (identifier) @font-lock-type-face) | |
| 290 | (type_identifier) @font-lock-type-face | 303 | |
| 291 | 304 | (type_identifier) @font-lock-type-face | |
| 292 | (predefined_type) @font-lock-type-face | 305 | |
| 293 | 306 | (predefined_type) @font-lock-type-face | |
| 294 | (new_expression | 307 | |
| 295 | constructor: (identifier) @font-lock-type-face) | 308 | (new_expression |
| 296 | 309 | constructor: (identifier) @font-lock-type-face) | |
| 297 | (enum_body (property_identifier) @font-lock-type-face) | 310 | |
| 298 | 311 | (enum_body (property_identifier) @font-lock-type-face) | |
| 299 | (enum_assignment name: (property_identifier) @font-lock-type-face) | 312 | |
| 300 | 313 | (enum_assignment name: (property_identifier) @font-lock-type-face) | |
| 301 | (variable_declarator | 314 | |
| 302 | name: (identifier) @font-lock-variable-name-face) | 315 | (variable_declarator |
| 303 | 316 | name: (identifier) @font-lock-variable-name-face) | |
| 304 | (for_in_statement | 317 | |
| 305 | left: (identifier) @font-lock-variable-name-face) | 318 | (for_in_statement |
| 306 | 319 | left: (identifier) @font-lock-variable-name-face) | |
| 307 | (arrow_function | 320 | |
| 308 | parameters: | 321 | (arrow_function |
| 309 | [(_ (identifier) @font-lock-variable-name-face) | 322 | parameters: |
| 310 | (_ (_ (identifier) @font-lock-variable-name-face)) | 323 | [(_ (identifier) @font-lock-variable-name-face) |
| 311 | (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) | 324 | (_ (_ (identifier) @font-lock-variable-name-face)) |
| 312 | 325 | (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) | |
| 313 | :language language | 326 | |
| 314 | :feature 'property | 327 | :language language |
| 315 | `((property_signature | 328 | :feature 'property |
| 316 | name: (property_identifier) @font-lock-property-name-face) | 329 | `((property_signature |
| 317 | (public_field_definition | 330 | name: (property_identifier) @font-lock-property-name-face) |
| 318 | name: (property_identifier) @font-lock-property-name-face) | 331 | (public_field_definition |
| 319 | 332 | name: (property_identifier) @font-lock-property-name-face) | |
| 320 | (pair key: (property_identifier) @font-lock-property-use-face) | 333 | |
| 321 | 334 | (pair key: (property_identifier) @font-lock-property-use-face) | |
| 322 | ((shorthand_property_identifier) @font-lock-property-use-face)) | 335 | |
| 323 | 336 | ((shorthand_property_identifier) @font-lock-property-use-face)) | |
| 324 | :language language | 337 | |
| 325 | :feature 'expression | 338 | :language language |
| 326 | '((assignment_expression | 339 | :feature 'expression |
| 327 | left: [(identifier) @font-lock-function-name-face | 340 | `((assignment_expression |
| 328 | (member_expression | 341 | left: [(identifier) @font-lock-function-name-face |
| 329 | property: (property_identifier) @font-lock-function-name-face)] | 342 | (member_expression |
| 330 | right: [(function) (arrow_function)])) | 343 | property: (property_identifier) @font-lock-function-name-face)] |
| 331 | 344 | right: [(,func-exp) (arrow_function)])) | |
| 332 | :language language | 345 | |
| 333 | :feature 'function | 346 | :language language |
| 334 | '((call_expression | 347 | :feature 'function |
| 335 | function: | 348 | '((call_expression |
| 336 | [(identifier) @font-lock-function-call-face | 349 | function: |
| 337 | (member_expression | 350 | [(identifier) @font-lock-function-call-face |
| 338 | property: (property_identifier) @font-lock-function-call-face)])) | 351 | (member_expression |
| 339 | 352 | property: (property_identifier) @font-lock-function-call-face)])) | |
| 340 | :language language | 353 | |
| 341 | :feature 'pattern | 354 | :language language |
| 342 | `((pair_pattern | 355 | :feature 'pattern |
| 343 | key: (property_identifier) @font-lock-property-use-face | 356 | `((pair_pattern |
| 344 | value: [(identifier) @font-lock-variable-name-face | 357 | key: (property_identifier) @font-lock-property-use-face |
| 345 | (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) | 358 | value: [(identifier) @font-lock-variable-name-face |
| 346 | 359 | (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) | |
| 347 | (array_pattern (identifier) @font-lock-variable-name-face) | 360 | |
| 348 | 361 | (array_pattern (identifier) @font-lock-variable-name-face) | |
| 349 | ((shorthand_property_identifier_pattern) @font-lock-variable-name-face)) | 362 | |
| 350 | 363 | ((shorthand_property_identifier_pattern) @font-lock-variable-name-face)) | |
| 351 | :language language | 364 | |
| 352 | :feature 'jsx | 365 | :language language |
| 353 | (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language) | 366 | :feature 'jsx |
| 354 | `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))) | 367 | (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language) |
| 355 | 368 | `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))) | |
| 356 | :language language | 369 | |
| 357 | :feature 'number | 370 | :language language |
| 358 | `((number) @font-lock-number-face | 371 | :feature 'number |
| 359 | ((identifier) @font-lock-number-face | 372 | `((number) @font-lock-number-face |
| 360 | (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face))) | 373 | ((identifier) @font-lock-number-face |
| 361 | 374 | (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face))) | |
| 362 | :language language | 375 | |
| 363 | :feature 'operator | 376 | :language language |
| 364 | `([,@typescript-ts-mode--operators] @font-lock-operator-face | 377 | :feature 'operator |
| 365 | (ternary_expression ["?" ":"] @font-lock-operator-face)) | 378 | `([,@typescript-ts-mode--operators] @font-lock-operator-face |
| 366 | 379 | (ternary_expression ["?" ":"] @font-lock-operator-face)) | |
| 367 | :language language | 380 | |
| 368 | :feature 'bracket | 381 | :language language |
| 369 | '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) | 382 | :feature 'bracket |
| 370 | 383 | '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) | |
| 371 | :language language | 384 | |
| 372 | :feature 'delimiter | 385 | :language language |
| 373 | '((["," "." ";" ":"]) @font-lock-delimiter-face) | 386 | :feature 'delimiter |
| 374 | 387 | '((["," "." ";" ":"]) @font-lock-delimiter-face) | |
| 375 | :language language | 388 | |
| 376 | :feature 'escape-sequence | 389 | :language language |
| 377 | :override t | 390 | :feature 'escape-sequence |
| 378 | '((escape_sequence) @font-lock-escape-face))) | 391 | :override t |
| 392 | '((escape_sequence) @font-lock-escape-face)))) | ||
| 379 | 393 | ||
| 380 | (defvar typescript-ts-mode--sentence-nodes | 394 | (defvar typescript-ts-mode--sentence-nodes |
| 381 | '("import_statement" | 395 | '("import_statement" |
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index afdf52629c4..144bfa944d3 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el | |||
| @@ -8398,6 +8398,44 @@ buffer." | |||
| 8398 | (message "Updating sensitivity lists...done"))) | 8398 | (message "Updating sensitivity lists...done"))) |
| 8399 | (when noninteractive (save-buffer))) | 8399 | (when noninteractive (save-buffer))) |
| 8400 | 8400 | ||
| 8401 | (defun vhdl--re2-region (beg-re end-re) | ||
| 8402 | "Return a function searching for a region delimited by a pair of regexps. | ||
| 8403 | BEG-RE and END-RE are the regexps delimiting the region to search for." | ||
| 8404 | (lambda (proc-end) | ||
| 8405 | (when (vhdl-re-search-forward beg-re proc-end t) | ||
| 8406 | (save-excursion | ||
| 8407 | (vhdl-re-search-forward end-re proc-end t))))) | ||
| 8408 | |||
| 8409 | (defconst vhdl--signal-regions-functions | ||
| 8410 | (list | ||
| 8411 | ;; right-hand side of signal/variable assignment | ||
| 8412 | ;; (special case: "<=" is relational operator in a condition) | ||
| 8413 | (vhdl--re2-region "[<:]=" | ||
| 8414 | ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>") | ||
| 8415 | ;; if condition | ||
| 8416 | (vhdl--re2-region "^\\s-*if\\>" "\\<then\\>") | ||
| 8417 | ;; elsif condition | ||
| 8418 | (vhdl--re2-region "\\<elsif\\>" "\\<then\\>") | ||
| 8419 | ;; while loop condition | ||
| 8420 | (vhdl--re2-region "^\\s-*while\\>" "\\<loop\\>") | ||
| 8421 | ;; exit/next condition | ||
| 8422 | (vhdl--re2-region "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ";") | ||
| 8423 | ;; assert condition | ||
| 8424 | (vhdl--re2-region "\\<assert\\>" "\\(\\<report\\>\\|\\<severity\\>\\|;\\)") | ||
| 8425 | ;; case expression | ||
| 8426 | (vhdl--re2-region "^\\s-*case\\>" "\\<is\\>") | ||
| 8427 | ;; parameter list of procedure call, array index | ||
| 8428 | (lambda (proc-end) | ||
| 8429 | (when (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) | ||
| 8430 | (forward-char -1) | ||
| 8431 | (save-excursion | ||
| 8432 | (forward-sexp) | ||
| 8433 | (while (looking-at "(") (forward-sexp)) (point))))) | ||
| 8434 | "Define syntactic regions where signals are read. | ||
| 8435 | Each function is called with one arg (a limit for the (forward) search) and | ||
| 8436 | should return either nil or the end position of the region (in which case | ||
| 8437 | point will be set to its beginning).") | ||
| 8438 | |||
| 8401 | (defun vhdl-update-sensitivity-list () | 8439 | (defun vhdl-update-sensitivity-list () |
| 8402 | "Update sensitivity list." | 8440 | "Update sensitivity list." |
| 8403 | (let ((proc-beg (point)) | 8441 | (let ((proc-beg (point)) |
| @@ -8418,35 +8456,6 @@ buffer." | |||
| 8418 | (let | 8456 | (let |
| 8419 | ;; scan for visible signals | 8457 | ;; scan for visible signals |
| 8420 | ((visible-list (vhdl-get-visible-signals)) | 8458 | ((visible-list (vhdl-get-visible-signals)) |
| 8421 | ;; define syntactic regions where signals are read | ||
| 8422 | (scan-regions-list | ||
| 8423 | `(;; right-hand side of signal/variable assignment | ||
| 8424 | ;; (special case: "<=" is relational operator in a condition) | ||
| 8425 | ((vhdl-re-search-forward "[<:]=" ,proc-end t) | ||
| 8426 | (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" ,proc-end t)) | ||
| 8427 | ;; if condition | ||
| 8428 | ((vhdl-re-search-forward "^\\s-*if\\>" ,proc-end t) | ||
| 8429 | (vhdl-re-search-forward "\\<then\\>" ,proc-end t)) | ||
| 8430 | ;; elsif condition | ||
| 8431 | ((vhdl-re-search-forward "\\<elsif\\>" ,proc-end t) | ||
| 8432 | (vhdl-re-search-forward "\\<then\\>" ,proc-end t)) | ||
| 8433 | ;; while loop condition | ||
| 8434 | ((vhdl-re-search-forward "^\\s-*while\\>" ,proc-end t) | ||
| 8435 | (vhdl-re-search-forward "\\<loop\\>" ,proc-end t)) | ||
| 8436 | ;; exit/next condition | ||
| 8437 | ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ,proc-end t) | ||
| 8438 | (vhdl-re-search-forward ";" ,proc-end t)) | ||
| 8439 | ;; assert condition | ||
| 8440 | ((vhdl-re-search-forward "\\<assert\\>" ,proc-end t) | ||
| 8441 | (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" ,proc-end t)) | ||
| 8442 | ;; case expression | ||
| 8443 | ((vhdl-re-search-forward "^\\s-*case\\>" ,proc-end t) | ||
| 8444 | (vhdl-re-search-forward "\\<is\\>" ,proc-end t)) | ||
| 8445 | ;; parameter list of procedure call, array index | ||
| 8446 | ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" ,proc-end t) | ||
| 8447 | (1- (point))) | ||
| 8448 | (progn (backward-char) (forward-sexp) | ||
| 8449 | (while (looking-at "(") (forward-sexp)) (point))))) | ||
| 8450 | name field read-list sens-list signal-list tmp-list | 8459 | name field read-list sens-list signal-list tmp-list |
| 8451 | sens-beg sens-end beg end margin) | 8460 | sens-beg sens-end beg end margin) |
| 8452 | ;; scan for signals in old sensitivity list | 8461 | ;; scan for signals in old sensitivity list |
| @@ -8475,11 +8484,9 @@ buffer." | |||
| 8475 | (push (cons end (point)) seq-region-list) | 8484 | (push (cons end (point)) seq-region-list) |
| 8476 | (beginning-of-line))) | 8485 | (beginning-of-line))) |
| 8477 | ;; scan for signals read in process | 8486 | ;; scan for signals read in process |
| 8478 | (while scan-regions-list | 8487 | (dolist (scan-fun vhdl--signal-regions-functions) |
| 8479 | (goto-char proc-mid) | 8488 | (goto-char proc-mid) |
| 8480 | (while (and (setq beg (eval (nth 0 (car scan-regions-list)))) | 8489 | (while (setq end (funcall scan-fun proc-end)) |
| 8481 | (setq end (eval (nth 1 (car scan-regions-list))))) | ||
| 8482 | (goto-char beg) | ||
| 8483 | (unless (or (vhdl-in-literal) | 8490 | (unless (or (vhdl-in-literal) |
| 8484 | (and seq-region-list | 8491 | (and seq-region-list |
| 8485 | (let ((tmp-list seq-region-list)) | 8492 | (let ((tmp-list seq-region-list)) |
| @@ -8518,8 +8525,7 @@ buffer." | |||
| 8518 | (car tmp-list)) | 8525 | (car tmp-list)) |
| 8519 | (setq read-list (delete (car tmp-list) read-list))) | 8526 | (setq read-list (delete (car tmp-list) read-list))) |
| 8520 | (setq tmp-list (cdr tmp-list))))) | 8527 | (setq tmp-list (cdr tmp-list))))) |
| 8521 | (goto-char (match-end 1))))) | 8528 | (goto-char (match-end 1)))))) |
| 8522 | (setq scan-regions-list (cdr scan-regions-list))) | ||
| 8523 | ;; update sensitivity list | 8529 | ;; update sensitivity list |
| 8524 | (goto-char sens-beg) | 8530 | (goto-char sens-beg) |
| 8525 | (if sens-end | 8531 | (if sens-end |
| @@ -14978,9 +14984,9 @@ otherwise use cached data." | |||
| 14978 | (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) | 14984 | (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) |
| 14979 | 14985 | ||
| 14980 | (defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg | 14986 | (defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg |
| 14981 | package-alist ent-inst-list depth) | 14987 | pkg-alist ent-inst-list depth) |
| 14982 | "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PACKAGE-ALIST." | 14988 | "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PKG-ALIST." |
| 14983 | (if (not (or ent-alist-arg conf-alist-arg package-alist)) | 14989 | (if (not (or ent-alist-arg conf-alist-arg pkg-alist)) |
| 14984 | (vhdl-speedbar-make-title-line "No VHDL design units!" depth) | 14990 | (vhdl-speedbar-make-title-line "No VHDL design units!" depth) |
| 14985 | (let ((ent-alist ent-alist-arg) | 14991 | (let ((ent-alist ent-alist-arg) |
| 14986 | (conf-alist conf-alist-arg) | 14992 | (conf-alist conf-alist-arg) |
| @@ -15010,15 +15016,15 @@ otherwise use cached data." | |||
| 15010 | 'vhdl-speedbar-configuration-face depth) | 15016 | 'vhdl-speedbar-configuration-face depth) |
| 15011 | (setq conf-alist (cdr conf-alist))) | 15017 | (setq conf-alist (cdr conf-alist))) |
| 15012 | ;; insert packages | 15018 | ;; insert packages |
| 15013 | (when package-alist (vhdl-speedbar-make-title-line "Packages:" depth)) | 15019 | (when pkg-alist (vhdl-speedbar-make-title-line "Packages:" depth)) |
| 15014 | (while package-alist | 15020 | (while pkg-alist |
| 15015 | (setq pack-entry (car package-alist)) | 15021 | (setq pack-entry (car pkg-alist)) |
| 15016 | (vhdl-speedbar-make-pack-line | 15022 | (vhdl-speedbar-make-pack-line |
| 15017 | (nth 0 pack-entry) (nth 1 pack-entry) | 15023 | (nth 0 pack-entry) (nth 1 pack-entry) |
| 15018 | (cons (nth 2 pack-entry) (nth 3 pack-entry)) | 15024 | (cons (nth 2 pack-entry) (nth 3 pack-entry)) |
| 15019 | (cons (nth 7 pack-entry) (nth 8 pack-entry)) | 15025 | (cons (nth 7 pack-entry) (nth 8 pack-entry)) |
| 15020 | depth) | 15026 | depth) |
| 15021 | (setq package-alist (cdr package-alist)))))) | 15027 | (setq pkg-alist (cdr pkg-alist)))))) |
| 15022 | 15028 | ||
| 15023 | (declare-function speedbar-line-directory "speedbar" (&optional depth)) | 15029 | (declare-function speedbar-line-directory "speedbar" (&optional depth)) |
| 15024 | 15030 | ||
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index bd68672f905..b36e13104e3 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el | |||
| @@ -211,7 +211,7 @@ non-nil.") | |||
| 211 | (when which-function-mode | 211 | (when which-function-mode |
| 212 | (unless (local-variable-p 'which-func-mode) | 212 | (unless (local-variable-p 'which-func-mode) |
| 213 | (setq which-func-mode (or (eq which-func-modes t) | 213 | (setq which-func-mode (or (eq which-func-modes t) |
| 214 | (member major-mode which-func-modes))) | 214 | (derived-mode-p which-func-modes))) |
| 215 | (setq which-func--use-mode-line | 215 | (setq which-func--use-mode-line |
| 216 | (member which-func-display '(mode mode-and-header))) | 216 | (member which-func-display '(mode mode-and-header))) |
| 217 | (setq which-func--use-header-line | 217 | (setq which-func--use-header-line |
| @@ -239,7 +239,7 @@ It creates the Imenu index for the buffer, if necessary." | |||
| 239 | 239 | ||
| 240 | (condition-case err | 240 | (condition-case err |
| 241 | (if (and which-func-mode | 241 | (if (and which-func-mode |
| 242 | (not (member major-mode which-func-non-auto-modes)) | 242 | (not (derived-mode-p which-func-non-auto-modes)) |
| 243 | (or (null which-func-maxout) | 243 | (or (null which-func-maxout) |
| 244 | (< buffer-saved-size which-func-maxout) | 244 | (< buffer-saved-size which-func-maxout) |
| 245 | (= which-func-maxout 0))) | 245 | (= which-func-maxout 0))) |
diff --git a/lisp/server.el b/lisp/server.el index 66e6d729f8a..b65053267a6 100644 --- a/lisp/server.el +++ b/lisp/server.el | |||
| @@ -1439,7 +1439,11 @@ invocations of \"emacs\".") | |||
| 1439 | ;; including code that needs to wait. | 1439 | ;; including code that needs to wait. |
| 1440 | (with-local-quit | 1440 | (with-local-quit |
| 1441 | (condition-case err | 1441 | (condition-case err |
| 1442 | (let ((buffers (server-visit-files files proc nowait))) | 1442 | (let ((buffers (server-visit-files files proc nowait)) |
| 1443 | ;; On Android, the Emacs server generally can't provide | ||
| 1444 | ;; feedback to the user except by means of dialog boxes, | ||
| 1445 | ;; which are displayed in the GUI emacsclient wrapper. | ||
| 1446 | (use-dialog-box-override (featurep 'android))) | ||
| 1443 | (mapc 'funcall (nreverse commands)) | 1447 | (mapc 'funcall (nreverse commands)) |
| 1444 | (let ((server-eval-args-left (nreverse evalexprs))) | 1448 | (let ((server-eval-args-left (nreverse evalexprs))) |
| 1445 | (while server-eval-args-left | 1449 | (while server-eval-args-left |
diff --git a/lisp/simple.el b/lisp/simple.el index 8246b9cab81..f127290231b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -6419,7 +6419,7 @@ PROMPT is a string to prompt with." | |||
| 6419 | 0 (length s) | 6419 | 0 (length s) |
| 6420 | '( | 6420 | '( |
| 6421 | keymap local-map action mouse-action | 6421 | keymap local-map action mouse-action |
| 6422 | button category help-args) | 6422 | read-only button category help-args) |
| 6423 | s) | 6423 | s) |
| 6424 | s) | 6424 | s) |
| 6425 | kill-ring)) | 6425 | kill-ring)) |
| @@ -10858,6 +10858,87 @@ and setting it to nil." | |||
| 10858 | (setq-local vis-mode-saved-buffer-invisibility-spec | 10858 | (setq-local vis-mode-saved-buffer-invisibility-spec |
| 10859 | buffer-invisibility-spec) | 10859 | buffer-invisibility-spec) |
| 10860 | (setq buffer-invisibility-spec nil))) | 10860 | (setq buffer-invisibility-spec nil))) |
| 10861 | |||
| 10862 | |||
| 10863 | (defvar read-passwd--mode-line-buffer nil | ||
| 10864 | "Buffer to modify `mode-line-format' for showing/hiding passwords.") | ||
| 10865 | |||
| 10866 | (defvar read-passwd--mode-line-icon nil | ||
| 10867 | "Propertized mode line icon for showing/hiding passwords.") | ||
| 10868 | |||
| 10869 | (defun read-passwd-toggle-visibility () | ||
| 10870 | "Toggle minibuffer contents visibility. | ||
| 10871 | Adapt also mode line." | ||
| 10872 | (interactive) | ||
| 10873 | (setq read-passwd--hide-password (not read-passwd--hide-password)) | ||
| 10874 | (with-current-buffer read-passwd--mode-line-buffer | ||
| 10875 | (setq read-passwd--mode-line-icon | ||
| 10876 | `(:propertize | ||
| 10877 | ,(if icon-preference | ||
| 10878 | (icon-string | ||
| 10879 | (if read-passwd--hide-password | ||
| 10880 | 'read-passwd--show-password-icon | ||
| 10881 | 'read-passwd--hide-password-icon)) | ||
| 10882 | "") | ||
| 10883 | mouse-face mode-line-highlight | ||
| 10884 | local-map | ||
| 10885 | (keymap | ||
| 10886 | (mode-line keymap (mouse-1 . read-passwd-toggle-visibility))))) | ||
| 10887 | (force-mode-line-update)) | ||
| 10888 | (read-passwd--hide-password)) | ||
| 10889 | |||
| 10890 | (define-minor-mode read-passwd-mode | ||
| 10891 | "Toggle visibility of password in minibuffer." | ||
| 10892 | :group 'mode-line | ||
| 10893 | :group 'minibuffer | ||
| 10894 | :keymap read-passwd-map | ||
| 10895 | :version "30.1" | ||
| 10896 | |||
| 10897 | (require 'icons) | ||
| 10898 | ;; It would be preferable to use "👁" ("\N{EYE}"). However, there is | ||
| 10899 | ;; no corresponding Unicode char with a slash. So we use symbols as | ||
| 10900 | ;; fallback only, with "⦵" ("\N{CIRCLE WITH HORIZONTAL BAR}") for | ||
| 10901 | ;; hiding the password. | ||
| 10902 | (define-icon read-passwd--show-password-icon nil | ||
| 10903 | '((image "reveal.svg" "reveal.pbm" :height (0.8 . em)) | ||
| 10904 | (symbol "👁") | ||
| 10905 | (text "<o>")) | ||
| 10906 | "Mode line icon to show a hidden password." | ||
| 10907 | :group mode-line-faces | ||
| 10908 | :version "30.1" | ||
| 10909 | :help-echo "mouse-1: Toggle password visibility") | ||
| 10910 | (define-icon read-passwd--hide-password-icon nil | ||
| 10911 | '((image "conceal.svg" "conceal.pbm" :height (0.8 . em)) | ||
| 10912 | (symbol "⦵") | ||
| 10913 | (text "<\\>")) | ||
| 10914 | "Mode line icon to hide a visible password." | ||
| 10915 | :group mode-line-faces | ||
| 10916 | :version "30.1" | ||
| 10917 | :help-echo "mouse-1: Toggle password visibility") | ||
| 10918 | |||
| 10919 | (setq read-passwd--hide-password nil | ||
| 10920 | ;; Stolen from `eldoc-minibuffer-message'. | ||
| 10921 | read-passwd--mode-line-buffer | ||
| 10922 | (window-buffer | ||
| 10923 | (or (window-in-direction 'above (minibuffer-window)) | ||
| 10924 | (minibuffer-selected-window) | ||
| 10925 | (get-largest-window)))) | ||
| 10926 | |||
| 10927 | (if read-passwd-mode | ||
| 10928 | (with-current-buffer read-passwd--mode-line-buffer | ||
| 10929 | ;; Add `read-passwd--mode-line-icon'. | ||
| 10930 | (when (listp mode-line-format) | ||
| 10931 | (setq mode-line-format | ||
| 10932 | (cons '(:eval read-passwd--mode-line-icon) | ||
| 10933 | mode-line-format)))) | ||
| 10934 | (with-current-buffer read-passwd--mode-line-buffer | ||
| 10935 | ;; Remove `read-passwd--mode-line-icon'. | ||
| 10936 | (when (listp mode-line-format) | ||
| 10937 | (setq mode-line-format (cdr mode-line-format))))) | ||
| 10938 | |||
| 10939 | (when read-passwd-mode | ||
| 10940 | (read-passwd-toggle-visibility))) | ||
| 10941 | |||
| 10861 | 10942 | ||
| 10862 | (defvar messages-buffer-mode-map | 10943 | (defvar messages-buffer-mode-map |
| 10863 | (let ((map (make-sparse-keymap))) | 10944 | (let ((map (make-sparse-keymap))) |
diff --git a/lisp/sort.el b/lisp/sort.el index 2ee76b6e1e3..4f0d759ef8a 100644 --- a/lisp/sort.el +++ b/lisp/sort.el | |||
| @@ -478,6 +478,27 @@ sRegexp specifying key within record: \nr") | |||
| 478 | ;; if there was no such register | 478 | ;; if there was no such register |
| 479 | (error (throw 'key nil)))))))))) | 479 | (error (throw 'key nil)))))))))) |
| 480 | 480 | ||
| 481 | ;;;###autoload | ||
| 482 | (defun sort-on (sequence predicate accessor) | ||
| 483 | "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. | ||
| 484 | SEQUENCE should be the input sequence to sort. | ||
| 485 | Elements of SEQUENCE are sorted by keys which are obtained by | ||
| 486 | calling ACCESSOR on each element. ACCESSOR should be a function of | ||
| 487 | one argument, an element of SEQUENCE, and should return the key | ||
| 488 | value to be compared by PREDICATE for sorting the element. | ||
| 489 | PREDICATE is the function for comparing keys; it is called with two | ||
| 490 | arguments, the keys to compare, and should return non-nil if the | ||
| 491 | first key should sort before the second key. | ||
| 492 | The return value is always a new list. | ||
| 493 | This function has the performance advantage of evaluating | ||
| 494 | ACCESSOR only once for each element in the input SEQUENCE, and is | ||
| 495 | therefore appropriate when computing the key by ACCESSOR is an | ||
| 496 | expensive operation. This is known as the \"decorate-sort-undecorate\" | ||
| 497 | paradigm, or the Schwartzian transform." | ||
| 498 | (mapcar #'car | ||
| 499 | (sort (mapcar #'(lambda (x) (cons x (funcall accessor x))) sequence) | ||
| 500 | #'(lambda (x y) (funcall predicate (cdr x) (cdr y)))))) | ||
| 501 | |||
| 481 | 502 | ||
| 482 | (defvar sort-columns-subprocess t) | 503 | (defvar sort-columns-subprocess t) |
| 483 | 504 | ||
diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 1cb72dc23e6..2ed97986fe7 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el | |||
| @@ -3488,7 +3488,7 @@ functions to do caching and flushing if appropriate." | |||
| 3488 | 3488 | ||
| 3489 | nil | 3489 | nil |
| 3490 | 3490 | ||
| 3491 | (eval-when-compile (condition-case nil (require 'imenu) (error nil))) | 3491 | (eval-when-compile (require 'imenu)) |
| 3492 | (declare-function imenu--make-index-alist "imenu" (&optional no-error)) | 3492 | (declare-function imenu--make-index-alist "imenu" (&optional no-error)) |
| 3493 | 3493 | ||
| 3494 | (defun speedbar-fetch-dynamic-imenu (file) | 3494 | (defun speedbar-fetch-dynamic-imenu (file) |
diff --git a/lisp/startup.el b/lisp/startup.el index 23937055f30..33e1124b998 100644 --- a/lisp/startup.el +++ b/lisp/startup.el | |||
| @@ -556,6 +556,17 @@ the updated value." | |||
| 556 | (setq startup--original-eln-load-path | 556 | (setq startup--original-eln-load-path |
| 557 | (copy-sequence native-comp-eln-load-path)))) | 557 | (copy-sequence native-comp-eln-load-path)))) |
| 558 | 558 | ||
| 559 | (defun startup--rescale-elt-match-p (font-pattern font-object) | ||
| 560 | "Test whether FONT-OBJECT matches an element of `face-font-rescale-alist'. | ||
| 561 | FONT-OBJECT is a font-object that specifies a font to test. | ||
| 562 | FONT-PATTERN is the car of an element of `face-font-rescale-alist', | ||
| 563 | which can be either a regexp matching a font name or a font-spec." | ||
| 564 | (if (stringp font-pattern) | ||
| 565 | ;; FONT-PATTERN is a regexp, we need the name of FONT-OBJECT to match. | ||
| 566 | (string-match-p font-pattern (font-xlfd-name font-object)) | ||
| 567 | ;; FONT-PATTERN is a font-spec. | ||
| 568 | (font-match-p font-pattern font-object))) | ||
| 569 | |||
| 559 | (defvar android-fonts-enumerated nil | 570 | (defvar android-fonts-enumerated nil |
| 560 | "Whether or not fonts have been enumerated already. | 571 | "Whether or not fonts have been enumerated already. |
| 561 | On Android, Emacs uses this variable internally at startup.") | 572 | On Android, Emacs uses this variable internally at startup.") |
| @@ -816,8 +827,9 @@ It is the default value of the variable `top-level'." | |||
| 816 | (when (and (display-multi-font-p) | 827 | (when (and (display-multi-font-p) |
| 817 | (not (eq face-font-rescale-alist | 828 | (not (eq face-font-rescale-alist |
| 818 | old-face-font-rescale-alist)) | 829 | old-face-font-rescale-alist)) |
| 819 | (assoc (font-xlfd-name (face-attribute 'default :font)) | 830 | (assoc (face-attribute 'default :font) |
| 820 | face-font-rescale-alist #'string-match-p)) | 831 | face-font-rescale-alist |
| 832 | #'startup--rescale-elt-match-p)) | ||
| 821 | (set-face-attribute 'default nil :font (font-spec))) | 833 | (set-face-attribute 'default nil :font (font-spec))) |
| 822 | 834 | ||
| 823 | ;; Modify the initial frame based on what .emacs puts into | 835 | ;; Modify the initial frame based on what .emacs puts into |
| @@ -1627,7 +1639,9 @@ Consider using a subdirectory instead, e.g.: %s" | |||
| 1627 | (let ((dn (daemonp))) | 1639 | (let ((dn (daemonp))) |
| 1628 | (when dn | 1640 | (when dn |
| 1629 | (when (stringp dn) (setq server-name dn)) | 1641 | (when (stringp dn) (setq server-name dn)) |
| 1630 | (server-start) | 1642 | (condition-case err |
| 1643 | (server-start) | ||
| 1644 | (error (error "Unable to start daemon: %s; exiting" (error-message-string err)))) | ||
| 1631 | (if server-process | 1645 | (if server-process |
| 1632 | (daemon-initialized) | 1646 | (daemon-initialized) |
| 1633 | (if (stringp dn) | 1647 | (if (stringp dn) |
| @@ -1758,7 +1772,7 @@ If this is nil, no message will be displayed." | |||
| 1758 | "\n")) | 1772 | "\n")) |
| 1759 | "A list of texts to show in the middle part of splash screens. | 1773 | "A list of texts to show in the middle part of splash screens. |
| 1760 | Each element in the list should be a list of strings or pairs | 1774 | Each element in the list should be a list of strings or pairs |
| 1761 | `:face FACE', like `fancy-splash-insert' accepts them.") | 1775 | `:KEYWORD VALUE', like what `fancy-splash-insert' accepts.") |
| 1762 | 1776 | ||
| 1763 | (defconst fancy-about-text | 1777 | (defconst fancy-about-text |
| 1764 | `((:face (variable-pitch font-lock-comment-face) | 1778 | `((:face (variable-pitch font-lock-comment-face) |
| @@ -1851,7 +1865,7 @@ Each element in the list should be a list of strings or pairs | |||
| 1851 | "\tDisplay the Emacs manual in Info mode")) | 1865 | "\tDisplay the Emacs manual in Info mode")) |
| 1852 | "A list of texts to show in the middle part of the About screen. | 1866 | "A list of texts to show in the middle part of the About screen. |
| 1853 | Each element in the list should be a list of strings or pairs | 1867 | Each element in the list should be a list of strings or pairs |
| 1854 | `:face FACE', like `fancy-splash-insert' accepts them.") | 1868 | `:KEYWORD VALUE', like what `fancy-splash-insert' accepts.") |
| 1855 | 1869 | ||
| 1856 | 1870 | ||
| 1857 | (defgroup fancy-splash-screen () | 1871 | (defgroup fancy-splash-screen () |
diff --git a/lisp/subr.el b/lisp/subr.el index 33de100870e..d58f8ba3b27 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1,7 +1,6 @@ | |||
| 1 | ;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*- | 1 | ;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2024 Free Software | 3 | ;; Copyright (C) 1985-2024 Free Software Foundation, Inc. |
| 4 | ;; Foundation, Inc. | ||
| 5 | 4 | ||
| 6 | ;; Maintainer: emacs-devel@gnu.org | 5 | ;; Maintainer: emacs-devel@gnu.org |
| 7 | ;; Keywords: internal | 6 | ;; Keywords: internal |
| @@ -2023,6 +2022,8 @@ instead; it will indirectly limit the specpdl stack size as well.") | |||
| 2023 | 2022 | ||
| 2024 | (defvaralias 'native-comp-deferred-compilation 'native-comp-jit-compilation) | 2023 | (defvaralias 'native-comp-deferred-compilation 'native-comp-jit-compilation) |
| 2025 | 2024 | ||
| 2025 | (define-obsolete-function-alias 'fetch-bytecode #'ignore "30.1") | ||
| 2026 | |||
| 2026 | 2027 | ||
| 2027 | ;;;; Alternate names for functions - these are not being phased out. | 2028 | ;;;; Alternate names for functions - these are not being phased out. |
| 2028 | 2029 | ||
| @@ -2579,6 +2580,8 @@ Affects only hooks run in the current buffer." | |||
| 2579 | (list binding binding)) | 2580 | (list binding binding)) |
| 2580 | ((null (cdr binding)) | 2581 | ((null (cdr binding)) |
| 2581 | (list (make-symbol "s") (car binding))) | 2582 | (list (make-symbol "s") (car binding))) |
| 2583 | ((eq '_ (car binding)) | ||
| 2584 | (list (make-symbol "s") (cadr binding))) | ||
| 2582 | (t binding))) | 2585 | (t binding))) |
| 2583 | (when (> (length binding) 2) | 2586 | (when (> (length binding) 2) |
| 2584 | (signal 'error | 2587 | (signal 'error |
| @@ -2619,7 +2622,7 @@ This is like `when-let' but doesn't handle a VARLIST of the form | |||
| 2619 | (defmacro and-let* (varlist &rest body) | 2622 | (defmacro and-let* (varlist &rest body) |
| 2620 | "Bind variables according to VARLIST and conditionally evaluate BODY. | 2623 | "Bind variables according to VARLIST and conditionally evaluate BODY. |
| 2621 | Like `when-let*', except if BODY is empty and all the bindings | 2624 | Like `when-let*', except if BODY is empty and all the bindings |
| 2622 | are non-nil, then the result is non-nil." | 2625 | are non-nil, then the result is the value of the last binding." |
| 2623 | (declare (indent 1) (debug if-let*)) | 2626 | (declare (indent 1) (debug if-let*)) |
| 2624 | (let (res) | 2627 | (let (res) |
| 2625 | (if varlist | 2628 | (if varlist |
| @@ -2632,7 +2635,8 @@ are non-nil, then the result is non-nil." | |||
| 2632 | "Bind variables according to SPEC and evaluate THEN or ELSE. | 2635 | "Bind variables according to SPEC and evaluate THEN or ELSE. |
| 2633 | Evaluate each binding in turn, as in `let*', stopping if a | 2636 | Evaluate each binding in turn, as in `let*', stopping if a |
| 2634 | binding value is nil. If all are non-nil return the value of | 2637 | binding value is nil. If all are non-nil return the value of |
| 2635 | THEN, otherwise the last form in ELSE. | 2638 | THEN, otherwise the value of the last form in ELSE, or nil if |
| 2639 | there are none. | ||
| 2636 | 2640 | ||
| 2637 | Each element of SPEC is a list (SYMBOL VALUEFORM) that binds | 2641 | Each element of SPEC is a list (SYMBOL VALUEFORM) that binds |
| 2638 | SYMBOL to the value of VALUEFORM. An element can additionally be | 2642 | SYMBOL to the value of VALUEFORM. An element can additionally be |
| @@ -3374,14 +3378,23 @@ with Emacs. Do not call it directly in your own packages." | |||
| 3374 | (let ((map (make-sparse-keymap))) | 3378 | (let ((map (make-sparse-keymap))) |
| 3375 | (set-keymap-parent map minibuffer-local-map) | 3379 | (set-keymap-parent map minibuffer-local-map) |
| 3376 | (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 | 3380 | (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 |
| 3381 | (define-key map "\t" #'read-passwd-toggle-visibility) | ||
| 3377 | map) | 3382 | map) |
| 3378 | "Keymap used while reading passwords.") | 3383 | "Keymap used while reading passwords.") |
| 3379 | 3384 | ||
| 3380 | (defun read-password--hide-password () | 3385 | (defvar read-passwd--hide-password t) |
| 3386 | |||
| 3387 | (defun read-passwd--hide-password () | ||
| 3388 | "Make password in minibuffer hidden or visible." | ||
| 3381 | (let ((beg (minibuffer-prompt-end))) | 3389 | (let ((beg (minibuffer-prompt-end))) |
| 3382 | (dotimes (i (1+ (- (buffer-size) beg))) | 3390 | (dotimes (i (1+ (- (buffer-size) beg))) |
| 3383 | (put-text-property (+ i beg) (+ 1 i beg) | 3391 | (if read-passwd--hide-password |
| 3384 | 'display (string (or read-hide-char ?*)))))) | 3392 | (put-text-property |
| 3393 | (+ i beg) (+ 1 i beg) 'display (string (or read-hide-char ?*))) | ||
| 3394 | (remove-list-of-text-properties (+ i beg) (+ 1 i beg) '(display))) | ||
| 3395 | (put-text-property | ||
| 3396 | (+ i beg) (+ 1 i beg) | ||
| 3397 | 'help-echo "C-u: Clear password\nTAB: Toggle password visibility")))) | ||
| 3385 | 3398 | ||
| 3386 | (defun read-passwd (prompt &optional confirm default) | 3399 | (defun read-passwd (prompt &optional confirm default) |
| 3387 | "Read a password, prompting with PROMPT, and return it. | 3400 | "Read a password, prompting with PROMPT, and return it. |
| @@ -3419,18 +3432,20 @@ by doing (clear-string STRING)." | |||
| 3419 | (setq-local inhibit-modification-hooks nil) ;bug#15501. | 3432 | (setq-local inhibit-modification-hooks nil) ;bug#15501. |
| 3420 | (setq-local show-paren-mode nil) ;bug#16091. | 3433 | (setq-local show-paren-mode nil) ;bug#16091. |
| 3421 | (setq-local inhibit--record-char t) | 3434 | (setq-local inhibit--record-char t) |
| 3422 | (add-hook 'post-command-hook #'read-password--hide-password nil t)) | 3435 | (read-passwd-mode 1) |
| 3436 | (add-hook 'post-command-hook #'read-passwd--hide-password nil t)) | ||
| 3423 | (unwind-protect | 3437 | (unwind-protect |
| 3424 | (let ((enable-recursive-minibuffers t) | 3438 | (let ((enable-recursive-minibuffers t) |
| 3425 | (read-hide-char (or read-hide-char ?*))) | 3439 | (read-hide-char (or read-hide-char ?*))) |
| 3426 | (read-string prompt nil t default)) ; t = "no history" | 3440 | (read-string prompt nil t default)) ; t = "no history" |
| 3427 | (when (buffer-live-p minibuf) | 3441 | (when (buffer-live-p minibuf) |
| 3428 | (with-current-buffer minibuf | 3442 | (with-current-buffer minibuf |
| 3443 | (read-passwd-mode -1) | ||
| 3429 | ;; Not sure why but it seems that there might be cases where the | 3444 | ;; Not sure why but it seems that there might be cases where the |
| 3430 | ;; minibuffer is not always properly reset later on, so undo | 3445 | ;; minibuffer is not always properly reset later on, so undo |
| 3431 | ;; whatever we've done here (bug#11392). | 3446 | ;; whatever we've done here (bug#11392). |
| 3432 | (remove-hook 'after-change-functions | 3447 | (remove-hook 'after-change-functions |
| 3433 | #'read-password--hide-password 'local) | 3448 | #'read-passwd--hide-password 'local) |
| 3434 | (kill-local-variable 'post-self-insert-hook) | 3449 | (kill-local-variable 'post-self-insert-hook) |
| 3435 | ;; And of course, don't keep the sensitive data around. | 3450 | ;; And of course, don't keep the sensitive data around. |
| 3436 | (erase-buffer)))))))) | 3451 | (erase-buffer)))))))) |
| @@ -3725,10 +3740,10 @@ There is no need to explicitly add `help-char' to CHARS; | |||
| 3725 | (this-command this-command) | 3740 | (this-command this-command) |
| 3726 | (result (minibuffer-with-setup-hook | 3741 | (result (minibuffer-with-setup-hook |
| 3727 | (lambda () | 3742 | (lambda () |
| 3743 | (setq-local post-self-insert-hook nil) | ||
| 3728 | (add-hook 'post-command-hook | 3744 | (add-hook 'post-command-hook |
| 3729 | (lambda () | 3745 | (lambda () |
| 3730 | ;; FIXME: Should we use `<='? | 3746 | (if (<= (1+ (minibuffer-prompt-end)) |
| 3731 | (if (= (1+ (minibuffer-prompt-end)) | ||
| 3732 | (point-max)) | 3747 | (point-max)) |
| 3733 | (exit-minibuffer))) | 3748 | (exit-minibuffer))) |
| 3734 | nil 'local)) | 3749 | nil 'local)) |
| @@ -3828,15 +3843,25 @@ confusing to some users.") | |||
| 3828 | 3843 | ||
| 3829 | (defvar from--tty-menu-p nil | 3844 | (defvar from--tty-menu-p nil |
| 3830 | "Non-nil means the current command was invoked from a TTY menu.") | 3845 | "Non-nil means the current command was invoked from a TTY menu.") |
| 3846 | |||
| 3847 | (declare-function android-detect-keyboard "androidfns.c") | ||
| 3848 | |||
| 3849 | (defvar use-dialog-box-override nil | ||
| 3850 | "Whether `use-dialog-box-p' should always return t.") | ||
| 3851 | |||
| 3831 | (defun use-dialog-box-p () | 3852 | (defun use-dialog-box-p () |
| 3832 | "Return non-nil if the current command should prompt the user via a dialog box." | 3853 | "Return non-nil if the current command should prompt the user via a dialog box." |
| 3833 | (and last-input-event ; not during startup | 3854 | (or use-dialog-box-override |
| 3834 | (or (consp last-nonmenu-event) ; invoked by a mouse event | 3855 | (and last-input-event ; not during startup |
| 3835 | (and (null last-nonmenu-event) | 3856 | (or (consp last-nonmenu-event) ; invoked by a mouse event |
| 3836 | (consp last-input-event)) | 3857 | (and (null last-nonmenu-event) |
| 3837 | (featurep 'android) ; Prefer dialog boxes on Android. | 3858 | (consp last-input-event)) |
| 3838 | from--tty-menu-p) ; invoked via TTY menu | 3859 | (and (featurep 'android) ; Prefer dialog boxes on |
| 3839 | use-dialog-box)) | 3860 | ; Android. |
| 3861 | (not (android-detect-keyboard))) ; If no keyboard is | ||
| 3862 | ; connected. | ||
| 3863 | from--tty-menu-p) ; invoked via TTY menu | ||
| 3864 | use-dialog-box))) | ||
| 3840 | 3865 | ||
| 3841 | ;; Actually in textconv.c. | 3866 | ;; Actually in textconv.c. |
| 3842 | (defvar overriding-text-conversion-style) | 3867 | (defvar overriding-text-conversion-style) |
| @@ -5014,7 +5039,7 @@ read-only, and scans it for function and variable names to make them into | |||
| 5014 | clickable cross-references. | 5039 | clickable cross-references. |
| 5015 | 5040 | ||
| 5016 | See the related form `with-temp-buffer-window'." | 5041 | See the related form `with-temp-buffer-window'." |
| 5017 | (declare (debug t)) | 5042 | (declare (debug t) (indent 1)) |
| 5018 | (let ((old-dir (make-symbol "old-dir")) | 5043 | (let ((old-dir (make-symbol "old-dir")) |
| 5019 | (buf (make-symbol "buf"))) | 5044 | (buf (make-symbol "buf"))) |
| 5020 | `(let* ((,old-dir default-directory) | 5045 | `(let* ((,old-dir default-directory) |
| @@ -6734,6 +6759,8 @@ effectively rounded up." | |||
| 6734 | (progress-reporter-update reporter (or current-value min-value)) | 6759 | (progress-reporter-update reporter (or current-value min-value)) |
| 6735 | reporter)) | 6760 | reporter)) |
| 6736 | 6761 | ||
| 6762 | (defalias 'progress-reporter-make #'make-progress-reporter) | ||
| 6763 | |||
| 6737 | (defun progress-reporter-force-update (reporter &optional value new-message suffix) | 6764 | (defun progress-reporter-force-update (reporter &optional value new-message suffix) |
| 6738 | "Report progress of an operation in the echo area unconditionally. | 6765 | "Report progress of an operation in the echo area unconditionally. |
| 6739 | 6766 | ||
diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index e0d252f17e0..b7b0920626e 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el | |||
| @@ -480,5 +480,49 @@ the UTF-8 coding system." | |||
| 480 | (concat locale-base locale-modifier))) | 480 | (concat locale-base locale-modifier))) |
| 481 | 481 | ||
| 482 | 482 | ||
| 483 | ;; Miscellaneous functions. | ||
| 484 | |||
| 485 | (declare-function android-browse-url-internal "androidselect.c") | ||
| 486 | |||
| 487 | (defun android-browse-url (url &optional send) | ||
| 488 | "Open URL in an external application. | ||
| 489 | |||
| 490 | URL should be a URL-encoded URL with a scheme specified unless | ||
| 491 | SEND is non-nil. Signal an error upon failure. | ||
| 492 | |||
| 493 | If SEND is nil, start a program that is able to display the URL, | ||
| 494 | such as a web browser. Otherwise, try to share URL using | ||
| 495 | programs such as email clients. | ||
| 496 | |||
| 497 | If URL is a file URI, convert it into a `content' address | ||
| 498 | accessible to other programs." | ||
| 499 | (when-let* ((uri (url-generic-parse-url url)) | ||
| 500 | (filename (url-filename uri)) | ||
| 501 | ;; If `uri' is a file URI and the file resides in /content | ||
| 502 | ;; or /assets, copy it to a temporary file before | ||
| 503 | ;; providing it to other programs. | ||
| 504 | (replacement-url (and (string-match-p | ||
| 505 | "/\\(content\\|assets\\)[/$]" | ||
| 506 | filename) | ||
| 507 | (prog1 t | ||
| 508 | (copy-file | ||
| 509 | filename | ||
| 510 | (setq filename | ||
| 511 | (make-temp-file | ||
| 512 | "local" | ||
| 513 | nil | ||
| 514 | (let ((extension | ||
| 515 | (file-name-extension | ||
| 516 | filename))) | ||
| 517 | (if extension | ||
| 518 | (concat "." | ||
| 519 | extension) | ||
| 520 | nil)))) | ||
| 521 | t)) | ||
| 522 | (concat "file://" filename)))) | ||
| 523 | (setq url replacement-url)) | ||
| 524 | (android-browse-url-internal url send)) | ||
| 525 | |||
| 526 | |||
| 483 | (provide 'android-win) | 527 | (provide 'android-win) |
| 484 | ;; android-win.el ends here. | 528 | ;; android-win.el ends here. |
diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 301f3e8791c..9af2aa6748f 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el | |||
| @@ -121,6 +121,17 @@ Return nil if there is no name or if NODE is not a defun node." | |||
| 121 | ;; Imenu. | 121 | ;; Imenu. |
| 122 | (setq-local treesit-simple-imenu-settings | 122 | (setq-local treesit-simple-imenu-settings |
| 123 | '(("Element" "\\`tag_name\\'" nil nil))) | 123 | '(("Element" "\\`tag_name\\'" nil nil))) |
| 124 | |||
| 125 | ;; Outline minor mode. | ||
| 126 | (setq-local treesit-outline-predicate "\\`element\\'") | ||
| 127 | ;; `html-ts-mode' inherits from `html-mode' that sets | ||
| 128 | ;; regexp-based outline variables. So need to restore | ||
| 129 | ;; the default values of outline variables to be able | ||
| 130 | ;; to use `treesit-outline-predicate' above. | ||
| 131 | (kill-local-variable 'outline-regexp) | ||
| 132 | (kill-local-variable 'outline-heading-end-regexp) | ||
| 133 | (kill-local-variable 'outline-level) | ||
| 134 | |||
| 124 | (treesit-major-mode-setup)) | 135 | (treesit-major-mode-setup)) |
| 125 | 136 | ||
| 126 | (if (treesit-ready-p 'html) | 137 | (if (treesit-ready-p 'html) |
diff --git a/lisp/textmodes/pixel-fill.el b/lisp/textmodes/pixel-fill.el index 25c0b46cee9..d26eaec2111 100644 --- a/lisp/textmodes/pixel-fill.el +++ b/lisp/textmodes/pixel-fill.el | |||
| @@ -73,39 +73,41 @@ lines that are visually wider than PIXEL-WIDTH. | |||
| 73 | If START isn't at the start of a line, the horizontal position of | 73 | If START isn't at the start of a line, the horizontal position of |
| 74 | START, converted to pixel units, will be used as the indentation | 74 | START, converted to pixel units, will be used as the indentation |
| 75 | prefix on subsequent lines." | 75 | prefix on subsequent lines." |
| 76 | (save-excursion | 76 | (save-window-excursion |
| 77 | (goto-char start) | 77 | (set-window-buffer nil (current-buffer)) |
| 78 | (let ((indentation | 78 | (save-excursion |
| 79 | (car (window-text-pixel-size nil (line-beginning-position) | 79 | (goto-char start) |
| 80 | (point)))) | 80 | (let ((indentation |
| 81 | (newline-end nil)) | 81 | (car (window-text-pixel-size nil (line-beginning-position) |
| 82 | (when (> indentation pixel-width) | 82 | (point)))) |
| 83 | (error "The indentation (%s) is wider than the fill width (%s)" | 83 | (newline-end nil)) |
| 84 | indentation pixel-width)) | 84 | (when (> indentation pixel-width) |
| 85 | (save-restriction | 85 | (error "The indentation (%s) is wider than the fill width (%s)" |
| 86 | (narrow-to-region start end) | 86 | indentation pixel-width)) |
| 87 | (goto-char (point-max)) | 87 | (save-restriction |
| 88 | (when (looking-back "\n[ \t]*" (point-min)) | 88 | (narrow-to-region start end) |
| 89 | (setq newline-end t)) | 89 | (goto-char (point-max)) |
| 90 | (goto-char (point-min)) | 90 | (when (looking-back "\n[ \t]*" (point-min)) |
| 91 | ;; First replace all whitespace with space. | 91 | (setq newline-end t)) |
| 92 | (while (re-search-forward "[ \t\n]+" nil t) | 92 | (goto-char (point-min)) |
| 93 | (cond | 93 | ;; First replace all whitespace with space. |
| 94 | ((or (= (match-beginning 0) start) | 94 | (while (re-search-forward "[ \t\n]+" nil t) |
| 95 | (= (match-end 0) end)) | 95 | (cond |
| 96 | (delete-region (match-beginning 0) (match-end 0))) | 96 | ((or (= (match-beginning 0) start) |
| 97 | ;; If there's just a single space here, don't replace. | 97 | (= (match-end 0) end)) |
| 98 | ((not (and (= (- (match-end 0) (match-beginning 0)) 1) | 98 | (delete-region (match-beginning 0) (match-end 0))) |
| 99 | (= (char-after (match-beginning 0)) ?\s))) | 99 | ;; If there's just a single space here, don't replace. |
| 100 | (replace-match | 100 | ((not (and (= (- (match-end 0) (match-beginning 0)) 1) |
| 101 | ;; We need to use a space that has an appropriate width. | 101 | (= (char-after (match-beginning 0)) ?\s))) |
| 102 | (propertize " " 'face | 102 | (replace-match |
| 103 | (get-text-property (match-beginning 0) 'face)))))) | 103 | ;; We need to use a space that has an appropriate width. |
| 104 | (goto-char start) | 104 | (propertize " " 'face |
| 105 | (pixel-fill--fill-line pixel-width indentation) | 105 | (get-text-property (match-beginning 0) 'face)))))) |
| 106 | (goto-char (point-max)) | 106 | (goto-char start) |
| 107 | (when newline-end | 107 | (pixel-fill--fill-line pixel-width indentation) |
| 108 | (insert "\n")))))) | 108 | (goto-char (point-max)) |
| 109 | (when newline-end | ||
| 110 | (insert "\n"))))))) | ||
| 109 | 111 | ||
| 110 | (defun pixel-fill--goto-pixel (width) | 112 | (defun pixel-fill--goto-pixel (width) |
| 111 | (vertical-motion (cons (/ width (frame-char-width)) 0))) | 113 | (vertical-motion (cons (/ width (frame-char-width)) 0))) |
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index a0bc5c11ece..791b10412c9 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el | |||
| @@ -235,11 +235,10 @@ distribution. Mixed-case symbols are convenience aliases.") | |||
| 235 | "ConTeXt bib module" | 235 | "ConTeXt bib module" |
| 236 | ((?\C-m . "\\cite[%l]") | 236 | ((?\C-m . "\\cite[%l]") |
| 237 | (?s . "\\cite[][%l]") | 237 | (?s . "\\cite[][%l]") |
| 238 | (?n . "\\nocite[%l]"))) | 238 | (?n . "\\nocite[%l]")))) |
| 239 | ) | ||
| 240 | "Builtin versions of the citation format. | 239 | "Builtin versions of the citation format. |
| 241 | The following conventions are valid for all alist entries: | 240 | The following conventions are valid for all alist entries: |
| 242 | `?\C-m' should always point to a straight \\cite{%l} macro. | 241 | `?\\C-m' should always point to a straight \\cite{%l} macro. |
| 243 | `?t' should point to a textual citation (citation as a noun). | 242 | `?t' should point to a textual citation (citation as a noun). |
| 244 | `?p' should point to a parenthetical citation.") | 243 | `?p' should point to a parenthetical citation.") |
| 245 | 244 | ||
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 2cd78943883..5fbff4ba888 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el | |||
| @@ -1147,14 +1147,14 @@ as well but give an additional message." | |||
| 1147 | (unless (fboundp forwarder-function) | 1147 | (unless (fboundp forwarder-function) |
| 1148 | (defalias forwarder-function | 1148 | (defalias forwarder-function |
| 1149 | (lambda () | 1149 | (lambda () |
| 1150 | (:documentation | ||
| 1151 | (format "Deprecated binding for %s, use \\[%s] instead." | ||
| 1152 | def def)) | ||
| 1150 | (interactive) | 1153 | (interactive) |
| 1151 | (call-interactively def) | 1154 | (call-interactively def) |
| 1152 | (message "[Deprecated use of key %s; use key %s instead]" | 1155 | (message "[Deprecated use of key %s; use key %s instead]" |
| 1153 | (key-description (this-command-keys)) | 1156 | (key-description (this-command-keys)) |
| 1154 | (key-description key))) | 1157 | (key-description key))))) |
| 1155 | ;; FIXME: In Emacs-25 we could use (:documentation ...) instead. | ||
| 1156 | (format "Deprecated binding for %s, use \\[%s] instead." | ||
| 1157 | def def))) | ||
| 1158 | (dolist (dep-key deprecated) | 1158 | (dolist (dep-key deprecated) |
| 1159 | (define-key keymap dep-key forwarder-function))))) | 1159 | (define-key keymap dep-key forwarder-function))))) |
| 1160 | 1160 | ||
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 8968d8ec23b..616b8871090 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el | |||
| @@ -511,17 +511,26 @@ An alternative value is \" . \", if you use a font with a narrow period." | |||
| 511 | ;; This would allow highlighting \newcommand\CMD but requires | 511 | ;; This would allow highlighting \newcommand\CMD but requires |
| 512 | ;; adapting subgroup numbers below. | 512 | ;; adapting subgroup numbers below. |
| 513 | ;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)")) | 513 | ;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)")) |
| 514 | (inbraces-re (lambda (re) | 514 | (inbraces-re |
| 515 | (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)"))) | 515 | (lambda (n) ;; Level of nesting of braces we should support. |
| 516 | (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)"))) | 516 | (let ((re "[^}]")) |
| 517 | `( ;; Highlight $$math$$ and $math$. | 517 | (dotimes (_ n) |
| 518 | (setq re | ||
| 519 | (concat "\\(?:[^{}\\]\\|\\\\.\\|{" re "*}\\)"))) | ||
| 520 | re))) | ||
| 521 | (arg (concat "{\\(" (funcall inbraces-re 2) "+\\)"))) | ||
| 522 | `(;; Verbatim-like args. | ||
| 523 | ;; Do it first, because we don't want to highlight them | ||
| 524 | ;; in comments (bug#68827), but we do want to highlight them | ||
| 525 | ;; in $math$. | ||
| 526 | (,(concat slash verbish opt arg) 3 'tex-verbatim keep) | ||
| 527 | ;; Highlight $$math$$ and $math$. | ||
| 518 | ;; This is done at the very beginning so as to interact with the other | 528 | ;; This is done at the very beginning so as to interact with the other |
| 519 | ;; keywords in the same way as comments and strings. | 529 | ;; keywords in the same way as comments and strings. |
| 520 | (,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{" | 530 | (,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{" |
| 521 | (funcall inbraces-re | 531 | (funcall inbraces-re 6) |
| 522 | (concat "{" (funcall inbraces-re "{[^}]*}") "*}")) | ||
| 523 | "*}\\)+\\$?\\$") | 532 | "*}\\)+\\$?\\$") |
| 524 | (0 'tex-math)) | 533 | (0 'tex-math keep)) |
| 525 | ;; Heading args. | 534 | ;; Heading args. |
| 526 | (,(concat slash headings "\\*?" opt arg) | 535 | (,(concat slash headings "\\*?" opt arg) |
| 527 | ;; If ARG ends up matching too much (if the {} don't match, e.g.) | 536 | ;; If ARG ends up matching too much (if the {} don't match, e.g.) |
| @@ -543,8 +552,6 @@ An alternative value is \" . \", if you use a font with a narrow period." | |||
| 543 | (,(concat slash variables " *" arg) 2 font-lock-variable-name-face) | 552 | (,(concat slash variables " *" arg) 2 font-lock-variable-name-face) |
| 544 | ;; Include args. | 553 | ;; Include args. |
| 545 | (,(concat slash includes opt arg) 3 font-lock-builtin-face) | 554 | (,(concat slash includes opt arg) 3 font-lock-builtin-face) |
| 546 | ;; Verbatim-like args. | ||
| 547 | (,(concat slash verbish opt arg) 3 'tex-verbatim t) | ||
| 548 | ;; Definitions. I think. | 555 | ;; Definitions. I think. |
| 549 | ("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)" | 556 | ("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)" |
| 550 | 1 font-lock-function-name-face)))) | 557 | 1 font-lock-function-name-face)))) |
| @@ -602,14 +609,14 @@ An alternative value is \" . \", if you use a font with a narrow period." | |||
| 602 | (list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t) | 609 | (list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t) |
| 603 | "\\(\\(.\\|\n\\)+?\\)" | 610 | "\\(\\(.\\|\n\\)+?\\)" |
| 604 | (regexp-opt `("''" "\">" "\"'" ">>" "»") t)) | 611 | (regexp-opt `("''" "\">" "\"'" ">>" "»") t)) |
| 605 | '(1 font-lock-keyword-face) | 612 | '(1 'font-lock-keyword-face) |
| 606 | '(2 font-lock-string-face) | 613 | '(2 'font-lock-string-face) |
| 607 | '(4 font-lock-keyword-face)) | 614 | '(4 'font-lock-keyword-face)) |
| 608 | ;; | 615 | ;; |
| 609 | ;; Command names, special and general. | 616 | ;; Command names, special and general. |
| 610 | (cons (concat slash specials-1) 'font-lock-warning-face) | 617 | (cons (concat slash specials-1) 'font-lock-warning-face) |
| 611 | (list (concat "\\(" slash specials-2 "\\)\\([^a-zA-Z@]\\|\\'\\)") | 618 | (list (concat "\\(" slash specials-2 "\\)\\([^a-zA-Z@]\\|\\'\\)") |
| 612 | 1 'font-lock-warning-face) | 619 | '(1 'font-lock-warning-face)) |
| 613 | (concat slash general) | 620 | (concat slash general) |
| 614 | ;; | 621 | ;; |
| 615 | ;; Font environments. It seems a bit dubious to use `bold' etc. faces | 622 | ;; Font environments. It seems a bit dubious to use `bold' etc. faces |
| @@ -677,7 +684,7 @@ An alternative value is \" . \", if you use a font with a narrow period." | |||
| 677 | (eval-when-compile | 684 | (eval-when-compile |
| 678 | (defconst tex-syntax-propertize-rules | 685 | (defconst tex-syntax-propertize-rules |
| 679 | (syntax-propertize-precompile-rules | 686 | (syntax-propertize-precompile-rules |
| 680 | ("\\\\verb\\**\\([^a-z@*]\\)" | 687 | ("\\\\verb\\**\\([^a-z@*]\\)" |
| 681 | (1 (prog1 "\"" | 688 | (1 (prog1 "\"" |
| 682 | (tex-font-lock-verb | 689 | (tex-font-lock-verb |
| 683 | (match-beginning 0) (char-after (match-beginning 1)))))))) | 690 | (match-beginning 0) (char-after (match-beginning 1)))))))) |
| @@ -761,7 +768,7 @@ automatically inserts its partner." | |||
| 761 | (regexp-quote (buffer-substring arg-start arg-end))) | 768 | (regexp-quote (buffer-substring arg-start arg-end))) |
| 762 | (text-clone-create arg-start arg-end)))))))) | 769 | (text-clone-create arg-start arg-end)))))))) |
| 763 | (scan-error nil) | 770 | (scan-error nil) |
| 764 | (error (message "Error in latex-env-before-change: %s" err))))) | 771 | (error (message "Error in latex-env-before-change: %S" err))))) |
| 765 | 772 | ||
| 766 | (defun tex-font-lock-unfontify-region (beg end) | 773 | (defun tex-font-lock-unfontify-region (beg end) |
| 767 | (font-lock-default-unfontify-region beg end) | 774 | (font-lock-default-unfontify-region beg end) |
| @@ -849,7 +856,7 @@ START is the position of the \\ and DELIM is the delimiter char." | |||
| 849 | (let ((char (nth 3 state))) | 856 | (let ((char (nth 3 state))) |
| 850 | (cond | 857 | (cond |
| 851 | ((not char) | 858 | ((not char) |
| 852 | (if (eq 2 (nth 7 state)) 'tex-verbatim font-lock-comment-face)) | 859 | (if (eq 2 (nth 7 state)) 'tex-verbatim 'font-lock-comment-face)) |
| 853 | ((eq char ?$) 'tex-math) | 860 | ((eq char ?$) 'tex-math) |
| 854 | ;; A \verb element. | 861 | ;; A \verb element. |
| 855 | (t 'tex-verbatim)))) | 862 | (t 'tex-verbatim)))) |
| @@ -1262,8 +1269,8 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook | |||
| 1262 | (setq-local facemenu-end-add-face "}") | 1269 | (setq-local facemenu-end-add-face "}") |
| 1263 | (setq-local facemenu-remove-face-function t) | 1270 | (setq-local facemenu-remove-face-function t) |
| 1264 | (setq-local font-lock-defaults | 1271 | (setq-local font-lock-defaults |
| 1265 | '((tex-font-lock-keywords tex-font-lock-keywords-1 | 1272 | '(( tex-font-lock-keywords tex-font-lock-keywords-1 |
| 1266 | tex-font-lock-keywords-2 tex-font-lock-keywords-3) | 1273 | tex-font-lock-keywords-2 tex-font-lock-keywords-3) |
| 1267 | nil nil nil nil | 1274 | nil nil nil nil |
| 1268 | ;; Who ever uses that anyway ??? | 1275 | ;; Who ever uses that anyway ??? |
| 1269 | (font-lock-mark-block-function . mark-paragraph) | 1276 | (font-lock-mark-block-function . mark-paragraph) |
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 87f6668cecb..e8e1f4898ce 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el | |||
| @@ -88,7 +88,7 @@ nor does it extend `completion-at-point-functions'. | |||
| 88 | This user option only takes effect when you customize it in | 88 | This user option only takes effect when you customize it in |
| 89 | Custom or with `setopt', not with `setq'." | 89 | Custom or with `setopt', not with `setq'." |
| 90 | :group 'text | 90 | :group 'text |
| 91 | :type 'boolean | 91 | :type '(choice (const completion-at-point) boolean) |
| 92 | :version "30.1" | 92 | :version "30.1" |
| 93 | :set (lambda (sym val) | 93 | :set (lambda (sym val) |
| 94 | (if (and (set sym val) | 94 | (if (and (set sym val) |
diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index c0185457bc2..a8cb504ef03 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el | |||
| @@ -128,7 +128,7 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." | |||
| 128 | (save-restriction | 128 | (save-restriction |
| 129 | (widen) | 129 | (widen) |
| 130 | (let ((node (treesit-node-at (point)))) | 130 | (let ((node (treesit-node-at (point)))) |
| 131 | (when (string= "block_scalar" (treesit-node-type node)) | 131 | (if (member (treesit-node-type node) '("block_scalar" "comment")) |
| 132 | (let* ((start (treesit-node-start node)) | 132 | (let* ((start (treesit-node-start node)) |
| 133 | (end (treesit-node-end node)) | 133 | (end (treesit-node-end node)) |
| 134 | (start-marker (point-marker)) | 134 | (start-marker (point-marker)) |
| @@ -138,7 +138,8 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." | |||
| 138 | (forward-line) | 138 | (forward-line) |
| 139 | (move-marker start-marker (point)) | 139 | (move-marker start-marker (point)) |
| 140 | (narrow-to-region (point) end)) | 140 | (narrow-to-region (point) end)) |
| 141 | (fill-region start-marker end justify)))))) | 141 | (fill-region start-marker end justify)) |
| 142 | t)))) | ||
| 142 | 143 | ||
| 143 | ;;;###autoload | 144 | ;;;###autoload |
| 144 | (define-derived-mode yaml-ts-mode text-mode "YAML" | 145 | (define-derived-mode yaml-ts-mode text-mode "YAML" |
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 323d3d1cf6c..83ddc640d35 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el | |||
| @@ -619,36 +619,20 @@ point. | |||
| 619 | 619 | ||
| 620 | Optional argument DISTANCE limits search for REGEXP forward and | 620 | Optional argument DISTANCE limits search for REGEXP forward and |
| 621 | back from point." | 621 | back from point." |
| 622 | (save-excursion | 622 | (let* ((old (point)) |
| 623 | (let ((old-point (point)) | 623 | (beg (if distance (max (point-min) (- old distance)) (point-min))) |
| 624 | (forward-bound (and distance (+ (point) distance))) | 624 | (end (if distance (min (point-max) (+ old distance)))) |
| 625 | (backward-bound (and distance (- (point) distance))) | 625 | prev match) |
| 626 | match prev-pos new-pos) | 626 | (save-excursion |
| 627 | (and (looking-at regexp) | 627 | (goto-char beg) |
| 628 | (>= (match-end 0) old-point) | 628 | (while (and (setq prev (point) |
| 629 | (setq match (point))) | 629 | match (re-search-forward regexp end t)) |
| 630 | ;; Search back repeatedly from end of next match. | 630 | (< (match-end 0) old)) |
| 631 | ;; This may fail if next match ends before this match does. | 631 | (goto-char (match-beginning 0)) |
| 632 | (re-search-forward regexp forward-bound 'limit) | 632 | ;; Avoid inflooping when `regexp' matches the empty string. |
| 633 | (setq prev-pos (point)) | 633 | (unless (< prev (point)) (forward-char)))) |
| 634 | (while (and (setq new-pos (re-search-backward regexp backward-bound t)) | 634 | (and match (<= (match-beginning 0) old (match-end 0))))) |
| 635 | ;; Avoid inflooping with some regexps, such as "^", | 635 | |
| 636 | ;; matching which never moves point. | ||
| 637 | (< new-pos prev-pos) | ||
| 638 | (or (> (match-beginning 0) old-point) | ||
| 639 | (and (looking-at regexp) ; Extend match-end past search start | ||
| 640 | (>= (match-end 0) old-point) | ||
| 641 | (setq match (point)))))) | ||
| 642 | (if (not match) nil | ||
| 643 | (goto-char match) | ||
| 644 | ;; Back up a char at a time in case search skipped | ||
| 645 | ;; intermediate match straddling search start pos. | ||
| 646 | (while (and (not (bobp)) | ||
| 647 | (progn (backward-char 1) (looking-at regexp)) | ||
| 648 | (>= (match-end 0) old-point) | ||
| 649 | (setq match (point)))) | ||
| 650 | (goto-char match) | ||
| 651 | (looking-at regexp))))) | ||
| 652 | 636 | ||
| 653 | ;; Email addresses | 637 | ;; Email addresses |
| 654 | (defvar thing-at-point-email-regexp | 638 | (defvar thing-at-point-email-regexp |
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index a1ec4bca89f..c8de1d8ee31 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el | |||
| @@ -87,7 +87,7 @@ is being called from `read-sequence' or some similar function.") | |||
| 87 | (defgroup touch-screen nil | 87 | (defgroup touch-screen nil |
| 88 | "Interact with Emacs from touch screen devices." | 88 | "Interact with Emacs from touch screen devices." |
| 89 | :group 'mouse | 89 | :group 'mouse |
| 90 | :version "30.0") | 90 | :version "30.1") |
| 91 | 91 | ||
| 92 | (defcustom touch-screen-display-keyboard nil | 92 | (defcustom touch-screen-display-keyboard nil |
| 93 | "If non-nil, always display the on screen keyboard. | 93 | "If non-nil, always display the on screen keyboard. |
diff --git a/lisp/transient.el b/lisp/transient.el index f9060f5ba85..bb35746e186 100644 --- a/lisp/transient.el +++ b/lisp/transient.el | |||
| @@ -855,7 +855,6 @@ elements themselves.") | |||
| 855 | 855 | ||
| 856 | ;;; Define | 856 | ;;; Define |
| 857 | 857 | ||
| 858 | ;;;###autoload | ||
| 859 | (defmacro transient-define-prefix (name arglist &rest args) | 858 | (defmacro transient-define-prefix (name arglist &rest args) |
| 860 | "Define NAME as a transient prefix command. | 859 | "Define NAME as a transient prefix command. |
| 861 | 860 | ||
diff --git a/lisp/treesit.el b/lisp/treesit.el index 96222ed81cb..fa82ad898a9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el | |||
| @@ -344,14 +344,13 @@ ancestor node which satisfies the predicate PRED; then it | |||
| 344 | returns that ancestor node. It returns nil if no ancestor | 344 | returns that ancestor node. It returns nil if no ancestor |
| 345 | node was found that satisfies PRED. | 345 | node was found that satisfies PRED. |
| 346 | 346 | ||
| 347 | PRED should be a function that takes one argument, the node to | 347 | PRED can be a predicate function, a regexp matching node type, |
| 348 | examine, and returns a boolean value indicating whether that | 348 | and more; see docstring of `treesit-thing-settings'. |
| 349 | node is a match. | ||
| 350 | 349 | ||
| 351 | If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." | 350 | If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." |
| 352 | (let ((node (if include-node node | 351 | (let ((node (if include-node node |
| 353 | (treesit-node-parent node)))) | 352 | (treesit-node-parent node)))) |
| 354 | (while (and node (not (funcall pred node))) | 353 | (while (and node (not (treesit-node-match-p node pred))) |
| 355 | (setq node (treesit-node-parent node))) | 354 | (setq node (treesit-node-parent node))) |
| 356 | node)) | 355 | node)) |
| 357 | 356 | ||
| @@ -364,11 +363,10 @@ no longer satisfies the predicate PRED; it returns the last | |||
| 364 | examined node that satisfies PRED. If no node satisfies PRED, it | 363 | examined node that satisfies PRED. If no node satisfies PRED, it |
| 365 | returns nil. | 364 | returns nil. |
| 366 | 365 | ||
| 367 | PRED should be a function that takes one argument, the node to | 366 | PRED can be a predicate function, a regexp matching node type, |
| 368 | examine, and returns a boolean value indicating whether that | 367 | and more; see docstring of `treesit-thing-settings'." |
| 369 | node is a match." | ||
| 370 | (let ((last nil)) | 368 | (let ((last nil)) |
| 371 | (while (and node (funcall pred node)) | 369 | (while (and node (treesit-node-match-p node pred)) |
| 372 | (setq last node | 370 | (setq last node |
| 373 | node (treesit-node-parent node))) | 371 | node (treesit-node-parent node))) |
| 374 | last)) | 372 | last)) |
| @@ -655,37 +653,47 @@ those inside are kept." | |||
| 655 | if (<= start (car range) (cdr range) end) | 653 | if (<= start (car range) (cdr range) end) |
| 656 | collect range)) | 654 | collect range)) |
| 657 | 655 | ||
| 658 | (defun treesit-local-parsers-at (&optional pos language) | 656 | (defun treesit-local-parsers-at (&optional pos language with-host) |
| 659 | "Return all the local parsers at POS. | 657 | "Return all the local parsers at POS. |
| 660 | 658 | ||
| 661 | POS defaults to point. | 659 | POS defaults to point. |
| 662 | Local parsers are those which only parse a limited region marked | 660 | Local parsers are those which only parse a limited region marked |
| 663 | by an overlay with non-nil `treesit-parser' property. | 661 | by an overlay with non-nil `treesit-parser' property. |
| 664 | If LANGUAGE is non-nil, only return parsers for LANGUAGE." | 662 | If LANGUAGE is non-nil, only return parsers for LANGUAGE. |
| 663 | |||
| 664 | If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER) | ||
| 665 | instead. HOST-PARSER is the host parser which created the local | ||
| 666 | PARSER." | ||
| 665 | (let ((res nil)) | 667 | (let ((res nil)) |
| 666 | (dolist (ov (overlays-at (or pos (point)))) | 668 | (dolist (ov (overlays-at (or pos (point)))) |
| 667 | (when-let ((parser (overlay-get ov 'treesit-parser))) | 669 | (when-let ((parser (overlay-get ov 'treesit-parser)) |
| 670 | (host-parser (overlay-get ov 'treesit-host-parser))) | ||
| 668 | (when (or (null language) | 671 | (when (or (null language) |
| 669 | (eq (treesit-parser-language parser) | 672 | (eq (treesit-parser-language parser) |
| 670 | language)) | 673 | language)) |
| 671 | (push parser res)))) | 674 | (push (if with-host (cons parser host-parser) parser) res)))) |
| 672 | (nreverse res))) | 675 | (nreverse res))) |
| 673 | 676 | ||
| 674 | (defun treesit-local-parsers-on (&optional beg end language) | 677 | (defun treesit-local-parsers-on (&optional beg end language with-host) |
| 675 | "Return all the local parsers between BEG END. | 678 | "Return all the local parsers between BEG END. |
| 676 | 679 | ||
| 677 | BEG and END default to the beginning and end of the buffer's | 680 | BEG and END default to the beginning and end of the buffer's |
| 678 | accessible portion. | 681 | accessible portion. |
| 679 | Local parsers are those which have an `embedded' tag, and only parse | 682 | Local parsers are those which have an `embedded' tag, and only parse |
| 680 | a limited region marked by an overlay with a non-nil `treesit-parser' | 683 | a limited region marked by an overlay with a non-nil `treesit-parser' |
| 681 | property. If LANGUAGE is non-nil, only return parsers for LANGUAGE." | 684 | property. If LANGUAGE is non-nil, only return parsers for LANGUAGE. |
| 685 | |||
| 686 | If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER) | ||
| 687 | instead. HOST-PARSER is the host parser which created the local | ||
| 688 | PARSER." | ||
| 682 | (let ((res nil)) | 689 | (let ((res nil)) |
| 683 | (dolist (ov (overlays-in (or beg (point-min)) (or end (point-max)))) | 690 | (dolist (ov (overlays-in (or beg (point-min)) (or end (point-max)))) |
| 684 | (when-let ((parser (overlay-get ov 'treesit-parser))) | 691 | (when-let ((parser (overlay-get ov 'treesit-parser)) |
| 692 | (host-parser (overlay-get ov 'treesit-host-parser))) | ||
| 685 | (when (or (null language) | 693 | (when (or (null language) |
| 686 | (eq (treesit-parser-language parser) | 694 | (eq (treesit-parser-language parser) |
| 687 | language)) | 695 | language)) |
| 688 | (push parser res)))) | 696 | (push (if with-host (cons parser host-parser) parser) res)))) |
| 689 | (nreverse res))) | 697 | (nreverse res))) |
| 690 | 698 | ||
| 691 | (defun treesit--update-ranges-local | 699 | (defun treesit--update-ranges-local |
| @@ -701,7 +709,8 @@ parser for EMBEDDED-LANG." | |||
| 701 | (treesit-parser-delete parser)))) | 709 | (treesit-parser-delete parser)))) |
| 702 | ;; Update range. | 710 | ;; Update range. |
| 703 | (let* ((host-lang (treesit-query-language query)) | 711 | (let* ((host-lang (treesit-query-language query)) |
| 704 | (ranges (treesit-query-range host-lang query beg end))) | 712 | (host-parser (treesit-parser-create host-lang)) |
| 713 | (ranges (treesit-query-range host-parser query beg end))) | ||
| 705 | (pcase-dolist (`(,beg . ,end) ranges) | 714 | (pcase-dolist (`(,beg . ,end) ranges) |
| 706 | (let ((has-parser nil)) | 715 | (let ((has-parser nil)) |
| 707 | (dolist (ov (overlays-in beg end)) | 716 | (dolist (ov (overlays-in beg end)) |
| @@ -719,6 +728,7 @@ parser for EMBEDDED-LANG." | |||
| 719 | embedded-lang nil t 'embedded)) | 728 | embedded-lang nil t 'embedded)) |
| 720 | (ov (make-overlay beg end nil nil t))) | 729 | (ov (make-overlay beg end nil nil t))) |
| 721 | (overlay-put ov 'treesit-parser embedded-parser) | 730 | (overlay-put ov 'treesit-parser embedded-parser) |
| 731 | (overlay-put ov 'treesit-host-parser host-parser) | ||
| 722 | (treesit-parser-set-included-ranges | 732 | (treesit-parser-set-included-ranges |
| 723 | embedded-parser `((,beg . ,end))))))))) | 733 | embedded-parser `((,beg . ,end))))))))) |
| 724 | 734 | ||
| @@ -1372,7 +1382,15 @@ as comment due to incomplete parse tree." | |||
| 1372 | ;; `treesit-update-ranges' will force the host language's parser to | 1382 | ;; `treesit-update-ranges' will force the host language's parser to |
| 1373 | ;; reparse and set correct ranges for embedded parsers. Then | 1383 | ;; reparse and set correct ranges for embedded parsers. Then |
| 1374 | ;; `treesit-parser-root-node' will force those parsers to reparse. | 1384 | ;; `treesit-parser-root-node' will force those parsers to reparse. |
| 1375 | (treesit-update-ranges) | 1385 | (let ((len (+ (* (window-body-height) (window-body-width)) 800))) |
| 1386 | ;; FIXME: As a temporary fix, this prevents Emacs from updating | ||
| 1387 | ;; every single local parsers in the buffer every time there's an | ||
| 1388 | ;; edit. Moving forward, we need some way to properly track the | ||
| 1389 | ;; regions which need update on parser ranges, like what jit-lock | ||
| 1390 | ;; and syntax-ppss does. | ||
| 1391 | (treesit-update-ranges | ||
| 1392 | (max (point-min) (- (point) len)) | ||
| 1393 | (min (point-max) (+ (point) len)))) | ||
| 1376 | ;; Force repase on _all_ the parsers might not be necessary, but | 1394 | ;; Force repase on _all_ the parsers might not be necessary, but |
| 1377 | ;; this is probably the most robust way. | 1395 | ;; this is probably the most robust way. |
| 1378 | (dolist (parser (treesit-parser-list)) | 1396 | (dolist (parser (treesit-parser-list)) |
| @@ -1800,11 +1818,17 @@ Return (ANCHOR . OFFSET). This function is used by | |||
| 1800 | (forward-line 0) | 1818 | (forward-line 0) |
| 1801 | (skip-chars-forward " \t") | 1819 | (skip-chars-forward " \t") |
| 1802 | (point))) | 1820 | (point))) |
| 1803 | (local-parsers (treesit-local-parsers-at bol)) | 1821 | (local-parsers (treesit-local-parsers-at bol nil t)) |
| 1804 | (smallest-node | 1822 | (smallest-node |
| 1805 | (cond ((null (treesit-parser-list)) nil) | 1823 | (cond ((car local-parsers) |
| 1806 | (local-parsers (treesit-node-at | 1824 | (let ((local-parser (caar local-parsers)) |
| 1807 | bol (car local-parsers))) | 1825 | (host-parser (cdar local-parsers))) |
| 1826 | (if (eq (treesit-node-start | ||
| 1827 | (treesit-parser-root-node local-parser)) | ||
| 1828 | bol) | ||
| 1829 | (treesit-node-at bol host-parser) | ||
| 1830 | (treesit-node-at bol local-parser)))) | ||
| 1831 | ((null (treesit-parser-list)) nil) | ||
| 1808 | ((eq 1 (length (treesit-parser-list nil nil t))) | 1832 | ((eq 1 (length (treesit-parser-list nil nil t))) |
| 1809 | (treesit-node-at bol)) | 1833 | (treesit-node-at bol)) |
| 1810 | ((treesit-language-at bol) | 1834 | ((treesit-language-at bol) |
| @@ -2644,9 +2668,17 @@ function is called recursively." | |||
| 2644 | (setq parent (treesit-node-top-level parent thing t) | 2668 | (setq parent (treesit-node-top-level parent thing t) |
| 2645 | prev nil | 2669 | prev nil |
| 2646 | next nil)) | 2670 | next nil)) |
| 2647 | ;; If TACTIC is `restricted', the implementation is very simple. | 2671 | ;; If TACTIC is `restricted', the implementation is simple. |
| 2672 | ;; In principle we don't go to parent's beg/end for | ||
| 2673 | ;; `restricted' tactic, but if the parent is a "leaf thing" | ||
| 2674 | ;; (doesn't have any child "thing" inside it), then we can | ||
| 2675 | ;; move to the beg/end of it (bug#68899). | ||
| 2648 | (if (eq tactic 'restricted) | 2676 | (if (eq tactic 'restricted) |
| 2649 | (setq pos (funcall advance (if (> arg 0) next prev))) | 2677 | (setq pos (funcall |
| 2678 | advance | ||
| 2679 | (cond ((and (null next) (null prev)) parent) | ||
| 2680 | ((> arg 0) next) | ||
| 2681 | (t prev)))) | ||
| 2650 | ;; For `nested', it's a bit more work: | 2682 | ;; For `nested', it's a bit more work: |
| 2651 | ;; Move... | 2683 | ;; Move... |
| 2652 | (if (> arg 0) | 2684 | (if (> arg 0) |
| @@ -2836,6 +2868,71 @@ ENTRY. MARKER marks the start of each tree-sitter node." | |||
| 2836 | index)))) | 2868 | index)))) |
| 2837 | treesit-simple-imenu-settings))) | 2869 | treesit-simple-imenu-settings))) |
| 2838 | 2870 | ||
| 2871 | ;;; Outline minor mode | ||
| 2872 | |||
| 2873 | (defvar-local treesit-outline-predicate nil | ||
| 2874 | "Predicate used to find outline headings in the syntax tree. | ||
| 2875 | The predicate can be a function, a regexp matching node type, | ||
| 2876 | and more; see docstring of `treesit-thing-settings'. | ||
| 2877 | It matches the nodes located on lines with outline headings. | ||
| 2878 | Intended to be set by a major mode. When nil, the predicate | ||
| 2879 | is constructed from the value of `treesit-simple-imenu-settings' | ||
| 2880 | when a major mode sets it.") | ||
| 2881 | |||
| 2882 | (defun treesit-outline-predicate--from-imenu (node) | ||
| 2883 | ;; Return an outline searching predicate created from Imenu. | ||
| 2884 | ;; Return the value suitable to set `treesit-outline-predicate'. | ||
| 2885 | ;; Create this predicate from the value `treesit-simple-imenu-settings' | ||
| 2886 | ;; that major modes set to find Imenu entries. The assumption here | ||
| 2887 | ;; is that the positions of Imenu entries most of the time coincide | ||
| 2888 | ;; with the lines of outline headings. When this assumption fails, | ||
| 2889 | ;; you can directly set a proper value to `treesit-outline-predicate'. | ||
| 2890 | (seq-some | ||
| 2891 | (lambda (setting) | ||
| 2892 | (and (string-match-p (nth 1 setting) (treesit-node-type node)) | ||
| 2893 | (or (null (nth 2 setting)) | ||
| 2894 | (funcall (nth 2 setting) node)))) | ||
| 2895 | treesit-simple-imenu-settings)) | ||
| 2896 | |||
| 2897 | (defun treesit-outline-search (&optional bound move backward looking-at) | ||
| 2898 | "Search for the next outline heading in the syntax tree. | ||
| 2899 | See the descriptions of arguments in `outline-search-function'." | ||
| 2900 | (if looking-at | ||
| 2901 | (when-let* ((node (or (treesit--thing-at (pos-eol) treesit-outline-predicate) | ||
| 2902 | (treesit--thing-at (pos-bol) treesit-outline-predicate))) | ||
| 2903 | (start (treesit-node-start node))) | ||
| 2904 | (eq (pos-bol) (save-excursion (goto-char start) (pos-bol)))) | ||
| 2905 | |||
| 2906 | (let* ((pos | ||
| 2907 | ;; When function wants to find the current outline, point | ||
| 2908 | ;; is at the beginning of the current line. When it wants | ||
| 2909 | ;; to find the next outline, point is at the second column. | ||
| 2910 | (if (eq (point) (pos-bol)) | ||
| 2911 | (if (bobp) (point) (1- (point))) | ||
| 2912 | (pos-eol))) | ||
| 2913 | (found (treesit--navigate-thing pos (if backward -1 1) 'beg | ||
| 2914 | treesit-outline-predicate))) | ||
| 2915 | (if found | ||
| 2916 | (if (or (not bound) (if backward (>= found bound) (<= found bound))) | ||
| 2917 | (progn | ||
| 2918 | (goto-char found) | ||
| 2919 | (goto-char (pos-bol)) | ||
| 2920 | (set-match-data (list (point) (pos-eol))) | ||
| 2921 | t) | ||
| 2922 | (when move (goto-char bound)) | ||
| 2923 | nil) | ||
| 2924 | (when move (goto-char (or bound (if backward (point-min) (point-max))))) | ||
| 2925 | nil)))) | ||
| 2926 | |||
| 2927 | (defun treesit-outline-level () | ||
| 2928 | "Return the depth of the current outline heading." | ||
| 2929 | (let* ((node (treesit-node-at (point) nil t)) | ||
| 2930 | (level (if (treesit-node-match-p node treesit-outline-predicate) | ||
| 2931 | 1 0))) | ||
| 2932 | (while (setq node (treesit-parent-until node treesit-outline-predicate)) | ||
| 2933 | (setq level (1+ level))) | ||
| 2934 | (if (zerop level) 1 level))) | ||
| 2935 | |||
| 2839 | ;;; Activating tree-sitter | 2936 | ;;; Activating tree-sitter |
| 2840 | 2937 | ||
| 2841 | (defun treesit-ready-p (language &optional quiet) | 2938 | (defun treesit-ready-p (language &optional quiet) |
| @@ -2966,6 +3063,17 @@ before calling this function." | |||
| 2966 | (setq-local imenu-create-index-function | 3063 | (setq-local imenu-create-index-function |
| 2967 | #'treesit-simple-imenu)) | 3064 | #'treesit-simple-imenu)) |
| 2968 | 3065 | ||
| 3066 | ;; Outline minor mode. | ||
| 3067 | (when (and (or treesit-outline-predicate treesit-simple-imenu-settings) | ||
| 3068 | (not (seq-some #'local-variable-p | ||
| 3069 | '(outline-search-function | ||
| 3070 | outline-regexp outline-level)))) | ||
| 3071 | (unless treesit-outline-predicate | ||
| 3072 | (setq treesit-outline-predicate | ||
| 3073 | #'treesit-outline-predicate--from-imenu)) | ||
| 3074 | (setq-local outline-search-function #'treesit-outline-search | ||
| 3075 | outline-level #'treesit-outline-level)) | ||
| 3076 | |||
| 2969 | ;; Remove existing local parsers. | 3077 | ;; Remove existing local parsers. |
| 2970 | (dolist (ov (overlays-in (point-min) (point-max))) | 3078 | (dolist (ov (overlays-in (point-min) (point-max))) |
| 2971 | (when-let ((parser (overlay-get ov 'treesit-parser))) | 3079 | (when-let ((parser (overlay-get ov 'treesit-parser))) |
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el index 17a0318e652..d80037f8fe9 100644 --- a/lisp/url/url-cid.el +++ b/lisp/url/url-cid.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; url-cid.el --- Content-ID URL loader -*- lexical-binding: t; -*- | 1 | ;;; url-cid.el --- Content-ID URL loader -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1998-2024 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Keywords: comm, data, processes | 5 | ;; Keywords: comm, data, processes |
| 6 | 6 | ||
| @@ -52,12 +52,7 @@ | |||
| 52 | 52 | ||
| 53 | ;;;###autoload | 53 | ;;;###autoload |
| 54 | (defun url-cid (url) | 54 | (defun url-cid (url) |
| 55 | (cond | 55 | (with-current-buffer (generate-new-buffer " *url-cid*") |
| 56 | ((fboundp 'mm-get-content-id) | 56 | (url-cid-gnus (url-filename url)))) |
| 57 | ;; Using Pterodactyl Gnus or later | ||
| 58 | (with-current-buffer (generate-new-buffer " *url-cid*") | ||
| 59 | (url-cid-gnus (url-filename url)))) | ||
| 60 | (t | ||
| 61 | (message "Unable to handle CID URL: %s" url)))) | ||
| 62 | 57 | ||
| 63 | ;;; url-cid.el ends here | 58 | ;;; url-cid.el ends here |
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index d6a1d0eade8..184c1278072 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el | |||
| @@ -427,7 +427,7 @@ Use `url-http-referer' as the Referer-header (subject to `url-privacy-level')." | |||
| 427 | 427 | ||
| 428 | ;; Parsing routines | 428 | ;; Parsing routines |
| 429 | (defun url-http-clean-headers () | 429 | (defun url-http-clean-headers () |
| 430 | "Remove trailing \r from header lines. | 430 | "Remove trailing \\r from header lines. |
| 431 | This allows us to use `mail-fetch-field', etc. | 431 | This allows us to use `mail-fetch-field', etc. |
| 432 | Return the number of characters removed." | 432 | Return the number of characters removed." |
| 433 | (let ((end (marker-position url-http-end-of-headers))) | 433 | (let ((end (marker-position url-http-end-of-headers))) |
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el index 1bdd5099637..6aaea606c27 100644 --- a/lisp/url/url-ldap.el +++ b/lisp/url/url-ldap.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -*- lexical-binding: t; -*- | 1 | ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1998-2024 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Keywords: comm, data, processes | 5 | ;; Keywords: comm, data, processes |
| 6 | 6 | ||
| @@ -92,12 +92,8 @@ | |||
| 92 | "'>" dn "</a>")) | 92 | "'>" dn "</a>")) |
| 93 | 93 | ||
| 94 | (defun url-ldap-certificate-formatter (data) | 94 | (defun url-ldap-certificate-formatter (data) |
| 95 | (condition-case () | 95 | ;; FIXME: tls.el is obsolete. |
| 96 | (require 'ssl) | 96 | (let ((vals (tls-certificate-information data))) |
| 97 | (error nil)) | ||
| 98 | (let ((vals (if (fboundp 'ssl-certificate-information) | ||
| 99 | (ssl-certificate-information data) | ||
| 100 | (tls-certificate-information data)))) | ||
| 101 | (if (not vals) | 97 | (if (not vals) |
| 102 | "<b>Unable to parse certificate</b>" | 98 | "<b>Unable to parse certificate</b>" |
| 103 | (concat "<table border=0>\n" | 99 | (concat "<table border=0>\n" |
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el index c2d347a1646..50293ab3f05 100644 --- a/lisp/url/url-mailto.el +++ b/lisp/url/url-mailto.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; url-mailto.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*- | 1 | ;;; url-mailto.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1996-1999, 2004-2024 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1996-2024 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Keywords: comm, data, processes | 5 | ;; Keywords: comm, data, processes |
| 6 | 6 | ||
| @@ -28,12 +28,7 @@ | |||
| 28 | (require 'url-util) | 28 | (require 'url-util) |
| 29 | 29 | ||
| 30 | ;;;###autoload | 30 | ;;;###autoload |
| 31 | (defun url-mail (&rest args) | 31 | (defalias 'url-mail #'message-mail) |
| 32 | (interactive "P") | ||
| 33 | (if (fboundp 'message-mail) | ||
| 34 | (apply 'message-mail args) | ||
| 35 | (or (apply 'mail args) | ||
| 36 | (error "Mail aborted")))) | ||
| 37 | 32 | ||
| 38 | (defun url-mail-goto-field (field) | 33 | (defun url-mail-goto-field (field) |
| 39 | (if (not field) | 34 | (if (not field) |
| @@ -57,8 +52,6 @@ | |||
| 57 | (save-excursion | 52 | (save-excursion |
| 58 | (insert "\n")))))) | 53 | (insert "\n")))))) |
| 59 | 54 | ||
| 60 | (declare-function mail-send-and-exit "sendmail") | ||
| 61 | |||
| 62 | ;;;###autoload | 55 | ;;;###autoload |
| 63 | (defun url-mailto (url) | 56 | (defun url-mailto (url) |
| 64 | "Handle the mailto: URL syntax." | 57 | "Handle the mailto: URL syntax." |
| @@ -111,8 +104,6 @@ | |||
| 111 | ;; (setq func (intern-soft (concat "mail-" (caar args)))) | 104 | ;; (setq func (intern-soft (concat "mail-" (caar args)))) |
| 112 | (insert (mapconcat 'identity (cdar args) ", "))) | 105 | (insert (mapconcat 'identity (cdar args) ", "))) |
| 113 | (setq args (cdr args))) | 106 | (setq args (cdr args))) |
| 114 | ;; (url-mail-goto-field "User-Agent") | ||
| 115 | ;; (insert url-package-name "/" url-package-version " URL/" url-version) | ||
| 116 | (if (not url-request-data) | 107 | (if (not url-request-data) |
| 117 | (progn | 108 | (progn |
| 118 | (set-buffer-modified-p nil) | 109 | (set-buffer-modified-p nil) |
| @@ -128,8 +119,8 @@ | |||
| 128 | (goto-char (point-max)) | 119 | (goto-char (point-max)) |
| 129 | (insert url-request-data) | 120 | (insert url-request-data) |
| 130 | ;; It seems Microsoft-ish to send without warning. | 121 | ;; It seems Microsoft-ish to send without warning. |
| 131 | ;; Fixme: presumably this should depend on a privacy setting. | 122 | ;; FIXME: presumably this should depend on a privacy setting. |
| 132 | (if (y-or-n-p "Send this auto-generated mail? ") | 123 | (if (y-or-n-p "Send this auto-generated mail?") |
| 133 | (let ((buffer (current-buffer))) | 124 | (let ((buffer (current-buffer))) |
| 134 | (cond ((eq url-mail-command 'compose-mail) | 125 | (cond ((eq url-mail-command 'compose-mail) |
| 135 | (funcall (get mail-user-agent 'sendfunc) nil)) | 126 | (funcall (get mail-user-agent 'sendfunc) nil)) |
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 83d580d98dd..99ac50c155a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el | |||
| @@ -517,8 +517,8 @@ use the face `diff-removed' for removed lines, and the face | |||
| 517 | ("^Only in .*\n" . 'diff-nonexistent) | 517 | ("^Only in .*\n" . 'diff-nonexistent) |
| 518 | ("^Binary files .* differ\n" . 'diff-file-header) | 518 | ("^Binary files .* differ\n" . 'diff-file-header) |
| 519 | ("^\\(#\\)\\(.*\\)" | 519 | ("^\\(#\\)\\(.*\\)" |
| 520 | (1 font-lock-comment-delimiter-face) | 520 | (1 'font-lock-comment-delimiter-face) |
| 521 | (2 font-lock-comment-face)) | 521 | (2 'font-lock-comment-face)) |
| 522 | ("^diff: .*" (0 'diff-error)) | 522 | ("^diff: .*" (0 'diff-error)) |
| 523 | ("^[^-=+*!<>#].*\n" (0 'diff-context)) | 523 | ("^[^-=+*!<>#].*\n" (0 'diff-context)) |
| 524 | (,#'diff--font-lock-syntax) | 524 | (,#'diff--font-lock-syntax) |
| @@ -944,7 +944,8 @@ like \(diff-merge-strings \"b/foo\" \"b/bar\" \"/a/c/foo\")." | |||
| 944 | (when (and (string-match (concat | 944 | (when (and (string-match (concat |
| 945 | "\\`\\(.*?\\)\\(.*\\)\\(.*\\)\n" | 945 | "\\`\\(.*?\\)\\(.*\\)\\(.*\\)\n" |
| 946 | "\\1\\(.*\\)\\3\n" | 946 | "\\1\\(.*\\)\\3\n" |
| 947 | "\\(.*\\(\\2\\).*\\)\\'") str) | 947 | "\\(.*\\(\\2\\).*\\)\\'") |
| 948 | str) | ||
| 948 | (equal to (match-string 5 str))) | 949 | (equal to (match-string 5 str))) |
| 949 | (concat (substring str (match-beginning 5) (match-beginning 6)) | 950 | (concat (substring str (match-beginning 5) (match-beginning 6)) |
| 950 | (match-string 4 str) | 951 | (match-string 4 str) |
| @@ -1999,7 +2000,7 @@ With a prefix argument, REVERSE the hunk." | |||
| 1999 | (diff-find-source-location nil reverse))) | 2000 | (diff-find-source-location nil reverse))) |
| 2000 | (cond | 2001 | (cond |
| 2001 | ((null line-offset) | 2002 | ((null line-offset) |
| 2002 | (error "Can't find the text to patch")) | 2003 | (user-error "Can't find the text to patch")) |
| 2003 | ((with-current-buffer buf | 2004 | ((with-current-buffer buf |
| 2004 | (and buffer-file-name | 2005 | (and buffer-file-name |
| 2005 | (backup-file-name-p buffer-file-name) | 2006 | (backup-file-name-p buffer-file-name) |
| @@ -2008,7 +2009,7 @@ With a prefix argument, REVERSE the hunk." | |||
| 2008 | (yes-or-no-p (format "Really apply this hunk to %s? " | 2009 | (yes-or-no-p (format "Really apply this hunk to %s? " |
| 2009 | (file-name-nondirectory | 2010 | (file-name-nondirectory |
| 2010 | buffer-file-name))))))) | 2011 | buffer-file-name))))))) |
| 2011 | (error "%s" | 2012 | (user-error "%s" |
| 2012 | (substitute-command-keys | 2013 | (substitute-command-keys |
| 2013 | (format "Use %s\\[diff-apply-hunk] to apply it to the other file" | 2014 | (format "Use %s\\[diff-apply-hunk] to apply it to the other file" |
| 2014 | (if (not reverse) "\\[universal-argument] "))))) | 2015 | (if (not reverse) "\\[universal-argument] "))))) |
| @@ -2275,6 +2276,24 @@ Return new point, if it was moved." | |||
| 2275 | (end (progn (diff-end-of-hunk) (point)))) | 2276 | (end (progn (diff-end-of-hunk) (point)))) |
| 2276 | (diff--refine-hunk beg end))))) | 2277 | (diff--refine-hunk beg end))))) |
| 2277 | 2278 | ||
| 2279 | (defun diff--refine-propertize (beg end face) | ||
| 2280 | (let ((ol (make-overlay beg end))) | ||
| 2281 | (overlay-put ol 'diff-mode 'fine) | ||
| 2282 | (overlay-put ol 'evaporate t) | ||
| 2283 | (overlay-put ol 'face face))) | ||
| 2284 | |||
| 2285 | (defcustom diff-refine-nonmodified nil | ||
| 2286 | "If non-nil, also highlight the added/removed lines as \"refined\". | ||
| 2287 | The lines highlighted when this is non-nil are those that were | ||
| 2288 | added or removed in their entirety, as opposed to lines some | ||
| 2289 | parts of which were modified. The added lines are highlighted | ||
| 2290 | using the `diff-refine-added' face, while the removed lines are | ||
| 2291 | highlighted using the `diff-refine-removed' face. | ||
| 2292 | This is currently implemented only for diff formats supported | ||
| 2293 | by `diff-refine-hunk'." | ||
| 2294 | :version "30.1" | ||
| 2295 | :type 'boolean) | ||
| 2296 | |||
| 2278 | (defun diff--refine-hunk (start end) | 2297 | (defun diff--refine-hunk (start end) |
| 2279 | (require 'smerge-mode) | 2298 | (require 'smerge-mode) |
| 2280 | (goto-char start) | 2299 | (goto-char start) |
| @@ -2289,41 +2308,68 @@ Return new point, if it was moved." | |||
| 2289 | (goto-char beg) | 2308 | (goto-char beg) |
| 2290 | (pcase style | 2309 | (pcase style |
| 2291 | ('unified | 2310 | ('unified |
| 2292 | (while (re-search-forward "^-" end t) | 2311 | (while (re-search-forward "^[-+]" end t) |
| 2293 | (let ((beg-del (progn (beginning-of-line) (point))) | 2312 | (let ((beg-del (progn (beginning-of-line) (point))) |
| 2294 | beg-add end-add) | 2313 | beg-add end-add) |
| 2295 | (when (and (diff--forward-while-leading-char ?- end) | 2314 | (cond |
| 2296 | ;; Allow for "\ No newline at end of file". | 2315 | ((eq (char-after) ?+) |
| 2297 | (progn (diff--forward-while-leading-char ?\\ end) | 2316 | (diff--forward-while-leading-char ?+ end) |
| 2298 | (setq beg-add (point))) | 2317 | (when diff-refine-nonmodified |
| 2299 | (diff--forward-while-leading-char ?+ end) | 2318 | (diff--refine-propertize beg-del (point) 'diff-refine-added))) |
| 2300 | (progn (diff--forward-while-leading-char ?\\ end) | 2319 | ((and (diff--forward-while-leading-char ?- end) |
| 2301 | (setq end-add (point)))) | 2320 | ;; Allow for "\ No newline at end of file". |
| 2321 | (progn (diff--forward-while-leading-char ?\\ end) | ||
| 2322 | (setq beg-add (point))) | ||
| 2323 | (diff--forward-while-leading-char ?+ end) | ||
| 2324 | (progn (diff--forward-while-leading-char ?\\ end) | ||
| 2325 | (setq end-add (point)))) | ||
| 2302 | (smerge-refine-regions beg-del beg-add beg-add end-add | 2326 | (smerge-refine-regions beg-del beg-add beg-add end-add |
| 2303 | nil #'diff-refine-preproc props-r props-a))))) | 2327 | nil #'diff-refine-preproc props-r props-a)) |
| 2328 | (t ;; If we're here, it's because | ||
| 2329 | ;; (diff--forward-while-leading-char ?+ end) failed. | ||
| 2330 | (when diff-refine-nonmodified | ||
| 2331 | (diff--refine-propertize beg-del (point) | ||
| 2332 | 'diff-refine-removed))))))) | ||
| 2304 | ('context | 2333 | ('context |
| 2305 | (let* ((middle (save-excursion (re-search-forward "^---" end t))) | 2334 | (let* ((middle (save-excursion (re-search-forward "^---" end t))) |
| 2306 | (other middle)) | 2335 | (other middle)) |
| 2307 | (while (and middle | 2336 | (when middle |
| 2308 | (re-search-forward "^\\(?:!.*\n\\)+" middle t)) | 2337 | (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) |
| 2309 | (smerge-refine-regions (match-beginning 0) (match-end 0) | 2338 | (smerge-refine-regions (match-beginning 0) (match-end 0) |
| 2310 | (save-excursion | 2339 | (save-excursion |
| 2311 | (goto-char other) | 2340 | (goto-char other) |
| 2312 | (re-search-forward "^\\(?:!.*\n\\)+" end) | 2341 | (re-search-forward "^\\(?:!.*\n\\)+" end) |
| 2313 | (setq other (match-end 0)) | 2342 | (setq other (match-end 0)) |
| 2314 | (match-beginning 0)) | 2343 | (match-beginning 0)) |
| 2315 | other | 2344 | other |
| 2316 | (if diff-use-changed-face props-c) | 2345 | (if diff-use-changed-face props-c) |
| 2317 | #'diff-refine-preproc | 2346 | #'diff-refine-preproc |
| 2318 | (unless diff-use-changed-face props-r) | 2347 | (unless diff-use-changed-face props-r) |
| 2319 | (unless diff-use-changed-face props-a))))) | 2348 | (unless diff-use-changed-face props-a))) |
| 2349 | (when diff-refine-nonmodified | ||
| 2350 | (goto-char beg) | ||
| 2351 | (while (re-search-forward "^\\(?:-.*\n\\)+" middle t) | ||
| 2352 | (diff--refine-propertize (match-beginning 0) | ||
| 2353 | (match-end 0) | ||
| 2354 | 'diff-refine-removed)) | ||
| 2355 | (goto-char middle) | ||
| 2356 | (while (re-search-forward "^\\(?:+.*\n\\)+" end t) | ||
| 2357 | (diff--refine-propertize (match-beginning 0) | ||
| 2358 | (match-end 0) | ||
| 2359 | 'diff-refine-added)))))) | ||
| 2320 | (_ ;; Normal diffs. | 2360 | (_ ;; Normal diffs. |
| 2321 | (let ((beg1 (1+ (point)))) | 2361 | (let ((beg1 (1+ (point)))) |
| 2322 | (when (re-search-forward "^---.*\n" end t) | 2362 | (cond |
| 2363 | ((re-search-forward "^---.*\n" end t) | ||
| 2323 | ;; It's a combined add&remove, so there's something to do. | 2364 | ;; It's a combined add&remove, so there's something to do. |
| 2324 | (smerge-refine-regions beg1 (match-beginning 0) | 2365 | (smerge-refine-regions beg1 (match-beginning 0) |
| 2325 | (match-end 0) end | 2366 | (match-end 0) end |
| 2326 | nil #'diff-refine-preproc props-r props-a))))))) | 2367 | nil #'diff-refine-preproc props-r props-a)) |
| 2368 | (diff-refine-nonmodified | ||
| 2369 | (diff--refine-propertize | ||
| 2370 | beg1 end | ||
| 2371 | (if (eq (char-after beg1) ?<) | ||
| 2372 | 'diff-refine-removed 'diff-refine-added))))))))) | ||
| 2327 | 2373 | ||
| 2328 | (defun diff--iterate-hunks (max fun) | 2374 | (defun diff--iterate-hunks (max fun) |
| 2329 | "Iterate over all hunks between point and MAX. | 2375 | "Iterate over all hunks between point and MAX. |
| @@ -2817,6 +2863,57 @@ and the position in MAX." | |||
| 2817 | (defvar-local diff--syntax-file-attributes nil) | 2863 | (defvar-local diff--syntax-file-attributes nil) |
| 2818 | (put 'diff--syntax-file-attributes 'permanent-local t) | 2864 | (put 'diff--syntax-file-attributes 'permanent-local t) |
| 2819 | 2865 | ||
| 2866 | (defvar diff--cached-revision-buffers nil | ||
| 2867 | "List of ((FILE . REVISION) . BUFFER) in MRU order.") | ||
| 2868 | |||
| 2869 | (defvar diff--cache-clean-timer nil) | ||
| 2870 | (defconst diff--cache-clean-interval 3600) ; seconds | ||
| 2871 | |||
| 2872 | (defun diff--cache-clean () | ||
| 2873 | "Discard the least recently used half of the cache." | ||
| 2874 | (let ((n (/ (length diff--cached-revision-buffers) 2))) | ||
| 2875 | (mapc #'kill-buffer (mapcar #'cdr (nthcdr n diff--cached-revision-buffers))) | ||
| 2876 | (setq diff--cached-revision-buffers | ||
| 2877 | (ntake n diff--cached-revision-buffers))) | ||
| 2878 | (diff--cache-schedule-clean)) | ||
| 2879 | |||
| 2880 | (defun diff--cache-schedule-clean () | ||
| 2881 | (setq diff--cache-clean-timer | ||
| 2882 | (and diff--cached-revision-buffers | ||
| 2883 | (run-with-timer diff--cache-clean-interval nil | ||
| 2884 | #'diff--cache-clean)))) | ||
| 2885 | |||
| 2886 | (defun diff--get-revision-properties (file revision text line-nb) | ||
| 2887 | "Get font-lock properties from FILE at REVISION for TEXT at LINE-NB." | ||
| 2888 | (let* ((file-rev (cons file revision)) | ||
| 2889 | (entry (assoc file-rev diff--cached-revision-buffers)) | ||
| 2890 | (buffer (cdr entry))) | ||
| 2891 | (if (buffer-live-p buffer) | ||
| 2892 | (progn | ||
| 2893 | ;; Don't re-initialize the buffer (which would throw | ||
| 2894 | ;; away the previous fontification work). | ||
| 2895 | (setq file nil) | ||
| 2896 | (setq diff--cached-revision-buffers | ||
| 2897 | (cons entry | ||
| 2898 | (delq entry diff--cached-revision-buffers)))) | ||
| 2899 | ;; Cache miss: create a new entry. | ||
| 2900 | (setq buffer (get-buffer-create (format " *diff-syntax:%s.~%s~*" | ||
| 2901 | file revision))) | ||
| 2902 | (condition-case nil | ||
| 2903 | (vc-find-revision-no-save file revision diff-vc-backend buffer) | ||
| 2904 | (error | ||
| 2905 | (kill-buffer buffer) | ||
| 2906 | (setq buffer nil)) | ||
| 2907 | (:success | ||
| 2908 | (push (cons file-rev buffer) | ||
| 2909 | diff--cached-revision-buffers)))) | ||
| 2910 | (when diff--cache-clean-timer | ||
| 2911 | (cancel-timer diff--cache-clean-timer)) | ||
| 2912 | (diff--cache-schedule-clean) | ||
| 2913 | (and buffer | ||
| 2914 | (with-current-buffer buffer | ||
| 2915 | (diff-syntax-fontify-props file text line-nb))))) | ||
| 2916 | |||
| 2820 | (defun diff-syntax-fontify-hunk (beg end old) | 2917 | (defun diff-syntax-fontify-hunk (beg end old) |
| 2821 | "Highlight source language syntax in diff hunk between BEG and END. | 2918 | "Highlight source language syntax in diff hunk between BEG and END. |
| 2822 | When OLD is non-nil, highlight the hunk from the old source." | 2919 | When OLD is non-nil, highlight the hunk from the old source." |
| @@ -2867,22 +2964,8 @@ When OLD is non-nil, highlight the hunk from the old source." | |||
| 2867 | (insert-file-contents file) | 2964 | (insert-file-contents file) |
| 2868 | (setq diff--syntax-file-attributes attrs))) | 2965 | (setq diff--syntax-file-attributes attrs))) |
| 2869 | (diff-syntax-fontify-props file text line-nb))))) | 2966 | (diff-syntax-fontify-props file text line-nb))))) |
| 2870 | ;; Get properties from a cached revision | 2967 | (diff--get-revision-properties file revision |
| 2871 | (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" | 2968 | text line-nb))))) |
| 2872 | file revision)) | ||
| 2873 | (buffer (get-buffer buffer-name))) | ||
| 2874 | (if buffer | ||
| 2875 | ;; Don't re-initialize the buffer (which would throw | ||
| 2876 | ;; away the previous fontification work). | ||
| 2877 | (setq file nil) | ||
| 2878 | (setq buffer (ignore-errors | ||
| 2879 | (vc-find-revision-no-save | ||
| 2880 | file revision | ||
| 2881 | diff-vc-backend | ||
| 2882 | (get-buffer-create buffer-name))))) | ||
| 2883 | (when buffer | ||
| 2884 | (with-current-buffer buffer | ||
| 2885 | (diff-syntax-fontify-props file text line-nb)))))))) | ||
| 2886 | (let ((file (car (diff-hunk-file-names old)))) | 2969 | (let ((file (car (diff-hunk-file-names old)))) |
| 2887 | (cond | 2970 | (cond |
| 2888 | ((and file diff-default-directory | 2971 | ((and file diff-default-directory |
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 456417e566e..18b4a8691e9 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el | |||
| @@ -1411,9 +1411,16 @@ This prompts for a branch to merge from." | |||
| 1411 | (vc-message-unresolved-conflicts buffer-file-name))) | 1411 | (vc-message-unresolved-conflicts buffer-file-name))) |
| 1412 | 1412 | ||
| 1413 | (defun vc-git-clone (remote directory rev) | 1413 | (defun vc-git-clone (remote directory rev) |
| 1414 | (if rev | 1414 | "Attempt to clone REMOTE repository into DIRECTORY at revision REV." |
| 1415 | (vc-git--out-ok "clone" "--branch" rev remote directory) | 1415 | (cond |
| 1416 | ((null rev) | ||
| 1416 | (vc-git--out-ok "clone" remote directory)) | 1417 | (vc-git--out-ok "clone" remote directory)) |
| 1418 | ((ignore-errors | ||
| 1419 | (vc-git--out-ok "clone" "--branch" rev remote directory))) | ||
| 1420 | ((vc-git--out-ok "clone" remote directory) | ||
| 1421 | (let ((default-directory directory)) | ||
| 1422 | (vc-git--out-ok "checkout" rev))) | ||
| 1423 | ((error "Failed to check out %s at %s" remote rev))) | ||
| 1417 | directory) | 1424 | directory) |
| 1418 | 1425 | ||
| 1419 | ;;; HISTORY FUNCTIONS | 1426 | ;;; HISTORY FUNCTIONS |
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 1493845e2d9..75f68dd80d1 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el | |||
| @@ -186,7 +186,8 @@ revision number and lock status." | |||
| 186 | This minor mode is automatically activated whenever you visit a file under | 186 | This minor mode is automatically activated whenever you visit a file under |
| 187 | control of one of the revision control systems in `vc-handled-backends'. | 187 | control of one of the revision control systems in `vc-handled-backends'. |
| 188 | VC commands are globally reachable under the prefix \\[vc-prefix-map]: | 188 | VC commands are globally reachable under the prefix \\[vc-prefix-map]: |
| 189 | \\{vc-prefix-map}") | 189 | \\{vc-prefix-map}" |
| 190 | nil) | ||
| 190 | 191 | ||
| 191 | (defmacro vc-error-occurred (&rest body) | 192 | (defmacro vc-error-occurred (&rest body) |
| 192 | `(condition-case nil (progn ,@body nil) (error t))) | 193 | `(condition-case nil (progn ,@body nil) (error t))) |
| @@ -197,7 +198,7 @@ VC commands are globally reachable under the prefix \\[vc-prefix-map]: | |||
| 197 | ;; during any subsequent VC operations, and forget them when | 198 | ;; during any subsequent VC operations, and forget them when |
| 198 | ;; the buffer is killed. | 199 | ;; the buffer is killed. |
| 199 | 200 | ||
| 200 | (defvar vc-file-prop-obarray (make-vector 17 0) | 201 | (defvar vc-file-prop-obarray (obarray-make 17) |
| 201 | "Obarray for per-file properties.") | 202 | "Obarray for per-file properties.") |
| 202 | 203 | ||
| 203 | (defvar vc-touched-properties nil) | 204 | (defvar vc-touched-properties nil) |
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index f612daaa569..3cd17276fa4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el | |||
| @@ -935,7 +935,7 @@ is sensitive to blank lines." | |||
| 935 | (defun vc-clear-context () | 935 | (defun vc-clear-context () |
| 936 | "Clear all cached file properties." | 936 | "Clear all cached file properties." |
| 937 | (interactive) | 937 | (interactive) |
| 938 | (fillarray vc-file-prop-obarray 0)) | 938 | (obarray-clear vc-file-prop-obarray)) |
| 939 | 939 | ||
| 940 | (defmacro with-vc-properties (files form settings) | 940 | (defmacro with-vc-properties (files form settings) |
| 941 | "Execute FORM, then maybe set per-file properties for FILES. | 941 | "Execute FORM, then maybe set per-file properties for FILES. |
| @@ -3623,7 +3623,15 @@ revisions. | |||
| 3623 | When invoked interactively in a Log View buffer with | 3623 | When invoked interactively in a Log View buffer with |
| 3624 | marked revisions, use those." | 3624 | marked revisions, use those." |
| 3625 | (interactive | 3625 | (interactive |
| 3626 | (let ((revs (vc-prepare-patch-prompt-revisions)) to) | 3626 | (let* ((revs (vc-prepare-patch-prompt-revisions)) |
| 3627 | (subject | ||
| 3628 | (and (length= revs 1) | ||
| 3629 | (plist-get | ||
| 3630 | (vc-call-backend | ||
| 3631 | (vc-responsible-backend default-directory) | ||
| 3632 | 'prepare-patch (car revs)) | ||
| 3633 | :subject))) | ||
| 3634 | to) | ||
| 3627 | (require 'message) | 3635 | (require 'message) |
| 3628 | (while (null (setq to (completing-read-multiple | 3636 | (while (null (setq to (completing-read-multiple |
| 3629 | (format-prompt | 3637 | (format-prompt |
| @@ -3636,10 +3644,9 @@ marked revisions, use those." | |||
| 3636 | (sit-for blink-matching-delay)) | 3644 | (sit-for blink-matching-delay)) |
| 3637 | (list (string-join to ", ") | 3645 | (list (string-join to ", ") |
| 3638 | (and (not vc-prepare-patches-separately) | 3646 | (and (not vc-prepare-patches-separately) |
| 3639 | (read-string "Subject: " "[PATCH] " nil nil t)) | 3647 | (read-string "Subject: " (or subject "[PATCH] ") nil nil t)) |
| 3640 | revs))) | 3648 | revs))) |
| 3641 | (save-current-buffer | 3649 | (save-current-buffer |
| 3642 | (vc-ensure-vc-buffer) | ||
| 3643 | (let ((patches (mapcar (lambda (rev) | 3650 | (let ((patches (mapcar (lambda (rev) |
| 3644 | (vc-call-backend | 3651 | (vc-call-backend |
| 3645 | (vc-responsible-backend default-directory) | 3652 | (vc-responsible-backend default-directory) |
diff --git a/lisp/vcursor.el b/lisp/vcursor.el index ec5adbd832c..15791285b13 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el | |||
| @@ -433,7 +433,7 @@ Default is nil." | |||
| 433 | (defcustom vcursor-interpret-input nil | 433 | (defcustom vcursor-interpret-input nil |
| 434 | "If non-nil, input from the vcursor is treated as interactive input. | 434 | "If non-nil, input from the vcursor is treated as interactive input. |
| 435 | This will cause text insertion to be much slower. Note that no special | 435 | This will cause text insertion to be much slower. Note that no special |
| 436 | interpretation of strings is done: \"\C-x\" is a string of four | 436 | interpretation of strings is done: \"\\C-x\" is a string of four |
| 437 | characters. The default is simply to copy strings." | 437 | characters. The default is simply to copy strings." |
| 438 | :type 'boolean | 438 | :type 'boolean |
| 439 | :version "20.3") | 439 | :version "20.3") |
diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 20e55444082..d95cf4bb569 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el | |||
| @@ -173,7 +173,9 @@ by `visual-wrap-extra-indent'." | |||
| 173 | 173 | ||
| 174 | ;;;###autoload | 174 | ;;;###autoload |
| 175 | (define-minor-mode visual-wrap-prefix-mode | 175 | (define-minor-mode visual-wrap-prefix-mode |
| 176 | "Display continuation lines with prefixes from surrounding context." | 176 | "Display continuation lines with prefixes from surrounding context. |
| 177 | To enable this minor mode across all buffers, enable | ||
| 178 | `global-visual-wrap-prefix-mode'." | ||
| 177 | :lighter "" | 179 | :lighter "" |
| 178 | :group 'visual-line | 180 | :group 'visual-line |
| 179 | (if visual-wrap-prefix-mode | 181 | (if visual-wrap-prefix-mode |
| @@ -192,5 +194,11 @@ by `visual-wrap-extra-indent'." | |||
| 192 | (widen) | 194 | (widen) |
| 193 | (remove-text-properties (point-min) (point-max) '(wrap-prefix nil)))))) | 195 | (remove-text-properties (point-min) (point-max) '(wrap-prefix nil)))))) |
| 194 | 196 | ||
| 197 | ;;;###autoload | ||
| 198 | (define-globalized-minor-mode global-visual-wrap-prefix-mode | ||
| 199 | visual-wrap-prefix-mode visual-wrap-prefix-mode | ||
| 200 | :init-value nil | ||
| 201 | :group 'visual-line) | ||
| 202 | |||
| 195 | (provide 'visual-wrap) | 203 | (provide 'visual-wrap) |
| 196 | ;;; visual-wrap.el ends here | 204 | ;;; visual-wrap.el ends here |
diff --git a/lisp/winner.el b/lisp/winner.el index 2aa59a86b25..19641a05bfc 100644 --- a/lisp/winner.el +++ b/lisp/winner.el | |||
| @@ -178,7 +178,8 @@ You may want to include buffer names such as *Help*, *Apropos*, | |||
| 178 | (setq winner-last-frames nil) | 178 | (setq winner-last-frames nil) |
| 179 | (setq winner-last-command this-command)) | 179 | (setq winner-last-command this-command)) |
| 180 | (dolist (frame winner-modified-list) | 180 | (dolist (frame winner-modified-list) |
| 181 | (winner-insert-if-new frame)) | 181 | (if (frame-live-p frame) |
| 182 | (winner-insert-if-new frame))) | ||
| 182 | (setq winner-modified-list nil) | 183 | (setq winner-modified-list nil) |
| 183 | (winner-remember))) | 184 | (winner-remember))) |
| 184 | 185 | ||
diff --git a/lisp/woman.el b/lisp/woman.el index a9af46fa387..2357ba6b132 100644 --- a/lisp/woman.el +++ b/lisp/woman.el | |||
| @@ -2566,7 +2566,8 @@ If DELETE is non-nil then delete from point." | |||
| 2566 | ;; "\\(\\\\{\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*" | 2566 | ;; "\\(\\\\{\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*" |
| 2567 | ;; Interpret bogus `el \}' as `el \{', | 2567 | ;; Interpret bogus `el \}' as `el \{', |
| 2568 | ;; especially for Tcl/Tk man pages: | 2568 | ;; especially for Tcl/Tk man pages: |
| 2569 | "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*") | 2569 | "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*" |
| 2570 | nil t) | ||
| 2570 | (match-beginning 1)) | 2571 | (match-beginning 1)) |
| 2571 | (re-search-forward "\\\\}")) | 2572 | (re-search-forward "\\\\}")) |
| 2572 | (delete-region (if delete from (match-beginning 0)) (point)) | 2573 | (delete-region (if delete from (match-beginning 0)) (point)) |
diff --git a/m4/copy-file-range.m4 b/m4/copy-file-range.m4 index e9198549510..443e598ba55 100644 --- a/m4/copy-file-range.m4 +++ b/m4/copy-file-range.m4 | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | # copy-file-range.m4 | 1 | # copy-file-range.m4 serial 5 |
| 2 | dnl Copyright 2019-2024 Free Software Foundation, Inc. | 2 | dnl Copyright 2019-2024 Free Software Foundation, Inc. |
| 3 | dnl This file is free software; the Free Software Foundation | 3 | dnl This file is free software; the Free Software Foundation |
| 4 | dnl gives unlimited permission to copy and/or distribute it, | 4 | dnl gives unlimited permission to copy and/or distribute it, |
| @@ -17,22 +17,33 @@ AC_DEFUN([gl_FUNC_COPY_FILE_RANGE], | |||
| 17 | dnl Programs that use copy_file_range must fall back on read+write | 17 | dnl Programs that use copy_file_range must fall back on read+write |
| 18 | dnl anyway, and there's little point to substituting the Gnulib stub | 18 | dnl anyway, and there's little point to substituting the Gnulib stub |
| 19 | dnl for a glibc stub. | 19 | dnl for a glibc stub. |
| 20 | AC_CACHE_CHECK([for copy_file_range], [gl_cv_func_copy_file_range], | 20 | case "$host_os" in |
| 21 | [AC_LINK_IFELSE( | 21 | *-gnu* | gnu*) |
| 22 | [AC_LANG_PROGRAM( | 22 | AC_CACHE_CHECK([for copy_file_range], [gl_cv_func_copy_file_range], |
| 23 | [[#include <unistd.h> | 23 | [AC_LINK_IFELSE( |
| 24 | ]], | 24 | [AC_LANG_PROGRAM( |
| 25 | [[ssize_t (*func) (int, off_t *, int, off_t *, size_t, unsigned) | 25 | [[#include <unistd.h> |
| 26 | = copy_file_range; | 26 | ]], |
| 27 | return func (0, 0, 0, 0, 0, 0) & 127; | 27 | [[ssize_t (*func) (int, off_t *, int, off_t *, size_t, unsigned) |
| 28 | ]]) | 28 | = copy_file_range; |
| 29 | ], | 29 | return func (0, 0, 0, 0, 0, 0) & 127; |
| 30 | [gl_cv_func_copy_file_range=yes], | 30 | ]]) |
| 31 | [gl_cv_func_copy_file_range=no]) | 31 | ], |
| 32 | ]) | 32 | [gl_cv_func_copy_file_range=yes], |
| 33 | 33 | [gl_cv_func_copy_file_range=no]) | |
| 34 | ]) | ||
| 35 | gl_cv_onwards_func_copy_file_range="$gl_cv_func_copy_file_range" | ||
| 36 | ;; | ||
| 37 | *) | ||
| 38 | gl_CHECK_FUNCS_ANDROID([copy_file_range], [[#include <unistd.h>]]) | ||
| 39 | gl_cv_func_copy_file_range="$ac_cv_func_copy_file_range" | ||
| 40 | ;; | ||
| 41 | esac | ||
| 34 | if test "$gl_cv_func_copy_file_range" != yes; then | 42 | if test "$gl_cv_func_copy_file_range" != yes; then |
| 35 | HAVE_COPY_FILE_RANGE=0 | 43 | HAVE_COPY_FILE_RANGE=0 |
| 44 | case "$gl_cv_onwards_func_copy_file_range" in | ||
| 45 | future*) REPLACE_COPY_FILE_RANGE=1 ;; | ||
| 46 | esac | ||
| 36 | else | 47 | else |
| 37 | AC_DEFINE([HAVE_COPY_FILE_RANGE], 1, | 48 | AC_DEFINE([HAVE_COPY_FILE_RANGE], 1, |
| 38 | [Define to 1 if the function copy_file_range exists.]) | 49 | [Define to 1 if the function copy_file_range exists.]) |
diff --git a/m4/gettime.m4 b/m4/gettime.m4 index e450e6b9d05..1ec018d5154 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | # gettime.m4 serial 14 | 1 | # gettime.m4 serial 15 |
| 2 | dnl Copyright (C) 2002, 2004-2006, 2009-2024 Free Software Foundation, Inc. | 2 | dnl Copyright (C) 2002, 2004-2006, 2009-2024 Free Software Foundation, Inc. |
| 3 | dnl This file is free software; the Free Software Foundation | 3 | dnl This file is free software; the Free Software Foundation |
| 4 | dnl gives unlimited permission to copy and/or distribute it, | 4 | dnl gives unlimited permission to copy and/or distribute it, |
| @@ -64,5 +64,5 @@ AC_DEFUN([gl_GETTIME_RES], | |||
| 64 | dnl Prerequisites of lib/gettime-res.c. | 64 | dnl Prerequisites of lib/gettime-res.c. |
| 65 | AC_REQUIRE([gl_CLOCK_TIME]) | 65 | AC_REQUIRE([gl_CLOCK_TIME]) |
| 66 | AC_REQUIRE([gl_TIMESPEC]) | 66 | AC_REQUIRE([gl_TIMESPEC]) |
| 67 | AC_CHECK_FUNCS_ONCE([timespec_getres]) | 67 | gl_CHECK_FUNCS_ANDROID([timespec_getres], [[#include <time.h>]]) |
| 68 | ]) | 68 | ]) |
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 03d10fa51ea..d8d0904f787 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | # gnulib-common.m4 serial 90 | 1 | # gnulib-common.m4 serial 92 |
| 2 | dnl Copyright (C) 2007-2024 Free Software Foundation, Inc. | 2 | dnl Copyright (C) 2007-2024 Free Software Foundation, Inc. |
| 3 | dnl This file is free software; the Free Software Foundation | 3 | dnl This file is free software; the Free Software Foundation |
| 4 | dnl gives unlimited permission to copy and/or distribute it, | 4 | dnl gives unlimited permission to copy and/or distribute it, |
| @@ -76,42 +76,48 @@ AC_DEFUN([gl_COMMON_BODY], [ | |||
| 76 | #endif]) | 76 | #endif]) |
| 77 | AH_VERBATIM([attribute], | 77 | AH_VERBATIM([attribute], |
| 78 | [/* Attributes. */ | 78 | [/* Attributes. */ |
| 79 | #if (defined __has_attribute \ | 79 | /* Define _GL_HAS_ATTRIBUTE only once, because on FreeBSD, with gcc < 5, if |
| 80 | && (!defined __clang_minor__ \ | 80 | <config.h> gets included once again after <sys/cdefs.h>, __has_attribute(x) |
| 81 | || (defined __apple_build_version__ \ | 81 | expands to 0 always, and redefining _GL_HAS_ATTRIBUTE would turn off all |
| 82 | ? 6000000 <= __apple_build_version__ \ | 82 | attributes. */ |
| 83 | : 5 <= __clang_major__))) | 83 | #ifndef _GL_HAS_ATTRIBUTE |
| 84 | # define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__) | 84 | # if (defined __has_attribute \ |
| 85 | #else | 85 | && (!defined __clang_minor__ \ |
| 86 | # define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr | 86 | || (defined __apple_build_version__ \ |
| 87 | # define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3) | 87 | ? 7000000 <= __apple_build_version__ \ |
| 88 | # define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2) | 88 | : 5 <= __clang_major__))) |
| 89 | # define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3) | 89 | # define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__) |
| 90 | # define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3) | ||
| 91 | # define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95) | ||
| 92 | # define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1) | ||
| 93 | # define _GL_ATTR_diagnose_if 0 | ||
| 94 | # define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3) | ||
| 95 | # define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1) | ||
| 96 | # define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0) | ||
| 97 | # define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7) | ||
| 98 | # define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6) | ||
| 99 | # define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0) | ||
| 100 | # ifdef _ICC | ||
| 101 | # define _GL_ATTR_may_alias 0 | ||
| 102 | # else | 90 | # else |
| 103 | # define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3) | 91 | # define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr |
| 92 | # define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3) | ||
| 93 | # define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2) | ||
| 94 | # define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3) | ||
| 95 | # define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3) | ||
| 96 | # define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95) | ||
| 97 | # define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1) | ||
| 98 | # define _GL_ATTR_diagnose_if 0 | ||
| 99 | # define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3) | ||
| 100 | # define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1) | ||
| 101 | # define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0) | ||
| 102 | # define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7) | ||
| 103 | # define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6) | ||
| 104 | # define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0) | ||
| 105 | # ifdef _ICC | ||
| 106 | # define _GL_ATTR_may_alias 0 | ||
| 107 | # else | ||
| 108 | # define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3) | ||
| 109 | # endif | ||
| 110 | # define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1) | ||
| 111 | # define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3) | ||
| 112 | # define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0) | ||
| 113 | # define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3) | ||
| 114 | # define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7) | ||
| 115 | # define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96) | ||
| 116 | # define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9) | ||
| 117 | # define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0) | ||
| 118 | # define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7) | ||
| 119 | # define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4) | ||
| 104 | # endif | 120 | # endif |
| 105 | # define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1) | ||
| 106 | # define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3) | ||
| 107 | # define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0) | ||
| 108 | # define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3) | ||
| 109 | # define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7) | ||
| 110 | # define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96) | ||
| 111 | # define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9) | ||
| 112 | # define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0) | ||
| 113 | # define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7) | ||
| 114 | # define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4) | ||
| 115 | #endif | 121 | #endif |
| 116 | 122 | ||
| 117 | /* Use __has_c_attribute if available. However, do not use with | 123 | /* Use __has_c_attribute if available. However, do not use with |
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 2e5b328e3d8..d8b92e7b122 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 | |||
| @@ -432,7 +432,8 @@ AC_DEFUN([gl_INIT], | |||
| 432 | ]) | 432 | ]) |
| 433 | gl_STRING_MODULE_INDICATOR([memrchr]) | 433 | gl_STRING_MODULE_INDICATOR([memrchr]) |
| 434 | gl_FUNC_MEMSET_EXPLICIT | 434 | gl_FUNC_MEMSET_EXPLICIT |
| 435 | gl_CONDITIONAL([GL_COND_OBJ_MEMSET_EXPLICIT], [test $HAVE_MEMSET_EXPLICIT = 0]) | 435 | gl_CONDITIONAL([GL_COND_OBJ_MEMSET_EXPLICIT], |
| 436 | [test $HAVE_MEMSET_EXPLICIT = 0 || test $REPLACE_MEMSET_EXPLICIT = 1]) | ||
| 436 | AM_COND_IF([GL_COND_OBJ_MEMSET_EXPLICIT], [ | 437 | AM_COND_IF([GL_COND_OBJ_MEMSET_EXPLICIT], [ |
| 437 | gl_PREREQ_MEMSET_EXPLICIT | 438 | gl_PREREQ_MEMSET_EXPLICIT |
| 438 | ]) | 439 | ]) |
| @@ -1023,7 +1024,7 @@ AC_DEFUN([gl_INIT], | |||
| 1023 | if test $ac_use_included_regex = yes; then | 1024 | if test $ac_use_included_regex = yes; then |
| 1024 | func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c | 1025 | func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c |
| 1025 | fi | 1026 | fi |
| 1026 | if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then | 1027 | if test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then |
| 1027 | func_gl_gnulib_m4code_strtoll | 1028 | func_gl_gnulib_m4code_strtoll |
| 1028 | fi | 1029 | fi |
| 1029 | if test $HAVE_TIMEGM = 0 || test $REPLACE_TIMEGM = 1; then | 1030 | if test $HAVE_TIMEGM = 0 || test $REPLACE_TIMEGM = 1; then |
| @@ -1421,6 +1422,7 @@ AC_DEFUN([gl_FILE_LIST], [ | |||
| 1421 | lib/stdlib.in.h | 1422 | lib/stdlib.in.h |
| 1422 | lib/stpcpy.c | 1423 | lib/stpcpy.c |
| 1423 | lib/str-two-way.h | 1424 | lib/str-two-way.h |
| 1425 | lib/strftime.c | ||
| 1424 | lib/strftime.h | 1426 | lib/strftime.h |
| 1425 | lib/string.in.h | 1427 | lib/string.in.h |
| 1426 | lib/strnlen.c | 1428 | lib/strnlen.c |
diff --git a/m4/memset_explicit.m4 b/m4/memset_explicit.m4 index 6ac798d4557..19514ff917e 100644 --- a/m4/memset_explicit.m4 +++ b/m4/memset_explicit.m4 | |||
| @@ -1,3 +1,4 @@ | |||
| 1 | # memset_explicit.m4 serial 2 | ||
| 1 | dnl Copyright 2022-2024 Free Software Foundation, Inc. | 2 | dnl Copyright 2022-2024 Free Software Foundation, Inc. |
| 2 | dnl This file is free software; the Free Software Foundation | 3 | dnl This file is free software; the Free Software Foundation |
| 3 | dnl gives unlimited permission to copy and/or distribute it, | 4 | dnl gives unlimited permission to copy and/or distribute it, |
| @@ -7,9 +8,12 @@ AC_DEFUN([gl_FUNC_MEMSET_EXPLICIT], | |||
| 7 | [ | 8 | [ |
| 8 | AC_REQUIRE([gl_STRING_H_DEFAULTS]) | 9 | AC_REQUIRE([gl_STRING_H_DEFAULTS]) |
| 9 | 10 | ||
| 10 | AC_CHECK_FUNCS_ONCE([memset_explicit]) | 11 | gl_CHECK_FUNCS_ANDROID([memset_explicit], [[#include <string.h>]]) |
| 11 | if test $ac_cv_func_memset_explicit = no; then | 12 | if test $ac_cv_func_memset_explicit = no; then |
| 12 | HAVE_MEMSET_EXPLICIT=0 | 13 | HAVE_MEMSET_EXPLICIT=0 |
| 14 | case "$gl_cv_onwards_func_memset_explicit" in | ||
| 15 | future*) REPLACE_MEMSET_EXPLICIT=1 ;; | ||
| 16 | esac | ||
| 13 | fi | 17 | fi |
| 14 | ]) | 18 | ]) |
| 15 | 19 | ||
diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4 index c51f590402f..ff730b676cd 100644 --- a/m4/nanosleep.m4 +++ b/m4/nanosleep.m4 | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | # serial 46 | 1 | # serial 47 |
| 2 | 2 | ||
| 3 | dnl From Jim Meyering. | 3 | dnl From Jim Meyering. |
| 4 | dnl Check for the nanosleep function. | 4 | dnl Check for the nanosleep function. |
| @@ -119,6 +119,10 @@ AC_DEFUN([gl_FUNC_NANOSLEEP], | |||
| 119 | # Guess it halfway works when the kernel is Linux. | 119 | # Guess it halfway works when the kernel is Linux. |
| 120 | linux*) | 120 | linux*) |
| 121 | gl_cv_func_nanosleep='guessing no (mishandles large arguments)' ;; | 121 | gl_cv_func_nanosleep='guessing no (mishandles large arguments)' ;; |
| 122 | # Midipix generally emulates the Linux system calls, | ||
| 123 | # but here it handles large arguments correctly. | ||
| 124 | midipix*) | ||
| 125 | gl_cv_func_nanosleep='guessing yes' ;; | ||
| 122 | # Guess no on native Windows. | 126 | # Guess no on native Windows. |
| 123 | mingw* | windows*) | 127 | mingw* | windows*) |
| 124 | gl_cv_func_nanosleep='guessing no' ;; | 128 | gl_cv_func_nanosleep='guessing no' ;; |
diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4 index 67250dc9455..aa5d63a54b5 100644 --- a/m4/nstrftime.m4 +++ b/m4/nstrftime.m4 | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | # serial 37 | 1 | # serial 38 |
| 2 | 2 | ||
| 3 | # Copyright (C) 1996-1997, 1999-2007, 2009-2024 Free Software Foundation, Inc. | 3 | # Copyright (C) 1996-1997, 1999-2007, 2009-2024 Free Software Foundation, Inc. |
| 4 | # | 4 | # |
| @@ -16,7 +16,4 @@ AC_DEFUN([gl_FUNC_GNU_STRFTIME], | |||
| 16 | AC_REQUIRE([AC_STRUCT_TIMEZONE]) | 16 | AC_REQUIRE([AC_STRUCT_TIMEZONE]) |
| 17 | 17 | ||
| 18 | AC_REQUIRE([gl_TM_GMTOFF]) | 18 | AC_REQUIRE([gl_TM_GMTOFF]) |
| 19 | |||
| 20 | AC_DEFINE([my_strftime], [nstrftime], | ||
| 21 | [Define to the name of the strftime replacement function.]) | ||
| 22 | ]) | 19 | ]) |
diff --git a/m4/string_h.m4 b/m4/string_h.m4 index 8b12101447f..9ea748cc774 100644 --- a/m4/string_h.m4 +++ b/m4/string_h.m4 | |||
| @@ -5,7 +5,7 @@ | |||
| 5 | # gives unlimited permission to copy and/or distribute it, | 5 | # gives unlimited permission to copy and/or distribute it, |
| 6 | # with or without modifications, as long as this notice is preserved. | 6 | # with or without modifications, as long as this notice is preserved. |
| 7 | 7 | ||
| 8 | # serial 38 | 8 | # serial 39 |
| 9 | 9 | ||
| 10 | # Written by Paul Eggert. | 10 | # Written by Paul Eggert. |
| 11 | 11 | ||
| @@ -132,6 +132,7 @@ AC_DEFUN([gl_STRING_H_DEFAULTS], | |||
| 132 | REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR]) | 132 | REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR]) |
| 133 | REPLACE_MEMMEM=0; AC_SUBST([REPLACE_MEMMEM]) | 133 | REPLACE_MEMMEM=0; AC_SUBST([REPLACE_MEMMEM]) |
| 134 | REPLACE_MEMPCPY=0; AC_SUBST([REPLACE_MEMPCPY]) | 134 | REPLACE_MEMPCPY=0; AC_SUBST([REPLACE_MEMPCPY]) |
| 135 | REPLACE_MEMSET_EXPLICIT=0; AC_SUBST([REPLACE_MEMSET_EXPLICIT]) | ||
| 135 | REPLACE_STPCPY=0; AC_SUBST([REPLACE_STPCPY]) | 136 | REPLACE_STPCPY=0; AC_SUBST([REPLACE_STPCPY]) |
| 136 | REPLACE_STPNCPY=0; AC_SUBST([REPLACE_STPNCPY]) | 137 | REPLACE_STPNCPY=0; AC_SUBST([REPLACE_STPNCPY]) |
| 137 | REPLACE_STRCHRNUL=0; AC_SUBST([REPLACE_STRCHRNUL]) | 138 | REPLACE_STRCHRNUL=0; AC_SUBST([REPLACE_STRCHRNUL]) |
diff --git a/m4/time_h.m4 b/m4/time_h.m4 index 367f69efae6..32fade0f401 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 | |||
| @@ -2,7 +2,7 @@ | |||
| 2 | 2 | ||
| 3 | # Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc. | 3 | # Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | # serial 24 | 5 | # serial 25 |
| 6 | 6 | ||
| 7 | # This file is free software; the Free Software Foundation | 7 | # This file is free software; the Free Software Foundation |
| 8 | # gives unlimited permission to copy and/or distribute it, | 8 | # gives unlimited permission to copy and/or distribute it, |
| @@ -175,5 +175,6 @@ AC_DEFUN([gl_TIME_H_DEFAULTS], | |||
| 175 | REPLACE_TIME=0; AC_SUBST([REPLACE_TIME]) | 175 | REPLACE_TIME=0; AC_SUBST([REPLACE_TIME]) |
| 176 | REPLACE_TIMEGM=0; AC_SUBST([REPLACE_TIMEGM]) | 176 | REPLACE_TIMEGM=0; AC_SUBST([REPLACE_TIMEGM]) |
| 177 | REPLACE_TIMESPEC_GET=0; AC_SUBST([REPLACE_TIMESPEC_GET]) | 177 | REPLACE_TIMESPEC_GET=0; AC_SUBST([REPLACE_TIMESPEC_GET]) |
| 178 | REPLACE_TIMESPEC_GETRES=0; AC_SUBST([REPLACE_TIMESPEC_GETRES]) | ||
| 178 | REPLACE_TZSET=0; AC_SUBST([REPLACE_TZSET]) | 179 | REPLACE_TZSET=0; AC_SUBST([REPLACE_TZSET]) |
| 179 | ]) | 180 | ]) |
diff --git a/m4/utimens.m4 b/m4/utimens.m4 index af03e6b52be..0f5bfd4c843 100644 --- a/m4/utimens.m4 +++ b/m4/utimens.m4 | |||
| @@ -3,7 +3,7 @@ dnl This file is free software; the Free Software Foundation | |||
| 3 | dnl gives unlimited permission to copy and/or distribute it, | 3 | dnl gives unlimited permission to copy and/or distribute it, |
| 4 | dnl with or without modifications, as long as this notice is preserved. | 4 | dnl with or without modifications, as long as this notice is preserved. |
| 5 | 5 | ||
| 6 | dnl serial 15 | 6 | dnl serial 16 |
| 7 | 7 | ||
| 8 | AC_DEFUN([gl_UTIMENS], | 8 | AC_DEFUN([gl_UTIMENS], |
| 9 | [ | 9 | [ |
| @@ -36,12 +36,13 @@ AC_DEFUN([gl_UTIMENS], | |||
| 36 | [gl_cv_func_futimesat_works=yes], | 36 | [gl_cv_func_futimesat_works=yes], |
| 37 | [gl_cv_func_futimesat_works=no], | 37 | [gl_cv_func_futimesat_works=no], |
| 38 | [case "$host_os" in | 38 | [case "$host_os" in |
| 39 | # Guess yes on Linux systems. | 39 | # Guess yes on Linux systems |
| 40 | linux-* | linux) gl_cv_func_futimesat_works="guessing yes" ;; | 40 | # and on systems that emulate the Linux system calls. |
| 41 | # Guess yes on glibc systems. | 41 | linux* | midipix*) gl_cv_func_futimesat_works="guessing yes" ;; |
| 42 | *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;; | 42 | # Guess yes on glibc systems. |
| 43 | # If we don't know, obey --enable-cross-guesses. | 43 | *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;; |
| 44 | *) gl_cv_func_futimesat_works="$gl_cross_guess_normal" ;; | 44 | # If we don't know, obey --enable-cross-guesses. |
| 45 | *) gl_cv_func_futimesat_works="$gl_cross_guess_normal" ;; | ||
| 45 | esac | 46 | esac |
| 46 | ]) | 47 | ]) |
| 47 | rm -f conftest.file]) | 48 | rm -f conftest.file]) |
diff --git a/m4/utimensat.m4 b/m4/utimensat.m4 index e595b333d17..4af7f6f81c8 100644 --- a/m4/utimensat.m4 +++ b/m4/utimensat.m4 | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | # serial 11 | 1 | # serial 12 |
| 2 | # See if we need to provide utimensat replacement. | 2 | # See if we need to provide utimensat replacement. |
| 3 | 3 | ||
| 4 | dnl Copyright (C) 2009-2024 Free Software Foundation, Inc. | 4 | dnl Copyright (C) 2009-2024 Free Software Foundation, Inc. |
| @@ -83,6 +83,9 @@ AC_DEFUN([gl_FUNC_UTIMENSAT], | |||
| 83 | # Guess yes on Linux or glibc systems. | 83 | # Guess yes on Linux or glibc systems. |
| 84 | linux-* | linux | *-gnu* | gnu*) | 84 | linux-* | linux | *-gnu* | gnu*) |
| 85 | gl_cv_func_utimensat_works="guessing yes" ;; | 85 | gl_cv_func_utimensat_works="guessing yes" ;; |
| 86 | # Guess yes on systems that emulate the Linux system calls. | ||
| 87 | midipix*) | ||
| 88 | gl_cv_func_utimensat_works="guessing yes" ;; | ||
| 86 | # Guess 'nearly' on AIX. | 89 | # Guess 'nearly' on AIX. |
| 87 | aix*) | 90 | aix*) |
| 88 | gl_cv_func_utimensat_works="guessing nearly" ;; | 91 | gl_cv_func_utimensat_works="guessing nearly" ;; |
diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c index 0500b653bb2..c012151cf96 100644 --- a/nt/cmdproxy.c +++ b/nt/cmdproxy.c | |||
| @@ -38,6 +38,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 38 | #include <string.h> /* strlen */ | 38 | #include <string.h> /* strlen */ |
| 39 | #include <ctype.h> /* isspace, isalpha */ | 39 | #include <ctype.h> /* isspace, isalpha */ |
| 40 | 40 | ||
| 41 | /* UCRT has a C99-compatible snprintf, and _snprintf is defined inline | ||
| 42 | in stdio.h, which we don't want to include here. Since the | ||
| 43 | differences in behavior between snprintf and _snprintf don't matter | ||
| 44 | in this file, we take the easy way out. */ | ||
| 45 | #ifdef _UCRT | ||
| 46 | # define _snprintf snprintf | ||
| 47 | #endif | ||
| 48 | |||
| 41 | /* We don't want to include stdio.h because we are already duplicating | 49 | /* We don't want to include stdio.h because we are already duplicating |
| 42 | lots of it here */ | 50 | lots of it here */ |
| 43 | extern int _snprintf (char *buffer, size_t count, const char *format, ...); | 51 | extern int _snprintf (char *buffer, size_t count, const char *format, ...); |
diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk index 5b1c2c88ba5..048f812724a 100644 --- a/nt/gnulib-cfg.mk +++ b/nt/gnulib-cfg.mk | |||
| @@ -46,6 +46,7 @@ OMIT_GNULIB_MODULE_allocator = true | |||
| 46 | OMIT_GNULIB_MODULE_at-internal = true | 46 | OMIT_GNULIB_MODULE_at-internal = true |
| 47 | OMIT_GNULIB_MODULE_canonicalize-lgpl = true | 47 | OMIT_GNULIB_MODULE_canonicalize-lgpl = true |
| 48 | OMIT_GNULIB_MODULE_careadlinkat = true | 48 | OMIT_GNULIB_MODULE_careadlinkat = true |
| 49 | OMIT_GNULIB_MODULE_copy-file-range = true | ||
| 49 | OMIT_GNULIB_MODULE_dirent = true | 50 | OMIT_GNULIB_MODULE_dirent = true |
| 50 | OMIT_GNULIB_MODULE_dirfd = true | 51 | OMIT_GNULIB_MODULE_dirfd = true |
| 51 | OMIT_GNULIB_MODULE_fchmodat = true | 52 | OMIT_GNULIB_MODULE_fchmodat = true |
diff --git a/src/alloc.c b/src/alloc.c index 15bb65cf74f..16257469aa6 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -360,13 +360,13 @@ static struct gcstat | |||
| 360 | object_ct total_intervals, total_free_intervals; | 360 | object_ct total_intervals, total_free_intervals; |
| 361 | object_ct total_buffers; | 361 | object_ct total_buffers; |
| 362 | 362 | ||
| 363 | /* Size of the ancillary arrays of live hash-table objects. | 363 | /* Size of the ancillary arrays of live hash-table and obarray objects. |
| 364 | The objects themselves are not included (counted as vectors above). */ | 364 | The objects themselves are not included (counted as vectors above). */ |
| 365 | byte_ct total_hash_table_bytes; | 365 | byte_ct total_hash_table_bytes; |
| 366 | } gcstat; | 366 | } gcstat; |
| 367 | 367 | ||
| 368 | /* Total size of ancillary arrays of all allocated hash-table objects, | 368 | /* Total size of ancillary arrays of all allocated hash-table and obarray |
| 369 | both dead and alive. This number is always kept up-to-date. */ | 369 | objects, both dead and alive. This number is always kept up-to-date. */ |
| 370 | static ptrdiff_t hash_table_allocated_bytes = 0; | 370 | static ptrdiff_t hash_table_allocated_bytes = 0; |
| 371 | 371 | ||
| 372 | /* Points to memory space allocated as "spare", to be freed if we run | 372 | /* Points to memory space allocated as "spare", to be freed if we run |
| @@ -3443,7 +3443,7 @@ cleanup_vector (struct Lisp_Vector *vector) | |||
| 3443 | struct Lisp_Hash_Table *h = PSEUDOVEC_STRUCT (vector, Lisp_Hash_Table); | 3443 | struct Lisp_Hash_Table *h = PSEUDOVEC_STRUCT (vector, Lisp_Hash_Table); |
| 3444 | if (h->table_size > 0) | 3444 | if (h->table_size > 0) |
| 3445 | { | 3445 | { |
| 3446 | eassert (h->index_size > 1); | 3446 | eassert (h->index_bits > 0); |
| 3447 | xfree (h->index); | 3447 | xfree (h->index); |
| 3448 | xfree (h->key_and_value); | 3448 | xfree (h->key_and_value); |
| 3449 | xfree (h->next); | 3449 | xfree (h->next); |
| @@ -3451,10 +3451,19 @@ cleanup_vector (struct Lisp_Vector *vector) | |||
| 3451 | ptrdiff_t bytes = (h->table_size * (2 * sizeof *h->key_and_value | 3451 | ptrdiff_t bytes = (h->table_size * (2 * sizeof *h->key_and_value |
| 3452 | + sizeof *h->hash | 3452 | + sizeof *h->hash |
| 3453 | + sizeof *h->next) | 3453 | + sizeof *h->next) |
| 3454 | + h->index_size * sizeof *h->index); | 3454 | + hash_table_index_size (h) * sizeof *h->index); |
| 3455 | hash_table_allocated_bytes -= bytes; | 3455 | hash_table_allocated_bytes -= bytes; |
| 3456 | } | 3456 | } |
| 3457 | } | 3457 | } |
| 3458 | break; | ||
| 3459 | case PVEC_OBARRAY: | ||
| 3460 | { | ||
| 3461 | struct Lisp_Obarray *o = PSEUDOVEC_STRUCT (vector, Lisp_Obarray); | ||
| 3462 | xfree (o->buckets); | ||
| 3463 | ptrdiff_t bytes = obarray_size (o) * sizeof *o->buckets; | ||
| 3464 | hash_table_allocated_bytes -= bytes; | ||
| 3465 | } | ||
| 3466 | break; | ||
| 3458 | /* Keep the switch exhaustive. */ | 3467 | /* Keep the switch exhaustive. */ |
| 3459 | case PVEC_NORMAL_VECTOR: | 3468 | case PVEC_NORMAL_VECTOR: |
| 3460 | case PVEC_FREE: | 3469 | case PVEC_FREE: |
| @@ -3951,7 +3960,7 @@ Its value is void, and its function definition and property list are nil. */) | |||
| 3951 | if (symbol_free_list) | 3960 | if (symbol_free_list) |
| 3952 | { | 3961 | { |
| 3953 | ASAN_UNPOISON_SYMBOL (symbol_free_list); | 3962 | ASAN_UNPOISON_SYMBOL (symbol_free_list); |
| 3954 | XSETSYMBOL (val, symbol_free_list); | 3963 | val = make_lisp_symbol (symbol_free_list); |
| 3955 | symbol_free_list = symbol_free_list->u.s.next; | 3964 | symbol_free_list = symbol_free_list->u.s.next; |
| 3956 | } | 3965 | } |
| 3957 | else | 3966 | else |
| @@ -3967,7 +3976,7 @@ Its value is void, and its function definition and property list are nil. */) | |||
| 3967 | } | 3976 | } |
| 3968 | 3977 | ||
| 3969 | ASAN_UNPOISON_SYMBOL (&symbol_block->symbols[symbol_block_index]); | 3978 | ASAN_UNPOISON_SYMBOL (&symbol_block->symbols[symbol_block_index]); |
| 3970 | XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); | 3979 | val = make_lisp_symbol (&symbol_block->symbols[symbol_block_index]); |
| 3971 | symbol_block_index++; | 3980 | symbol_block_index++; |
| 3972 | } | 3981 | } |
| 3973 | 3982 | ||
| @@ -5632,7 +5641,8 @@ valid_lisp_object_p (Lisp_Object obj) | |||
| 5632 | return 0; | 5641 | return 0; |
| 5633 | } | 5642 | } |
| 5634 | 5643 | ||
| 5635 | /* Like xmalloc, but makes allocation count toward the total consing. | 5644 | /* Like xmalloc, but makes allocation count toward the total consing |
| 5645 | and hash table or obarray usage. | ||
| 5636 | Return NULL for a zero-sized allocation. */ | 5646 | Return NULL for a zero-sized allocation. */ |
| 5637 | void * | 5647 | void * |
| 5638 | hash_table_alloc_bytes (ptrdiff_t nbytes) | 5648 | hash_table_alloc_bytes (ptrdiff_t nbytes) |
| @@ -5959,7 +5969,8 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) | |||
| 5959 | for (ptrdiff_t i = 0; i < nvalues; i++) | 5969 | for (ptrdiff_t i = 0; i < nvalues; i++) |
| 5960 | pure->key_and_value[i] = purecopy (table->key_and_value[i]); | 5970 | pure->key_and_value[i] = purecopy (table->key_and_value[i]); |
| 5961 | 5971 | ||
| 5962 | ptrdiff_t index_bytes = table->index_size * sizeof *table->index; | 5972 | ptrdiff_t index_bytes = hash_table_index_size (table) |
| 5973 | * sizeof *table->index; | ||
| 5963 | pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index); | 5974 | pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index); |
| 5964 | memcpy (pure->index, table->index, index_bytes); | 5975 | memcpy (pure->index, table->index, index_bytes); |
| 5965 | } | 5976 | } |
| @@ -6033,8 +6044,7 @@ purecopy (Lisp_Object obj) | |||
| 6033 | return obj; /* Don't hash cons it. */ | 6044 | return obj; /* Don't hash cons it. */ |
| 6034 | } | 6045 | } |
| 6035 | 6046 | ||
| 6036 | struct Lisp_Hash_Table *h = purecopy_hash_table (table); | 6047 | obj = make_lisp_hash_table (purecopy_hash_table (table)); |
| 6037 | XSET_HASH_TABLE (obj, h); | ||
| 6038 | } | 6048 | } |
| 6039 | else if (COMPILEDP (obj) || VECTORP (obj) || RECORDP (obj)) | 6049 | else if (COMPILEDP (obj) || VECTORP (obj) || RECORDP (obj)) |
| 6040 | { | 6050 | { |
| @@ -7310,6 +7320,14 @@ process_mark_stack (ptrdiff_t base_sp) | |||
| 7310 | break; | 7320 | break; |
| 7311 | } | 7321 | } |
| 7312 | 7322 | ||
| 7323 | case PVEC_OBARRAY: | ||
| 7324 | { | ||
| 7325 | struct Lisp_Obarray *o = (struct Lisp_Obarray *)ptr; | ||
| 7326 | set_vector_marked (ptr); | ||
| 7327 | mark_stack_push_values (o->buckets, obarray_size (o)); | ||
| 7328 | break; | ||
| 7329 | } | ||
| 7330 | |||
| 7313 | case PVEC_CHAR_TABLE: | 7331 | case PVEC_CHAR_TABLE: |
| 7314 | case PVEC_SUB_CHAR_TABLE: | 7332 | case PVEC_SUB_CHAR_TABLE: |
| 7315 | mark_char_table (ptr, (enum pvec_type) pvectype); | 7333 | mark_char_table (ptr, (enum pvec_type) pvectype); |
| @@ -7380,12 +7398,8 @@ process_mark_stack (ptrdiff_t base_sp) | |||
| 7380 | mark_stack_push_value (SYMBOL_VAL (ptr)); | 7398 | mark_stack_push_value (SYMBOL_VAL (ptr)); |
| 7381 | break; | 7399 | break; |
| 7382 | case SYMBOL_VARALIAS: | 7400 | case SYMBOL_VARALIAS: |
| 7383 | { | 7401 | mark_stack_push_value (make_lisp_symbol (SYMBOL_ALIAS (ptr))); |
| 7384 | Lisp_Object tem; | 7402 | break; |
| 7385 | XSETSYMBOL (tem, SYMBOL_ALIAS (ptr)); | ||
| 7386 | mark_stack_push_value (tem); | ||
| 7387 | break; | ||
| 7388 | } | ||
| 7389 | case SYMBOL_LOCALIZED: | 7403 | case SYMBOL_LOCALIZED: |
| 7390 | { | 7404 | { |
| 7391 | struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr); | 7405 | struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr); |
diff --git a/src/android.c b/src/android.c index 4a74f5b2af4..41481afa475 100644 --- a/src/android.c +++ b/src/android.c | |||
| @@ -40,6 +40,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 40 | 40 | ||
| 41 | #include <sys/param.h> | 41 | #include <sys/param.h> |
| 42 | #include <sys/stat.h> | 42 | #include <sys/stat.h> |
| 43 | #include <sys/select.h> | ||
| 43 | 44 | ||
| 44 | /* Old NDK versions lack MIN and MAX. */ | 45 | /* Old NDK versions lack MIN and MAX. */ |
| 45 | #include <minmax.h> | 46 | #include <minmax.h> |
| @@ -112,6 +113,8 @@ struct android_emacs_window | |||
| 112 | jmethodID define_cursor; | 113 | jmethodID define_cursor; |
| 113 | jmethodID damage_rect; | 114 | jmethodID damage_rect; |
| 114 | jmethodID recreate_activity; | 115 | jmethodID recreate_activity; |
| 116 | jmethodID clear_window; | ||
| 117 | jmethodID clear_area; | ||
| 115 | }; | 118 | }; |
| 116 | 119 | ||
| 117 | struct android_emacs_cursor | 120 | struct android_emacs_cursor |
| @@ -152,6 +155,13 @@ static char *android_files_dir; | |||
| 152 | /* The Java environment being used for the main thread. */ | 155 | /* The Java environment being used for the main thread. */ |
| 153 | JNIEnv *android_java_env; | 156 | JNIEnv *android_java_env; |
| 154 | 157 | ||
| 158 | #ifdef THREADS_ENABLED | ||
| 159 | |||
| 160 | /* The Java VM new threads attach to. */ | ||
| 161 | JavaVM *android_jvm; | ||
| 162 | |||
| 163 | #endif /* THREADS_ENABLED */ | ||
| 164 | |||
| 155 | /* The EmacsGC class. */ | 165 | /* The EmacsGC class. */ |
| 156 | static jclass emacs_gc_class; | 166 | static jclass emacs_gc_class; |
| 157 | 167 | ||
| @@ -496,6 +506,9 @@ android_handle_sigusr1 (int sig, siginfo_t *siginfo, void *arg) | |||
| 496 | This should ideally be defined further down. */ | 506 | This should ideally be defined further down. */ |
| 497 | static sem_t android_query_sem; | 507 | static sem_t android_query_sem; |
| 498 | 508 | ||
| 509 | /* ID of the Emacs thread. */ | ||
| 510 | static pthread_t main_thread_id; | ||
| 511 | |||
| 499 | /* Set up the global event queue by initializing the mutex and two | 512 | /* Set up the global event queue by initializing the mutex and two |
| 500 | condition variables, and the linked list of events. This must be | 513 | condition variables, and the linked list of events. This must be |
| 501 | called before starting the Emacs thread. Also, initialize the | 514 | called before starting the Emacs thread. Also, initialize the |
| @@ -531,6 +544,8 @@ android_init_events (void) | |||
| 531 | event_queue.events.next = &event_queue.events; | 544 | event_queue.events.next = &event_queue.events; |
| 532 | event_queue.events.last = &event_queue.events; | 545 | event_queue.events.last = &event_queue.events; |
| 533 | 546 | ||
| 547 | main_thread_id = pthread_self (); | ||
| 548 | |||
| 534 | #if __ANDROID_API__ >= 16 | 549 | #if __ANDROID_API__ >= 16 |
| 535 | 550 | ||
| 536 | /* Before starting the select thread, make sure the disposition for | 551 | /* Before starting the select thread, make sure the disposition for |
| @@ -579,10 +594,6 @@ android_pending (void) | |||
| 579 | return i; | 594 | return i; |
| 580 | } | 595 | } |
| 581 | 596 | ||
| 582 | /* Forward declaration. */ | ||
| 583 | |||
| 584 | static void android_check_query (void); | ||
| 585 | |||
| 586 | /* Wait for events to become available synchronously. Return once an | 597 | /* Wait for events to become available synchronously. Return once an |
| 587 | event arrives. Also, reply to the UI thread whenever it requires a | 598 | event arrives. Also, reply to the UI thread whenever it requires a |
| 588 | response. */ | 599 | response. */ |
| @@ -732,6 +743,12 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds, | |||
| 732 | static char byte; | 743 | static char byte; |
| 733 | #endif | 744 | #endif |
| 734 | 745 | ||
| 746 | #ifdef THREADS_ENABLED | ||
| 747 | if (!pthread_equal (pthread_self (), main_thread_id)) | ||
| 748 | return pselect (nfds, readfds, writefds, exceptfds, timeout, | ||
| 749 | NULL); | ||
| 750 | #endif /* THREADS_ENABLED */ | ||
| 751 | |||
| 735 | /* Since Emacs is reading keyboard input again, signify that queries | 752 | /* Since Emacs is reading keyboard input again, signify that queries |
| 736 | from input methods are no longer ``urgent''. */ | 753 | from input methods are no longer ``urgent''. */ |
| 737 | 754 | ||
| @@ -837,9 +854,11 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds, | |||
| 837 | if (nfds_return < 0) | 854 | if (nfds_return < 0) |
| 838 | errno = EINTR; | 855 | errno = EINTR; |
| 839 | 856 | ||
| 857 | #ifndef THREADS_ENABLED | ||
| 840 | /* Now check for and run anything the UI thread wants to run in the | 858 | /* Now check for and run anything the UI thread wants to run in the |
| 841 | main thread. */ | 859 | main thread. */ |
| 842 | android_check_query (); | 860 | android_check_query (); |
| 861 | #endif /* THREADS_ENABLED */ | ||
| 843 | 862 | ||
| 844 | return nfds_return; | 863 | return nfds_return; |
| 845 | } | 864 | } |
| @@ -1315,12 +1334,17 @@ NATIVE_NAME (setEmacsParams) (JNIEnv *env, jobject object, | |||
| 1315 | const char *java_string; | 1334 | const char *java_string; |
| 1316 | struct stat statb; | 1335 | struct stat statb; |
| 1317 | 1336 | ||
| 1337 | #ifdef THREADS_ENABLED | ||
| 1338 | /* Save the Java VM. */ | ||
| 1339 | if ((*env)->GetJavaVM (env, &android_jvm)) | ||
| 1340 | emacs_abort (); | ||
| 1341 | #endif /* THREADS_ENABLED */ | ||
| 1342 | |||
| 1318 | /* Set the Android API level early, as it is used by | 1343 | /* Set the Android API level early, as it is used by |
| 1319 | `android_vfs_init'. */ | 1344 | `android_vfs_init'. */ |
| 1320 | android_api_level = api_level; | 1345 | android_api_level = api_level; |
| 1321 | 1346 | ||
| 1322 | /* This function should only be called from the main thread. */ | 1347 | /* This function should only be called from the main thread. */ |
| 1323 | |||
| 1324 | android_pixel_density_x = pixel_density_x; | 1348 | android_pixel_density_x = pixel_density_x; |
| 1325 | android_pixel_density_y = pixel_density_y; | 1349 | android_pixel_density_y = pixel_density_y; |
| 1326 | android_scaled_pixel_density = scaled_density; | 1350 | android_scaled_pixel_density = scaled_density; |
| @@ -1583,16 +1607,13 @@ android_init_emacs_service (void) | |||
| 1583 | FIND_METHOD (draw_point, "drawPoint", | 1607 | FIND_METHOD (draw_point, "drawPoint", |
| 1584 | "(Lorg/gnu/emacs/EmacsDrawable;" | 1608 | "(Lorg/gnu/emacs/EmacsDrawable;" |
| 1585 | "Lorg/gnu/emacs/EmacsGC;II)V"); | 1609 | "Lorg/gnu/emacs/EmacsGC;II)V"); |
| 1586 | FIND_METHOD (clear_window, "clearWindow", | ||
| 1587 | "(Lorg/gnu/emacs/EmacsWindow;)V"); | ||
| 1588 | FIND_METHOD (clear_area, "clearArea", | ||
| 1589 | "(Lorg/gnu/emacs/EmacsWindow;IIII)V"); | ||
| 1590 | FIND_METHOD (ring_bell, "ringBell", "(I)V"); | 1610 | FIND_METHOD (ring_bell, "ringBell", "(I)V"); |
| 1591 | FIND_METHOD (query_tree, "queryTree", | 1611 | FIND_METHOD (query_tree, "queryTree", |
| 1592 | "(Lorg/gnu/emacs/EmacsWindow;)[S"); | 1612 | "(Lorg/gnu/emacs/EmacsWindow;)[S"); |
| 1593 | FIND_METHOD (get_screen_width, "getScreenWidth", "(Z)I"); | 1613 | FIND_METHOD (get_screen_width, "getScreenWidth", "(Z)I"); |
| 1594 | FIND_METHOD (get_screen_height, "getScreenHeight", "(Z)I"); | 1614 | FIND_METHOD (get_screen_height, "getScreenHeight", "(Z)I"); |
| 1595 | FIND_METHOD (detect_mouse, "detectMouse", "()Z"); | 1615 | FIND_METHOD (detect_mouse, "detectMouse", "()Z"); |
| 1616 | FIND_METHOD (detect_keyboard, "detectKeyboard", "()Z"); | ||
| 1596 | FIND_METHOD (name_keysym, "nameKeysym", "(I)Ljava/lang/String;"); | 1617 | FIND_METHOD (name_keysym, "nameKeysym", "(I)Ljava/lang/String;"); |
| 1597 | FIND_METHOD (browse_url, "browseUrl", "(Ljava/lang/String;Z)" | 1618 | FIND_METHOD (browse_url, "browseUrl", "(Ljava/lang/String;Z)" |
| 1598 | "Ljava/lang/String;"); | 1619 | "Ljava/lang/String;"); |
| @@ -1809,6 +1830,8 @@ android_init_emacs_window (void) | |||
| 1809 | android_damage_window. */ | 1830 | android_damage_window. */ |
| 1810 | FIND_METHOD (damage_rect, "damageRect", "(IIII)V"); | 1831 | FIND_METHOD (damage_rect, "damageRect", "(IIII)V"); |
| 1811 | FIND_METHOD (recreate_activity, "recreateActivity", "()V"); | 1832 | FIND_METHOD (recreate_activity, "recreateActivity", "()V"); |
| 1833 | FIND_METHOD (clear_window, "clearWindow", "()V"); | ||
| 1834 | FIND_METHOD (clear_area, "clearArea", "(IIII)V"); | ||
| 1812 | #undef FIND_METHOD | 1835 | #undef FIND_METHOD |
| 1813 | } | 1836 | } |
| 1814 | 1837 | ||
| @@ -2496,6 +2519,8 @@ JNIEXPORT jboolean JNICALL | |||
| 2496 | NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env, | 2519 | NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env, |
| 2497 | jobject object) | 2520 | jobject object) |
| 2498 | { | 2521 | { |
| 2522 | JNI_STACK_ALIGNMENT_PROLOGUE; | ||
| 2523 | |||
| 2499 | /* Yes, android_pass_multimedia_buttons_to_system is being | 2524 | /* Yes, android_pass_multimedia_buttons_to_system is being |
| 2500 | read from the UI thread. */ | 2525 | read from the UI thread. */ |
| 2501 | return !android_pass_multimedia_buttons_to_system; | 2526 | return !android_pass_multimedia_buttons_to_system; |
| @@ -2504,6 +2529,8 @@ NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env, | |||
| 2504 | JNIEXPORT jboolean JNICALL | 2529 | JNIEXPORT jboolean JNICALL |
| 2505 | NATIVE_NAME (shouldForwardCtrlSpace) (JNIEnv *env, jobject object) | 2530 | NATIVE_NAME (shouldForwardCtrlSpace) (JNIEnv *env, jobject object) |
| 2506 | { | 2531 | { |
| 2532 | JNI_STACK_ALIGNMENT_PROLOGUE; | ||
| 2533 | |||
| 2507 | return !android_intercept_control_space; | 2534 | return !android_intercept_control_space; |
| 2508 | } | 2535 | } |
| 2509 | 2536 | ||
| @@ -2607,6 +2634,8 @@ JNIEXPORT void JNICALL | |||
| 2607 | NATIVE_NAME (notifyPixelsChanged) (JNIEnv *env, jobject object, | 2634 | NATIVE_NAME (notifyPixelsChanged) (JNIEnv *env, jobject object, |
| 2608 | jobject bitmap) | 2635 | jobject bitmap) |
| 2609 | { | 2636 | { |
| 2637 | JNI_STACK_ALIGNMENT_PROLOGUE; | ||
| 2638 | |||
| 2610 | void *data; | 2639 | void *data; |
| 2611 | 2640 | ||
| 2612 | /* Lock and unlock the bitmap. This calls | 2641 | /* Lock and unlock the bitmap. This calls |
| @@ -2660,6 +2689,8 @@ NATIVE_NAME (answerQuerySpin) (JNIEnv *env, jobject object) | |||
| 2660 | JNIEXPORT void JNICALL | 2689 | JNIEXPORT void JNICALL |
| 2661 | NATIVE_NAME (setupSystemThread) (void) | 2690 | NATIVE_NAME (setupSystemThread) (void) |
| 2662 | { | 2691 | { |
| 2692 | JNI_STACK_ALIGNMENT_PROLOGUE; | ||
| 2693 | |||
| 2663 | sigset_t sigset; | 2694 | sigset_t sigset; |
| 2664 | 2695 | ||
| 2665 | /* Block everything except for SIGSEGV and SIGBUS; those two are | 2696 | /* Block everything except for SIGSEGV and SIGBUS; those two are |
| @@ -3408,10 +3439,9 @@ android_clear_window (android_window handle) | |||
| 3408 | window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); | 3439 | window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); |
| 3409 | 3440 | ||
| 3410 | (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, | 3441 | (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, |
| 3411 | emacs_service, | 3442 | window, |
| 3412 | service_class.class, | 3443 | window_class.class, |
| 3413 | service_class.clear_window, | 3444 | window_class.clear_window); |
| 3414 | window); | ||
| 3415 | android_exception_check (); | 3445 | android_exception_check (); |
| 3416 | } | 3446 | } |
| 3417 | 3447 | ||
| @@ -4722,10 +4752,10 @@ android_clear_area (android_window handle, int x, int y, | |||
| 4722 | window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); | 4752 | window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); |
| 4723 | 4753 | ||
| 4724 | (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, | 4754 | (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, |
| 4725 | emacs_service, | 4755 | window, |
| 4726 | service_class.class, | 4756 | window_class.class, |
| 4727 | service_class.clear_area, | 4757 | window_class.clear_area, |
| 4728 | window, (jint) x, (jint) y, | 4758 | (jint) x, (jint) y, |
| 4729 | (jint) width, (jint) height); | 4759 | (jint) width, (jint) height); |
| 4730 | } | 4760 | } |
| 4731 | 4761 | ||
| @@ -5626,6 +5656,21 @@ android_detect_mouse (void) | |||
| 5626 | return rc; | 5656 | return rc; |
| 5627 | } | 5657 | } |
| 5628 | 5658 | ||
| 5659 | bool | ||
| 5660 | android_detect_keyboard (void) | ||
| 5661 | { | ||
| 5662 | bool rc; | ||
| 5663 | jmethodID method; | ||
| 5664 | |||
| 5665 | method = service_class.detect_keyboard; | ||
| 5666 | rc = (*android_java_env)->CallNonvirtualBooleanMethod (android_java_env, | ||
| 5667 | emacs_service, | ||
| 5668 | service_class.class, | ||
| 5669 | method); | ||
| 5670 | android_exception_check (); | ||
| 5671 | return rc; | ||
| 5672 | } | ||
| 5673 | |||
| 5629 | void | 5674 | void |
| 5630 | android_set_dont_focus_on_map (android_window handle, | 5675 | android_set_dont_focus_on_map (android_window handle, |
| 5631 | bool no_focus_on_map) | 5676 | bool no_focus_on_map) |
| @@ -6701,7 +6746,7 @@ static void *android_query_context; | |||
| 6701 | /* Run any function that the UI thread has asked to run, and then | 6746 | /* Run any function that the UI thread has asked to run, and then |
| 6702 | signal its completion. */ | 6747 | signal its completion. */ |
| 6703 | 6748 | ||
| 6704 | static void | 6749 | void |
| 6705 | android_check_query (void) | 6750 | android_check_query (void) |
| 6706 | { | 6751 | { |
| 6707 | void (*proc) (void *); | 6752 | void (*proc) (void *); |
diff --git a/src/android.h b/src/android.h index 2f5f32037c5..e1834cebf68 100644 --- a/src/android.h +++ b/src/android.h | |||
| @@ -24,6 +24,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 24 | a table of function pointers. */ | 24 | a table of function pointers. */ |
| 25 | 25 | ||
| 26 | #ifndef _ANDROID_H_ | 26 | #ifndef _ANDROID_H_ |
| 27 | #define _ANDROID_H_ | ||
| 28 | |||
| 27 | #ifndef ANDROID_STUBIFY | 29 | #ifndef ANDROID_STUBIFY |
| 28 | #include <jni.h> | 30 | #include <jni.h> |
| 29 | #include <pwd.h> | 31 | #include <pwd.h> |
| @@ -103,6 +105,7 @@ extern int android_get_screen_height (void); | |||
| 103 | extern int android_get_mm_width (void); | 105 | extern int android_get_mm_width (void); |
| 104 | extern int android_get_mm_height (void); | 106 | extern int android_get_mm_height (void); |
| 105 | extern bool android_detect_mouse (void); | 107 | extern bool android_detect_mouse (void); |
| 108 | extern bool android_detect_keyboard (void); | ||
| 106 | 109 | ||
| 107 | extern void android_set_dont_focus_on_map (android_window, bool); | 110 | extern void android_set_dont_focus_on_map (android_window, bool); |
| 108 | extern void android_set_dont_accept_focus (android_window, bool); | 111 | extern void android_set_dont_accept_focus (android_window, bool); |
| @@ -225,6 +228,7 @@ extern void android_display_toast (const char *); | |||
| 225 | 228 | ||
| 226 | /* Event loop functions. */ | 229 | /* Event loop functions. */ |
| 227 | 230 | ||
| 231 | extern void android_check_query (void); | ||
| 228 | extern void android_check_query_urgent (void); | 232 | extern void android_check_query_urgent (void); |
| 229 | extern int android_run_in_emacs_thread (void (*) (void *), void *); | 233 | extern int android_run_in_emacs_thread (void (*) (void *), void *); |
| 230 | extern void android_write_event (union android_event *); | 234 | extern void android_write_event (union android_event *); |
| @@ -265,6 +269,7 @@ struct android_emacs_service | |||
| 265 | jmethodID get_screen_width; | 269 | jmethodID get_screen_width; |
| 266 | jmethodID get_screen_height; | 270 | jmethodID get_screen_height; |
| 267 | jmethodID detect_mouse; | 271 | jmethodID detect_mouse; |
| 272 | jmethodID detect_keyboard; | ||
| 268 | jmethodID name_keysym; | 273 | jmethodID name_keysym; |
| 269 | jmethodID browse_url; | 274 | jmethodID browse_url; |
| 270 | jmethodID restart_emacs; | 275 | jmethodID restart_emacs; |
| @@ -297,6 +302,10 @@ struct android_emacs_service | |||
| 297 | 302 | ||
| 298 | extern JNIEnv *android_java_env; | 303 | extern JNIEnv *android_java_env; |
| 299 | 304 | ||
| 305 | #ifdef THREADS_ENABLED | ||
| 306 | extern JavaVM *android_jvm; | ||
| 307 | #endif /* THREADS_ENABLED */ | ||
| 308 | |||
| 300 | /* The EmacsService object. */ | 309 | /* The EmacsService object. */ |
| 301 | extern jobject emacs_service; | 310 | extern jobject emacs_service; |
| 302 | 311 | ||
diff --git a/src/androidfns.c b/src/androidfns.c index eaecb78338b..0675a0a3c98 100644 --- a/src/androidfns.c +++ b/src/androidfns.c | |||
| @@ -2287,6 +2287,57 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, | |||
| 2287 | 2287 | ||
| 2288 | goto start_timer; | 2288 | goto start_timer; |
| 2289 | } | 2289 | } |
| 2290 | else if (tooltip_reuse_hidden_frame && BASE_EQ (frame, tip_last_frame)) | ||
| 2291 | { | ||
| 2292 | bool delete = false; | ||
| 2293 | Lisp_Object tail, elt, parm, last; | ||
| 2294 | |||
| 2295 | /* Check if every parameter in PARMS has the same value in | ||
| 2296 | tip_last_parms. This may destruct tip_last_parms which, | ||
| 2297 | however, will be recreated below. */ | ||
| 2298 | for (tail = parms; CONSP (tail); tail = XCDR (tail)) | ||
| 2299 | { | ||
| 2300 | elt = XCAR (tail); | ||
| 2301 | parm = CAR (elt); | ||
| 2302 | /* The left, top, right and bottom parameters are handled | ||
| 2303 | by compute_tip_xy so they can be ignored here. */ | ||
| 2304 | if (!EQ (parm, Qleft) && !EQ (parm, Qtop) | ||
| 2305 | && !EQ (parm, Qright) && !EQ (parm, Qbottom)) | ||
| 2306 | { | ||
| 2307 | last = Fassq (parm, tip_last_parms); | ||
| 2308 | if (NILP (Fequal (CDR (elt), CDR (last)))) | ||
| 2309 | { | ||
| 2310 | /* We lost, delete the old tooltip. */ | ||
| 2311 | delete = true; | ||
| 2312 | break; | ||
| 2313 | } | ||
| 2314 | else | ||
| 2315 | tip_last_parms | ||
| 2316 | = call2 (Qassq_delete_all, parm, tip_last_parms); | ||
| 2317 | } | ||
| 2318 | else | ||
| 2319 | tip_last_parms | ||
| 2320 | = call2 (Qassq_delete_all, parm, tip_last_parms); | ||
| 2321 | } | ||
| 2322 | |||
| 2323 | /* Now check if every parameter in what is left of | ||
| 2324 | tip_last_parms with a non-nil value has an association in | ||
| 2325 | PARMS. */ | ||
| 2326 | for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail)) | ||
| 2327 | { | ||
| 2328 | elt = XCAR (tail); | ||
| 2329 | parm = CAR (elt); | ||
| 2330 | if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) | ||
| 2331 | && !EQ (parm, Qbottom) && !NILP (CDR (elt))) | ||
| 2332 | { | ||
| 2333 | /* We lost, delete the old tooltip. */ | ||
| 2334 | delete = true; | ||
| 2335 | break; | ||
| 2336 | } | ||
| 2337 | } | ||
| 2338 | |||
| 2339 | android_hide_tip (delete); | ||
| 2340 | } | ||
| 2290 | else | 2341 | else |
| 2291 | android_hide_tip (true); | 2342 | android_hide_tip (true); |
| 2292 | } | 2343 | } |
| @@ -2453,7 +2504,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0, | |||
| 2453 | #endif /* 0 */ | 2504 | #endif /* 0 */ |
| 2454 | return Qnil; | 2505 | return Qnil; |
| 2455 | #else /* !ANDROID_STUBIFY */ | 2506 | #else /* !ANDROID_STUBIFY */ |
| 2456 | return android_hide_tip (true); | 2507 | return android_hide_tip (!tooltip_reuse_hidden_frame); |
| 2457 | #endif /* ANDROID_STUBIFY */ | 2508 | #endif /* ANDROID_STUBIFY */ |
| 2458 | } | 2509 | } |
| 2459 | 2510 | ||
| @@ -2476,6 +2527,25 @@ there is no mouse. */) | |||
| 2476 | #endif | 2527 | #endif |
| 2477 | } | 2528 | } |
| 2478 | 2529 | ||
| 2530 | DEFUN ("android-detect-keyboard", Fandroid_detect_keyboard, | ||
| 2531 | Sandroid_detect_keyboard, 0, 0, 0, | ||
| 2532 | doc: /* Return whether a keyboard is connected. | ||
| 2533 | Return non-nil if a key is connected to this computer, or nil | ||
| 2534 | if there is no keyboard. */) | ||
| 2535 | (void) | ||
| 2536 | { | ||
| 2537 | #ifndef ANDROID_STUBIFY | ||
| 2538 | /* If no display connection is present, just return nil. */ | ||
| 2539 | |||
| 2540 | if (!android_init_gui) | ||
| 2541 | return Qnil; | ||
| 2542 | |||
| 2543 | return android_detect_keyboard () ? Qt : Qnil; | ||
| 2544 | #else /* ANDROID_STUBIFY */ | ||
| 2545 | return Qt; | ||
| 2546 | #endif /* ANDROID_STUBIFY */ | ||
| 2547 | } | ||
| 2548 | |||
| 2479 | DEFUN ("android-toggle-on-screen-keyboard", | 2549 | DEFUN ("android-toggle-on-screen-keyboard", |
| 2480 | Fandroid_toggle_on_screen_keyboard, | 2550 | Fandroid_toggle_on_screen_keyboard, |
| 2481 | Sandroid_toggle_on_screen_keyboard, 2, 2, 0, | 2551 | Sandroid_toggle_on_screen_keyboard, 2, 2, 0, |
| @@ -3197,6 +3267,10 @@ syms_of_androidfns_for_pdumper (void) | |||
| 3197 | jstring string; | 3267 | jstring string; |
| 3198 | Lisp_Object language, country, script, variant; | 3268 | Lisp_Object language, country, script, variant; |
| 3199 | const char *data; | 3269 | const char *data; |
| 3270 | FILE *fd; | ||
| 3271 | char *line; | ||
| 3272 | size_t size; | ||
| 3273 | long pid; | ||
| 3200 | 3274 | ||
| 3201 | /* Find the Locale class. */ | 3275 | /* Find the Locale class. */ |
| 3202 | 3276 | ||
| @@ -3367,6 +3441,35 @@ syms_of_androidfns_for_pdumper (void) | |||
| 3367 | 3441 | ||
| 3368 | /* Set Vandroid_os_language. */ | 3442 | /* Set Vandroid_os_language. */ |
| 3369 | Vandroid_os_language = list4 (language, country, script, variant); | 3443 | Vandroid_os_language = list4 (language, country, script, variant); |
| 3444 | |||
| 3445 | /* Detect whether Emacs is running under libloader.so or another | ||
| 3446 | process tracing mechanism, and disable `android_use_exec_loader' if | ||
| 3447 | so, leaving subprocesses started by Emacs to the care of that | ||
| 3448 | loader instance. */ | ||
| 3449 | |||
| 3450 | if (android_get_current_api_level () >= 29) /* Q */ | ||
| 3451 | { | ||
| 3452 | fd = fopen ("/proc/self/status", "r"); | ||
| 3453 | if (!fd) | ||
| 3454 | return; | ||
| 3455 | |||
| 3456 | line = NULL; | ||
| 3457 | while (getline (&line, &size, fd) != -1) | ||
| 3458 | { | ||
| 3459 | if (strncmp (line, "TracerPid:", sizeof "TracerPid:" - 1)) | ||
| 3460 | continue; | ||
| 3461 | |||
| 3462 | pid = atol (line + sizeof "TracerPid:" - 1); | ||
| 3463 | |||
| 3464 | if (pid) | ||
| 3465 | android_use_exec_loader = false; | ||
| 3466 | |||
| 3467 | break; | ||
| 3468 | } | ||
| 3469 | |||
| 3470 | free (line); | ||
| 3471 | fclose (fd); | ||
| 3472 | } | ||
| 3370 | } | 3473 | } |
| 3371 | 3474 | ||
| 3372 | #endif /* ANDROID_STUBIFY */ | 3475 | #endif /* ANDROID_STUBIFY */ |
| @@ -3560,6 +3663,7 @@ language to be US English if LANGUAGE is empty. */); | |||
| 3560 | defsubr (&Sx_show_tip); | 3663 | defsubr (&Sx_show_tip); |
| 3561 | defsubr (&Sx_hide_tip); | 3664 | defsubr (&Sx_hide_tip); |
| 3562 | defsubr (&Sandroid_detect_mouse); | 3665 | defsubr (&Sandroid_detect_mouse); |
| 3666 | defsubr (&Sandroid_detect_keyboard); | ||
| 3563 | defsubr (&Sandroid_toggle_on_screen_keyboard); | 3667 | defsubr (&Sandroid_toggle_on_screen_keyboard); |
| 3564 | defsubr (&Sx_server_vendor); | 3668 | defsubr (&Sx_server_vendor); |
| 3565 | defsubr (&Sx_server_version); | 3669 | defsubr (&Sx_server_version); |
diff --git a/src/androidselect.c b/src/androidselect.c index 5b23c559d2c..61f1c6045db 100644 --- a/src/androidselect.c +++ b/src/androidselect.c | |||
| @@ -237,15 +237,21 @@ DEFUN ("android-clipboard-exists-p", Fandroid_clipboard_exists_p, | |||
| 237 | return rc ? Qt : Qnil; | 237 | return rc ? Qt : Qnil; |
| 238 | } | 238 | } |
| 239 | 239 | ||
| 240 | DEFUN ("android-browse-url", Fandroid_browse_url, | 240 | DEFUN ("android-browse-url-internal", Fandroid_browse_url_internal, |
| 241 | Sandroid_browse_url, 1, 2, 0, | 241 | Sandroid_browse_url_internal, 1, 2, 0, |
| 242 | doc: /* Open URL in an external application. URL should be a | 242 | doc: /* Open URL in an external application. |
| 243 | URL-encoded URL with a scheme specified unless SEND is non-nil. | 243 | |
| 244 | Signal an error upon failure. | 244 | URL should be a URL-encoded URL with a scheme specified unless SEND is |
| 245 | non-nil. Signal an error upon failure. | ||
| 245 | 246 | ||
| 246 | If SEND is nil, start a program that is able to display the URL, such | 247 | If SEND is nil, start a program that is able to display the URL, such |
| 247 | as a web browser. Otherwise, try to share URL using programs such as | 248 | as a web browser. Otherwise, try to share URL using programs such as |
| 248 | email clients. */) | 249 | email clients. |
| 250 | |||
| 251 | If URL is a file URI, convert it into a `content' address accessible to | ||
| 252 | other programs. Files inside the /content or /assets directories cannot | ||
| 253 | be opened through such addresses, which this function does not provide | ||
| 254 | for. Use `android-browse-url' instead. */) | ||
| 249 | (Lisp_Object url, Lisp_Object send) | 255 | (Lisp_Object url, Lisp_Object send) |
| 250 | { | 256 | { |
| 251 | Lisp_Object value; | 257 | Lisp_Object value; |
| @@ -803,7 +809,7 @@ syms_of_androidselect (void) | |||
| 803 | defsubr (&Sandroid_set_clipboard); | 809 | defsubr (&Sandroid_set_clipboard); |
| 804 | defsubr (&Sandroid_get_clipboard); | 810 | defsubr (&Sandroid_get_clipboard); |
| 805 | defsubr (&Sandroid_clipboard_exists_p); | 811 | defsubr (&Sandroid_clipboard_exists_p); |
| 806 | defsubr (&Sandroid_browse_url); | 812 | defsubr (&Sandroid_browse_url_internal); |
| 807 | defsubr (&Sandroid_get_clipboard_targets); | 813 | defsubr (&Sandroid_get_clipboard_targets); |
| 808 | defsubr (&Sandroid_get_clipboard_data); | 814 | defsubr (&Sandroid_get_clipboard_data); |
| 809 | 815 | ||
diff --git a/src/androidterm.c b/src/androidterm.c index d4612bb20fa..2bd2b45743d 100644 --- a/src/androidterm.c +++ b/src/androidterm.c | |||
| @@ -495,8 +495,8 @@ android_note_mouse_movement (struct frame *frame, | |||
| 495 | /* Has the mouse moved off the glyph it was on at the last sighting? */ | 495 | /* Has the mouse moved off the glyph it was on at the last sighting? */ |
| 496 | r = &dpyinfo->last_mouse_glyph; | 496 | r = &dpyinfo->last_mouse_glyph; |
| 497 | if (frame != dpyinfo->last_mouse_glyph_frame | 497 | if (frame != dpyinfo->last_mouse_glyph_frame |
| 498 | || event->x < r->x || event->x >= r->x + r->width | 498 | || event->x < r->x || event->x >= r->x + (int) r->width |
| 499 | || event->y < r->y || event->y >= r->y + r->height) | 499 | || event->y < r->y || event->y >= r->y + (int) r->height) |
| 500 | { | 500 | { |
| 501 | frame->mouse_moved = true; | 501 | frame->mouse_moved = true; |
| 502 | note_mouse_highlight (frame, event->x, event->y); | 502 | note_mouse_highlight (frame, event->x, event->y); |
diff --git a/src/androidvfs.c b/src/androidvfs.c index 78f6b6da6a8..d618e351204 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c | |||
| @@ -1018,8 +1018,8 @@ android_extract_long (char *pointer) | |||
| 1018 | static const char * | 1018 | static const char * |
| 1019 | android_scan_directory_tree (char *file, size_t *limit_return) | 1019 | android_scan_directory_tree (char *file, size_t *limit_return) |
| 1020 | { | 1020 | { |
| 1021 | char *token, *saveptr, *copy, *copy1, *start, *max, *limit; | 1021 | char *token, *saveptr, *copy, *start, *max, *limit; |
| 1022 | size_t token_length, ntokens, i; | 1022 | size_t token_length, ntokens, i, len; |
| 1023 | char *tokens[10]; | 1023 | char *tokens[10]; |
| 1024 | 1024 | ||
| 1025 | USE_SAFE_ALLOCA; | 1025 | USE_SAFE_ALLOCA; |
| @@ -1031,11 +1031,14 @@ android_scan_directory_tree (char *file, size_t *limit_return) | |||
| 1031 | limit = (char *) directory_tree + directory_tree_size; | 1031 | limit = (char *) directory_tree + directory_tree_size; |
| 1032 | 1032 | ||
| 1033 | /* Now, split `file' into tokens, with the delimiter being the file | 1033 | /* Now, split `file' into tokens, with the delimiter being the file |
| 1034 | name separator. Look for the file and seek past it. */ | 1034 | name separator. Look for the file and seek past it. Create a copy |
| 1035 | of FILE for the enjoyment of `strtok_r'. */ | ||
| 1035 | 1036 | ||
| 1036 | ntokens = 0; | 1037 | ntokens = 0; |
| 1037 | saveptr = NULL; | 1038 | saveptr = NULL; |
| 1038 | copy = copy1 = xstrdup (file); | 1039 | len = strlen (file) + 1; |
| 1040 | copy = SAFE_ALLOCA (len); | ||
| 1041 | memcpy (copy, file, len); | ||
| 1039 | memset (tokens, 0, sizeof tokens); | 1042 | memset (tokens, 0, sizeof tokens); |
| 1040 | 1043 | ||
| 1041 | while ((token = strtok_r (copy, "/", &saveptr))) | 1044 | while ((token = strtok_r (copy, "/", &saveptr))) |
| @@ -1044,19 +1047,14 @@ android_scan_directory_tree (char *file, size_t *limit_return) | |||
| 1044 | 1047 | ||
| 1045 | /* Make sure ntokens is within bounds. */ | 1048 | /* Make sure ntokens is within bounds. */ |
| 1046 | if (ntokens == ARRAYELTS (tokens)) | 1049 | if (ntokens == ARRAYELTS (tokens)) |
| 1047 | { | 1050 | goto fail; |
| 1048 | xfree (copy1); | ||
| 1049 | goto fail; | ||
| 1050 | } | ||
| 1051 | 1051 | ||
| 1052 | tokens[ntokens] = SAFE_ALLOCA (strlen (token) + 1); | 1052 | len = strlen (token) + 1; |
| 1053 | memcpy (tokens[ntokens], token, strlen (token) + 1); | 1053 | tokens[ntokens] = SAFE_ALLOCA (len); |
| 1054 | memcpy (tokens[ntokens], token, len); | ||
| 1054 | ntokens++; | 1055 | ntokens++; |
| 1055 | } | 1056 | } |
| 1056 | 1057 | ||
| 1057 | /* Free the copy created for strtok_r. */ | ||
| 1058 | xfree (copy1); | ||
| 1059 | |||
| 1060 | /* If there are no tokens, just return the start of the directory | 1058 | /* If there are no tokens, just return the start of the directory |
| 1061 | tree. */ | 1059 | tree. */ |
| 1062 | 1060 | ||
| @@ -6319,6 +6317,8 @@ static sem_t saf_completion_sem; | |||
| 6319 | JNIEXPORT jint JNICALL | 6317 | JNIEXPORT jint JNICALL |
| 6320 | NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject object) | 6318 | NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject object) |
| 6321 | { | 6319 | { |
| 6320 | JNI_STACK_ALIGNMENT_PROLOGUE; | ||
| 6321 | |||
| 6322 | while (sem_wait (&saf_completion_sem) < 0) | 6322 | while (sem_wait (&saf_completion_sem) < 0) |
| 6323 | { | 6323 | { |
| 6324 | if (input_blocked_p ()) | 6324 | if (input_blocked_p ()) |
| @@ -6340,6 +6340,8 @@ NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject object) | |||
| 6340 | JNIEXPORT void JNICALL | 6340 | JNIEXPORT void JNICALL |
| 6341 | NATIVE_NAME (safSync) (JNIEnv *env, jobject object) | 6341 | NATIVE_NAME (safSync) (JNIEnv *env, jobject object) |
| 6342 | { | 6342 | { |
| 6343 | JNI_STACK_ALIGNMENT_PROLOGUE; | ||
| 6344 | |||
| 6343 | while (sem_wait (&saf_completion_sem) < 0) | 6345 | while (sem_wait (&saf_completion_sem) < 0) |
| 6344 | process_pending_signals (); | 6346 | process_pending_signals (); |
| 6345 | } | 6347 | } |
| @@ -6347,12 +6349,16 @@ NATIVE_NAME (safSync) (JNIEnv *env, jobject object) | |||
| 6347 | JNIEXPORT void JNICALL | 6349 | JNIEXPORT void JNICALL |
| 6348 | NATIVE_NAME (safPostRequest) (JNIEnv *env, jobject object) | 6350 | NATIVE_NAME (safPostRequest) (JNIEnv *env, jobject object) |
| 6349 | { | 6351 | { |
| 6352 | JNI_STACK_ALIGNMENT_PROLOGUE; | ||
| 6353 | |||
| 6350 | sem_post (&saf_completion_sem); | 6354 | sem_post (&saf_completion_sem); |
| 6351 | } | 6355 | } |
| 6352 | 6356 | ||
| 6353 | JNIEXPORT jboolean JNICALL | 6357 | JNIEXPORT jboolean JNICALL |
| 6354 | NATIVE_NAME (ftruncate) (JNIEnv *env, jobject object, jint fd) | 6358 | NATIVE_NAME (ftruncate) (JNIEnv *env, jobject object, jint fd) |
| 6355 | { | 6359 | { |
| 6360 | JNI_STACK_ALIGNMENT_PROLOGUE; | ||
| 6361 | |||
| 6356 | if (ftruncate (fd, 0) < 0) | 6362 | if (ftruncate (fd, 0) < 0) |
| 6357 | return false; | 6363 | return false; |
| 6358 | 6364 | ||
diff --git a/src/buffer.c b/src/buffer.c index 352aca8ddfd..e235ff8f9f8 100644 --- a/src/buffer.c +++ b/src/buffer.c | |||
| @@ -1334,7 +1334,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) | |||
| 1334 | case SYMBOL_LOCALIZED: | 1334 | case SYMBOL_LOCALIZED: |
| 1335 | { /* Look in local_var_alist. */ | 1335 | { /* Look in local_var_alist. */ |
| 1336 | struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); | 1336 | struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); |
| 1337 | XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ | 1337 | variable = make_lisp_symbol (sym); /* Update In case of aliasing. */ |
| 1338 | result = assq_no_quit (variable, BVAR (buf, local_var_alist)); | 1338 | result = assq_no_quit (variable, BVAR (buf, local_var_alist)); |
| 1339 | if (!NILP (result)) | 1339 | if (!NILP (result)) |
| 1340 | { | 1340 | { |
| @@ -3002,7 +3002,7 @@ the normal hook `change-major-mode-hook'. */) | |||
| 3002 | But still return the total number of overlays. | 3002 | But still return the total number of overlays. |
| 3003 | */ | 3003 | */ |
| 3004 | 3004 | ||
| 3005 | ptrdiff_t | 3005 | static ptrdiff_t |
| 3006 | overlays_in (ptrdiff_t beg, ptrdiff_t end, bool extend, | 3006 | overlays_in (ptrdiff_t beg, ptrdiff_t end, bool extend, |
| 3007 | Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, | 3007 | Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, |
| 3008 | bool empty, bool trailing, | 3008 | bool empty, bool trailing, |
| @@ -3125,56 +3125,38 @@ mouse_face_overlay_overlaps (Lisp_Object overlay) | |||
| 3125 | { | 3125 | { |
| 3126 | ptrdiff_t start = OVERLAY_START (overlay); | 3126 | ptrdiff_t start = OVERLAY_START (overlay); |
| 3127 | ptrdiff_t end = OVERLAY_END (overlay); | 3127 | ptrdiff_t end = OVERLAY_END (overlay); |
| 3128 | ptrdiff_t n, i, size; | 3128 | Lisp_Object tem; |
| 3129 | Lisp_Object *v, tem; | 3129 | struct itree_node *node; |
| 3130 | Lisp_Object vbuf[10]; | ||
| 3131 | USE_SAFE_ALLOCA; | ||
| 3132 | 3130 | ||
| 3133 | size = ARRAYELTS (vbuf); | 3131 | ITREE_FOREACH (node, current_buffer->overlays, |
| 3134 | v = vbuf; | 3132 | start, min (end, ZV) + 1, |
| 3135 | n = overlays_in (start, end, 0, &v, &size, true, false, NULL); | 3133 | ASCENDING) |
| 3136 | if (n > size) | ||
| 3137 | { | 3134 | { |
| 3138 | SAFE_NALLOCA (v, 1, n); | 3135 | if (node->begin < end && node->end > start |
| 3139 | overlays_in (start, end, 0, &v, &n, true, false, NULL); | 3136 | && node->begin < node->end |
| 3137 | && !EQ (node->data, overlay) | ||
| 3138 | && (tem = Foverlay_get (overlay, Qmouse_face), | ||
| 3139 | !NILP (tem))) | ||
| 3140 | return true; | ||
| 3140 | } | 3141 | } |
| 3141 | 3142 | return false; | |
| 3142 | for (i = 0; i < n; ++i) | ||
| 3143 | if (!EQ (v[i], overlay) | ||
| 3144 | && (tem = Foverlay_get (overlay, Qmouse_face), | ||
| 3145 | !NILP (tem))) | ||
| 3146 | break; | ||
| 3147 | |||
| 3148 | SAFE_FREE (); | ||
| 3149 | return i < n; | ||
| 3150 | } | 3143 | } |
| 3151 | 3144 | ||
| 3152 | /* Return the value of the 'display-line-numbers-disable' property at | 3145 | /* Return the value of the 'display-line-numbers-disable' property at |
| 3153 | EOB, if there's an overlay at ZV with a non-nil value of that property. */ | 3146 | EOB, if there's an overlay at ZV with a non-nil value of that property. */ |
| 3154 | Lisp_Object | 3147 | bool |
| 3155 | disable_line_numbers_overlay_at_eob (void) | 3148 | disable_line_numbers_overlay_at_eob (void) |
| 3156 | { | 3149 | { |
| 3157 | ptrdiff_t n, i, size; | 3150 | Lisp_Object tem = Qnil; |
| 3158 | Lisp_Object *v, tem = Qnil; | 3151 | struct itree_node *node; |
| 3159 | Lisp_Object vbuf[10]; | ||
| 3160 | USE_SAFE_ALLOCA; | ||
| 3161 | 3152 | ||
| 3162 | size = ARRAYELTS (vbuf); | 3153 | ITREE_FOREACH (node, current_buffer->overlays, ZV, ZV, ASCENDING) |
| 3163 | v = vbuf; | ||
| 3164 | n = overlays_in (ZV, ZV, 0, &v, &size, false, false, NULL); | ||
| 3165 | if (n > size) | ||
| 3166 | { | 3154 | { |
| 3167 | SAFE_NALLOCA (v, 1, n); | 3155 | if ((tem = Foverlay_get (node->data, Qdisplay_line_numbers_disable), |
| 3168 | overlays_in (ZV, ZV, 0, &v, &n, false, false, NULL); | 3156 | !NILP (tem))) |
| 3157 | return true; | ||
| 3169 | } | 3158 | } |
| 3170 | 3159 | return false; | |
| 3171 | for (i = 0; i < n; ++i) | ||
| 3172 | if ((tem = Foverlay_get (v[i], Qdisplay_line_numbers_disable), | ||
| 3173 | !NILP (tem))) | ||
| 3174 | break; | ||
| 3175 | |||
| 3176 | SAFE_FREE (); | ||
| 3177 | return tem; | ||
| 3178 | } | 3160 | } |
| 3179 | 3161 | ||
| 3180 | 3162 | ||
| @@ -4989,7 +4971,7 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring, | |||
| 4989 | sym->u.s.declared_special = true; | 4971 | sym->u.s.declared_special = true; |
| 4990 | sym->u.s.redirect = SYMBOL_FORWARDED; | 4972 | sym->u.s.redirect = SYMBOL_FORWARDED; |
| 4991 | SET_SYMBOL_FWD (sym, bo_fwd); | 4973 | SET_SYMBOL_FWD (sym, bo_fwd); |
| 4992 | XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym); | 4974 | PER_BUFFER_SYMBOL (offset) = make_lisp_symbol (sym); |
| 4993 | 4975 | ||
| 4994 | if (PER_BUFFER_IDX (offset) == 0) | 4976 | if (PER_BUFFER_IDX (offset) == 0) |
| 4995 | /* Did a DEFVAR_PER_BUFFER without initializing the corresponding | 4977 | /* Did a DEFVAR_PER_BUFFER without initializing the corresponding |
diff --git a/src/buffer.h b/src/buffer.h index 9e0982f5da7..87ba2802b39 100644 --- a/src/buffer.h +++ b/src/buffer.h | |||
| @@ -1174,8 +1174,6 @@ extern void delete_all_overlays (struct buffer *); | |||
| 1174 | extern void reset_buffer (struct buffer *); | 1174 | extern void reset_buffer (struct buffer *); |
| 1175 | extern void compact_buffer (struct buffer *); | 1175 | extern void compact_buffer (struct buffer *); |
| 1176 | extern ptrdiff_t overlays_at (ptrdiff_t, bool, Lisp_Object **, ptrdiff_t *, ptrdiff_t *); | 1176 | extern ptrdiff_t overlays_at (ptrdiff_t, bool, Lisp_Object **, ptrdiff_t *, ptrdiff_t *); |
| 1177 | extern ptrdiff_t overlays_in (ptrdiff_t, ptrdiff_t, bool, Lisp_Object **, | ||
| 1178 | ptrdiff_t *, bool, bool, ptrdiff_t *); | ||
| 1179 | extern ptrdiff_t previous_overlay_change (ptrdiff_t); | 1177 | extern ptrdiff_t previous_overlay_change (ptrdiff_t); |
| 1180 | extern ptrdiff_t next_overlay_change (ptrdiff_t); | 1178 | extern ptrdiff_t next_overlay_change (ptrdiff_t); |
| 1181 | extern ptrdiff_t sort_overlays (Lisp_Object *, ptrdiff_t, struct window *); | 1179 | extern ptrdiff_t sort_overlays (Lisp_Object *, ptrdiff_t, struct window *); |
diff --git a/src/bytecode.c b/src/bytecode.c index ed6e2b34e77..8d7240b9966 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -625,9 +625,10 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, | |||
| 625 | varref: | 625 | varref: |
| 626 | { | 626 | { |
| 627 | Lisp_Object v1 = vectorp[op], v2; | 627 | Lisp_Object v1 = vectorp[op], v2; |
| 628 | if (!SYMBOLP (v1) | 628 | if (!BARE_SYMBOL_P (v1) |
| 629 | || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL | 629 | || XBARE_SYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL |
| 630 | || (v2 = SYMBOL_VAL (XSYMBOL (v1)), BASE_EQ (v2, Qunbound))) | 630 | || (v2 = XBARE_SYMBOL (v1)->u.s.val.value, |
| 631 | BASE_EQ (v2, Qunbound))) | ||
| 631 | v2 = Fsymbol_value (v1); | 632 | v2 = Fsymbol_value (v1); |
| 632 | PUSH (v2); | 633 | PUSH (v2); |
| 633 | NEXT; | 634 | NEXT; |
| @@ -699,11 +700,11 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, | |||
| 699 | Lisp_Object val = POP; | 700 | Lisp_Object val = POP; |
| 700 | 701 | ||
| 701 | /* Inline the most common case. */ | 702 | /* Inline the most common case. */ |
| 702 | if (SYMBOLP (sym) | 703 | if (BARE_SYMBOL_P (sym) |
| 703 | && !BASE_EQ (val, Qunbound) | 704 | && !BASE_EQ (val, Qunbound) |
| 704 | && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL | 705 | && XBARE_SYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL |
| 705 | && !SYMBOL_TRAPPED_WRITE_P (sym)) | 706 | && !XBARE_SYMBOL (sym)->u.s.trapped_write) |
| 706 | SET_SYMBOL_VAL (XSYMBOL (sym), val); | 707 | SET_SYMBOL_VAL (XBARE_SYMBOL (sym), val); |
| 707 | else | 708 | else |
| 708 | set_internal (sym, val, Qnil, SET_INTERNAL_SET); | 709 | set_internal (sym, val, Qnil, SET_INTERNAL_SET); |
| 709 | } | 710 | } |
| @@ -790,24 +791,22 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, | |||
| 790 | do_debug_on_call (Qlambda, count1); | 791 | do_debug_on_call (Qlambda, count1); |
| 791 | 792 | ||
| 792 | Lisp_Object original_fun = call_fun; | 793 | Lisp_Object original_fun = call_fun; |
| 793 | if (SYMBOLP (call_fun)) | 794 | /* Calls to symbols-with-pos don't need to be on the fast path. */ |
| 794 | call_fun = XSYMBOL (call_fun)->u.s.function; | 795 | if (BARE_SYMBOL_P (call_fun)) |
| 795 | Lisp_Object template; | 796 | call_fun = XBARE_SYMBOL (call_fun)->u.s.function; |
| 796 | Lisp_Object bytecode; | 797 | if (COMPILEDP (call_fun)) |
| 797 | if (COMPILEDP (call_fun) | ||
| 798 | /* Lexical binding only. */ | ||
| 799 | && (template = AREF (call_fun, COMPILED_ARGLIST), | ||
| 800 | FIXNUMP (template)) | ||
| 801 | /* No autoloads. */ | ||
| 802 | && (bytecode = AREF (call_fun, COMPILED_BYTECODE), | ||
| 803 | !CONSP (bytecode))) | ||
| 804 | { | 798 | { |
| 805 | fun = call_fun; | 799 | Lisp_Object template = AREF (call_fun, COMPILED_ARGLIST); |
| 806 | bytestr = bytecode; | 800 | if (FIXNUMP (template)) |
| 807 | args_template = XFIXNUM (template); | 801 | { |
| 808 | nargs = call_nargs; | 802 | /* Fast path for lexbound functions. */ |
| 809 | args = call_args; | 803 | fun = call_fun; |
| 810 | goto setup_frame; | 804 | bytestr = AREF (call_fun, COMPILED_BYTECODE), |
| 805 | args_template = XFIXNUM (template); | ||
| 806 | nargs = call_nargs; | ||
| 807 | args = call_args; | ||
| 808 | goto setup_frame; | ||
| 809 | } | ||
| 811 | } | 810 | } |
| 812 | 811 | ||
| 813 | Lisp_Object val; | 812 | Lisp_Object val; |
| @@ -1738,28 +1737,29 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, | |||
| 1738 | if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table)) | 1737 | if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table)) |
| 1739 | emacs_abort (); | 1738 | emacs_abort (); |
| 1740 | Lisp_Object v1 = POP; | 1739 | Lisp_Object v1 = POP; |
| 1741 | ptrdiff_t i; | ||
| 1742 | struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table); | 1740 | struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table); |
| 1743 | 1741 | /* Do a linear search if there are few cases and the test is `eq'. | |
| 1744 | /* h->count is a faster approximation for HASH_TABLE_SIZE (h) | 1742 | (The table is assumed to be sized exactly; all entries are |
| 1745 | here. */ | 1743 | consecutive at the beginning.) |
| 1746 | if (h->count <= 5 && !h->test->cmpfn) | 1744 | FIXME: 5 is arbitrarily chosen. */ |
| 1747 | { /* Do a linear search if there are not many cases | 1745 | if (h->count <= 5 && !h->test->cmpfn && !symbols_with_pos_enabled) |
| 1748 | FIXME: 5 is arbitrarily chosen. */ | 1746 | { |
| 1749 | for (i = h->count; 0 <= --i; ) | 1747 | eassume (h->count >= 2); |
| 1750 | if (EQ (v1, HASH_KEY (h, i))) | 1748 | for (ptrdiff_t i = h->count - 1; i >= 0; i--) |
| 1751 | break; | 1749 | if (BASE_EQ (v1, HASH_KEY (h, i))) |
| 1750 | { | ||
| 1751 | op = XFIXNUM (HASH_VALUE (h, i)); | ||
| 1752 | goto op_branch; | ||
| 1753 | } | ||
| 1752 | } | 1754 | } |
| 1753 | else | 1755 | else |
| 1754 | i = hash_lookup (h, v1); | ||
| 1755 | |||
| 1756 | if (i >= 0) | ||
| 1757 | { | 1756 | { |
| 1758 | Lisp_Object val = HASH_VALUE (h, i); | 1757 | ptrdiff_t i = hash_lookup (h, v1); |
| 1759 | if (BYTE_CODE_SAFE && !FIXNUMP (val)) | 1758 | if (i >= 0) |
| 1760 | emacs_abort (); | 1759 | { |
| 1761 | op = XFIXNUM (val); | 1760 | op = XFIXNUM (HASH_VALUE (h, i)); |
| 1762 | goto op_branch; | 1761 | goto op_branch; |
| 1762 | } | ||
| 1763 | } | 1763 | } |
| 1764 | } | 1764 | } |
| 1765 | NEXT; | 1765 | NEXT; |
| @@ -35,11 +35,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 35 | #include "coding.h" | 35 | #include "coding.h" |
| 36 | #include "keyboard.h" | 36 | #include "keyboard.h" |
| 37 | 37 | ||
| 38 | /* Avoid GCC 12 bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=105784>. */ | ||
| 39 | #if GNUC_PREREQ (12, 0, 0) | ||
| 40 | # pragma GCC diagnostic ignored "-Wanalyzer-use-of-uninitialized-value" | ||
| 41 | #endif | ||
| 42 | |||
| 43 | /* Table of registered CCL programs. Each element is a vector of | 38 | /* Table of registered CCL programs. Each element is a vector of |
| 44 | NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the | 39 | NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the |
| 45 | name of the program, CCL_PROG (vector) is the compiled code of the | 40 | name of the program, CCL_PROG (vector) is the compiled code of the |
| @@ -609,7 +604,7 @@ while (0) | |||
| 609 | https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109579 | 604 | https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109579 |
| 610 | which causes GCC to mistakenly complain about | 605 | which causes GCC to mistakenly complain about |
| 611 | popping the mapping stack. */ | 606 | popping the mapping stack. */ |
| 612 | #if GNUC_PREREQ (13, 0, 0) | 607 | #if __GNUC__ == 13 |
| 613 | # pragma GCC diagnostic ignored "-Wanalyzer-out-of-bounds" | 608 | # pragma GCC diagnostic ignored "-Wanalyzer-out-of-bounds" |
| 614 | #endif | 609 | #endif |
| 615 | 610 | ||
diff --git a/src/comp.c b/src/comp.c index 853757f6162..3f989c722d4 100644 --- a/src/comp.c +++ b/src/comp.c | |||
| @@ -4859,8 +4859,8 @@ add_compiler_options (void) | |||
| 4859 | #endif | 4859 | #endif |
| 4860 | } | 4860 | } |
| 4861 | 4861 | ||
| 4862 | DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, | 4862 | DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, |
| 4863 | Scomp__compile_ctxt_to_file, | 4863 | Scomp__compile_ctxt_to_file0, |
| 4864 | 1, 1, 0, | 4864 | 1, 1, 0, |
| 4865 | doc: /* Compile the current context as native code to file FILENAME. */) | 4865 | doc: /* Compile the current context as native code to file FILENAME. */) |
| 4866 | (Lisp_Object filename) | 4866 | (Lisp_Object filename) |
| @@ -5789,7 +5789,7 @@ natively-compiled one. */); | |||
| 5789 | defsubr (&Scomp__install_trampoline); | 5789 | defsubr (&Scomp__install_trampoline); |
| 5790 | defsubr (&Scomp__init_ctxt); | 5790 | defsubr (&Scomp__init_ctxt); |
| 5791 | defsubr (&Scomp__release_ctxt); | 5791 | defsubr (&Scomp__release_ctxt); |
| 5792 | defsubr (&Scomp__compile_ctxt_to_file); | 5792 | defsubr (&Scomp__compile_ctxt_to_file0); |
| 5793 | defsubr (&Scomp_libgccjit_version); | 5793 | defsubr (&Scomp_libgccjit_version); |
| 5794 | defsubr (&Scomp__register_lambda); | 5794 | defsubr (&Scomp__register_lambda); |
| 5795 | defsubr (&Scomp__register_subr); | 5795 | defsubr (&Scomp__register_subr); |
diff --git a/src/conf_post.h b/src/conf_post.h index 83a0dd1b09b..f2353803074 100644 --- a/src/conf_post.h +++ b/src/conf_post.h | |||
| @@ -471,3 +471,7 @@ extern int emacs_setenv_TZ (char const *); | |||
| 471 | #undef MB_CUR_MAX | 471 | #undef MB_CUR_MAX |
| 472 | #define MB_CUR_MAX REPLACEMENT_MB_CUR_MAX | 472 | #define MB_CUR_MAX REPLACEMENT_MB_CUR_MAX |
| 473 | #endif /* REPLACEMENT_MB_CUR_MAX */ | 473 | #endif /* REPLACEMENT_MB_CUR_MAX */ |
| 474 | |||
| 475 | /* Emacs does not need glibc strftime behavior for AM and PM | ||
| 476 | indicators. */ | ||
| 477 | #define REQUIRE_GNUISH_STRFTIME_AM_PM false | ||
diff --git a/src/data.c b/src/data.c index fd4b1fe4e44..c87b5317618 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -231,6 +231,7 @@ for example, (type-of 1) returns `integer'. */) | |||
| 231 | case PVEC_BOOL_VECTOR: return Qbool_vector; | 231 | case PVEC_BOOL_VECTOR: return Qbool_vector; |
| 232 | case PVEC_FRAME: return Qframe; | 232 | case PVEC_FRAME: return Qframe; |
| 233 | case PVEC_HASH_TABLE: return Qhash_table; | 233 | case PVEC_HASH_TABLE: return Qhash_table; |
| 234 | case PVEC_OBARRAY: return Qobarray; | ||
| 234 | case PVEC_FONT: | 235 | case PVEC_FONT: |
| 235 | if (FONT_SPEC_P (object)) | 236 | if (FONT_SPEC_P (object)) |
| 236 | return Qfont_spec; | 237 | return Qfont_spec; |
| @@ -791,18 +792,16 @@ DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0, | |||
| 791 | doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */) | 792 | doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */) |
| 792 | (register Lisp_Object sym) | 793 | (register Lisp_Object sym) |
| 793 | { | 794 | { |
| 794 | if (BARE_SYMBOL_P (sym)) | 795 | CHECK_SYMBOL (sym); |
| 795 | return sym; | 796 | return BARE_SYMBOL_P (sym) ? sym : XSYMBOL_WITH_POS_SYM (sym); |
| 796 | /* Type checking is done in the following macro. */ | ||
| 797 | return SYMBOL_WITH_POS_SYM (sym); | ||
| 798 | } | 797 | } |
| 799 | 798 | ||
| 800 | DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0, | 799 | DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0, |
| 801 | doc: /* Extract the position from a symbol with position. */) | 800 | doc: /* Extract the position from a symbol with position. */) |
| 802 | (register Lisp_Object ls) | 801 | (register Lisp_Object ls) |
| 803 | { | 802 | { |
| 804 | /* Type checking is done in the following macro. */ | 803 | CHECK_TYPE (SYMBOL_WITH_POS_P (ls), Qsymbol_with_pos_p, ls); |
| 805 | return SYMBOL_WITH_POS_POS (ls); | 804 | return XSYMBOL_WITH_POS_POS (ls); |
| 806 | } | 805 | } |
| 807 | 806 | ||
| 808 | DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol, | 807 | DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol, |
| @@ -812,7 +811,7 @@ Otherwise, return ARG unchanged. Compare with `bare-symbol'. */) | |||
| 812 | (register Lisp_Object arg) | 811 | (register Lisp_Object arg) |
| 813 | { | 812 | { |
| 814 | if (SYMBOL_WITH_POS_P (arg)) | 813 | if (SYMBOL_WITH_POS_P (arg)) |
| 815 | return (SYMBOL_WITH_POS_SYM (arg)); | 814 | return XSYMBOL_WITH_POS_SYM (arg); |
| 816 | return arg; | 815 | return arg; |
| 817 | } | 816 | } |
| 818 | 817 | ||
| @@ -823,20 +822,13 @@ POS, the position, is either a fixnum or a symbol with position from which | |||
| 823 | the position will be taken. */) | 822 | the position will be taken. */) |
| 824 | (register Lisp_Object sym, register Lisp_Object pos) | 823 | (register Lisp_Object sym, register Lisp_Object pos) |
| 825 | { | 824 | { |
| 826 | Lisp_Object bare; | 825 | Lisp_Object bare = Fbare_symbol (sym); |
| 827 | Lisp_Object position; | 826 | Lisp_Object position; |
| 828 | 827 | ||
| 829 | if (BARE_SYMBOL_P (sym)) | ||
| 830 | bare = sym; | ||
| 831 | else if (SYMBOL_WITH_POS_P (sym)) | ||
| 832 | bare = XSYMBOL_WITH_POS (sym)->sym; | ||
| 833 | else | ||
| 834 | wrong_type_argument (Qsymbolp, sym); | ||
| 835 | |||
| 836 | if (FIXNUMP (pos)) | 828 | if (FIXNUMP (pos)) |
| 837 | position = pos; | 829 | position = pos; |
| 838 | else if (SYMBOL_WITH_POS_P (pos)) | 830 | else if (SYMBOL_WITH_POS_P (pos)) |
| 839 | position = XSYMBOL_WITH_POS (pos)->pos; | 831 | position = XSYMBOL_WITH_POS_POS (pos); |
| 840 | else | 832 | else |
| 841 | wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos); | 833 | wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos); |
| 842 | 834 | ||
| @@ -1264,7 +1256,7 @@ If OBJECT is not a symbol, just return it. */) | |||
| 1264 | struct Lisp_Symbol *sym = XSYMBOL (object); | 1256 | struct Lisp_Symbol *sym = XSYMBOL (object); |
| 1265 | while (sym->u.s.redirect == SYMBOL_VARALIAS) | 1257 | while (sym->u.s.redirect == SYMBOL_VARALIAS) |
| 1266 | sym = SYMBOL_ALIAS (sym); | 1258 | sym = SYMBOL_ALIAS (sym); |
| 1267 | XSETSYMBOL (object, sym); | 1259 | object = make_lisp_symbol (sym); |
| 1268 | } | 1260 | } |
| 1269 | return object; | 1261 | return object; |
| 1270 | } | 1262 | } |
| @@ -1514,12 +1506,9 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ | |||
| 1514 | if (blv->fwd.fwdptr) | 1506 | if (blv->fwd.fwdptr) |
| 1515 | set_blv_value (blv, do_symval_forwarding (blv->fwd)); | 1507 | set_blv_value (blv, do_symval_forwarding (blv->fwd)); |
| 1516 | /* Choose the new binding. */ | 1508 | /* Choose the new binding. */ |
| 1517 | { | 1509 | tem1 = assq_no_quit (make_lisp_symbol (symbol), |
| 1518 | Lisp_Object var; | 1510 | BVAR (current_buffer, local_var_alist)); |
| 1519 | XSETSYMBOL (var, symbol); | 1511 | set_blv_where (blv, Fcurrent_buffer ()); |
| 1520 | tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); | ||
| 1521 | set_blv_where (blv, Fcurrent_buffer ()); | ||
| 1522 | } | ||
| 1523 | if (!(blv->found = !NILP (tem1))) | 1512 | if (!(blv->found = !NILP (tem1))) |
| 1524 | tem1 = blv->defcell; | 1513 | tem1 = blv->defcell; |
| 1525 | 1514 | ||
| @@ -1663,7 +1652,8 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, | |||
| 1663 | set_blv_value (blv, do_symval_forwarding (blv->fwd)); | 1652 | set_blv_value (blv, do_symval_forwarding (blv->fwd)); |
| 1664 | 1653 | ||
| 1665 | /* Find the new binding. */ | 1654 | /* Find the new binding. */ |
| 1666 | XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ | 1655 | /* May have changed via aliasing. */ |
| 1656 | symbol = make_lisp_symbol (sym); | ||
| 1667 | Lisp_Object tem1 | 1657 | Lisp_Object tem1 |
| 1668 | = assq_no_quit (symbol, | 1658 | = assq_no_quit (symbol, |
| 1669 | BVAR (XBUFFER (where), local_var_alist)); | 1659 | BVAR (XBUFFER (where), local_var_alist)); |
| @@ -2067,13 +2057,10 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded, | |||
| 2067 | union Lisp_Val_Fwd valcontents) | 2057 | union Lisp_Val_Fwd valcontents) |
| 2068 | { | 2058 | { |
| 2069 | struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv); | 2059 | struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv); |
| 2070 | Lisp_Object symbol; | 2060 | Lisp_Object tem = Fcons (make_lisp_symbol (sym), |
| 2071 | Lisp_Object tem; | 2061 | forwarded |
| 2072 | 2062 | ? do_symval_forwarding (valcontents.fwd) | |
| 2073 | XSETSYMBOL (symbol, sym); | 2063 | : valcontents.value); |
| 2074 | tem = Fcons (symbol, (forwarded | ||
| 2075 | ? do_symval_forwarding (valcontents.fwd) | ||
| 2076 | : valcontents.value)); | ||
| 2077 | 2064 | ||
| 2078 | /* Buffer_Local_Values cannot have as realval a buffer-local | 2065 | /* Buffer_Local_Values cannot have as realval a buffer-local |
| 2079 | or keyboard-local forwarding. */ | 2066 | or keyboard-local forwarding. */ |
| @@ -2229,7 +2216,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) | |||
| 2229 | } | 2216 | } |
| 2230 | 2217 | ||
| 2231 | /* Make sure this buffer has its own value of symbol. */ | 2218 | /* Make sure this buffer has its own value of symbol. */ |
| 2232 | XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ | 2219 | variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ |
| 2233 | tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); | 2220 | tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); |
| 2234 | if (NILP (tem)) | 2221 | if (NILP (tem)) |
| 2235 | { | 2222 | { |
| @@ -2309,7 +2296,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) | |||
| 2309 | notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ()); | 2296 | notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ()); |
| 2310 | 2297 | ||
| 2311 | /* Get rid of this buffer's alist element, if any. */ | 2298 | /* Get rid of this buffer's alist element, if any. */ |
| 2312 | XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ | 2299 | variable = make_lisp_symbol (sym); /* Propagate variable indirection. */ |
| 2313 | tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); | 2300 | tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); |
| 2314 | if (!NILP (tem)) | 2301 | if (!NILP (tem)) |
| 2315 | bset_local_var_alist | 2302 | bset_local_var_alist |
| @@ -2354,7 +2341,7 @@ Also see `buffer-local-boundp'.*/) | |||
| 2354 | Lisp_Object tmp; | 2341 | Lisp_Object tmp; |
| 2355 | struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); | 2342 | struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); |
| 2356 | XSETBUFFER (tmp, buf); | 2343 | XSETBUFFER (tmp, buf); |
| 2357 | XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ | 2344 | variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ |
| 2358 | 2345 | ||
| 2359 | if (EQ (blv->where, tmp)) /* The binding is already loaded. */ | 2346 | if (EQ (blv->where, tmp)) /* The binding is already loaded. */ |
| 2360 | return blv_found (blv) ? Qt : Qnil; | 2347 | return blv_found (blv) ? Qt : Qnil; |
| @@ -2404,7 +2391,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see | |||
| 2404 | struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); | 2391 | struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); |
| 2405 | if (blv->local_if_set) | 2392 | if (blv->local_if_set) |
| 2406 | return Qt; | 2393 | return Qt; |
| 2407 | XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ | 2394 | variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ |
| 2408 | return Flocal_variable_p (variable, buffer); | 2395 | return Flocal_variable_p (variable, buffer); |
| 2409 | } | 2396 | } |
| 2410 | case SYMBOL_FORWARDED: | 2397 | case SYMBOL_FORWARDED: |
| @@ -4238,6 +4225,7 @@ syms_of_data (void) | |||
| 4238 | DEFSYM (Qtreesit_parser, "treesit-parser"); | 4225 | DEFSYM (Qtreesit_parser, "treesit-parser"); |
| 4239 | DEFSYM (Qtreesit_node, "treesit-node"); | 4226 | DEFSYM (Qtreesit_node, "treesit-node"); |
| 4240 | DEFSYM (Qtreesit_compiled_query, "treesit-compiled-query"); | 4227 | DEFSYM (Qtreesit_compiled_query, "treesit-compiled-query"); |
| 4228 | DEFSYM (Qobarray, "obarray"); | ||
| 4241 | 4229 | ||
| 4242 | DEFSYM (Qdefun, "defun"); | 4230 | DEFSYM (Qdefun, "defun"); |
| 4243 | 4231 | ||
diff --git a/src/dispextern.h b/src/dispextern.h index 84b9dadc184..5387cb45603 100644 --- a/src/dispextern.h +++ b/src/dispextern.h | |||
| @@ -2752,6 +2752,16 @@ struct it | |||
| 2752 | pixel_width with each call to produce_glyphs. */ | 2752 | pixel_width with each call to produce_glyphs. */ |
| 2753 | int current_x; | 2753 | int current_x; |
| 2754 | 2754 | ||
| 2755 | /* Pixel position within a display line with a wrap prefix. Updated | ||
| 2756 | to reflect current_x in produce_glyphs when producing glyphs from | ||
| 2757 | a prefix string and continuation_lines_width > 0, which is to | ||
| 2758 | say, from a wrap prefix. | ||
| 2759 | |||
| 2760 | Such updates are unnecessary where it is impossible for a wrap | ||
| 2761 | prefix to be active, e.g. when continuation lines are being | ||
| 2762 | produced. */ | ||
| 2763 | int wrap_prefix_width; | ||
| 2764 | |||
| 2755 | /* Accumulated width of continuation lines. If > 0, this means we | 2765 | /* Accumulated width of continuation lines. If > 0, this means we |
| 2756 | are currently in a continuation line. This is initially zero and | 2766 | are currently in a continuation line. This is initially zero and |
| 2757 | incremented/reset by display_line, move_it_to etc. */ | 2767 | incremented/reset by display_line, move_it_to etc. */ |
| @@ -357,6 +357,20 @@ reread_doc_file (Lisp_Object file) | |||
| 357 | return 1; | 357 | return 1; |
| 358 | } | 358 | } |
| 359 | 359 | ||
| 360 | DEFUN ("documentation-stringp", Fdocumentation_stringp, Sdocumentation_stringp, | ||
| 361 | 1, 1, 0, | ||
| 362 | doc: /* Return non-nil if OBJECT is a well-formed docstring object. | ||
| 363 | OBJECT can be either a string or a reference if it's kept externally. */) | ||
| 364 | (Lisp_Object object) | ||
| 365 | { | ||
| 366 | return (STRINGP (object) | ||
| 367 | || FIXNUMP (object) /* Reference to DOC. */ | ||
| 368 | || (CONSP (object) /* Reference to .elc. */ | ||
| 369 | && STRINGP (XCAR (object)) | ||
| 370 | && FIXNUMP (XCDR (object))) | ||
| 371 | ? Qt : Qnil); | ||
| 372 | } | ||
| 373 | |||
| 360 | DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0, | 374 | DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0, |
| 361 | doc: /* Return the documentation string of FUNCTION. | 375 | doc: /* Return the documentation string of FUNCTION. |
| 362 | Unless a non-nil second argument RAW is given, the | 376 | Unless a non-nil second argument RAW is given, the |
| @@ -502,46 +516,13 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) | |||
| 502 | /* If it's a lisp form, stick it in the form. */ | 516 | /* If it's a lisp form, stick it in the form. */ |
| 503 | if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) | 517 | if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) |
| 504 | fun = XCDR (fun); | 518 | fun = XCDR (fun); |
| 505 | if (CONSP (fun)) | ||
| 506 | { | ||
| 507 | Lisp_Object tem = XCAR (fun); | ||
| 508 | if (EQ (tem, Qlambda) || EQ (tem, Qautoload) | ||
| 509 | || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1))) | ||
| 510 | { | ||
| 511 | tem = Fcdr (Fcdr (fun)); | ||
| 512 | if (CONSP (tem) && FIXNUMP (XCAR (tem))) | ||
| 513 | /* FIXME: This modifies typically pure hash-cons'd data, so its | ||
| 514 | correctness is quite delicate. */ | ||
| 515 | XSETCAR (tem, make_fixnum (offset)); | ||
| 516 | } | ||
| 517 | } | ||
| 518 | /* Lisp_Subrs have a slot for it. */ | 519 | /* Lisp_Subrs have a slot for it. */ |
| 519 | else if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun)) | 520 | if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun)) |
| 520 | { | 521 | XSUBR (fun)->doc = offset; |
| 521 | XSUBR (fun)->doc = offset; | 522 | else |
| 522 | } | ||
| 523 | |||
| 524 | /* Bytecode objects sometimes have slots for it. */ | ||
| 525 | else if (COMPILEDP (fun)) | ||
| 526 | { | 523 | { |
| 527 | /* This bytecode object must have a slot for the | 524 | AUTO_STRING (format, "Ignoring DOC string on non-subr: %S"); |
| 528 | docstring, since we've found a docstring for it. */ | 525 | CALLN (Fmessage, format, obj); |
| 529 | if (PVSIZE (fun) > COMPILED_DOC_STRING | ||
| 530 | /* Don't overwrite a non-docstring value placed there, | ||
| 531 | * such as the symbols used for Oclosures. */ | ||
| 532 | && VALID_DOCSTRING_P (AREF (fun, COMPILED_DOC_STRING))) | ||
| 533 | ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset)); | ||
| 534 | else | ||
| 535 | { | ||
| 536 | AUTO_STRING (format, | ||
| 537 | (PVSIZE (fun) > COMPILED_DOC_STRING | ||
| 538 | ? "Docstring slot busy for %s" | ||
| 539 | : "No docstring slot for %s")); | ||
| 540 | CALLN (Fmessage, format, | ||
| 541 | (SYMBOLP (obj) | ||
| 542 | ? SYMBOL_NAME (obj) | ||
| 543 | : build_string ("<anonymous>"))); | ||
| 544 | } | ||
| 545 | } | 526 | } |
| 546 | } | 527 | } |
| 547 | 528 | ||
| @@ -776,6 +757,7 @@ compute the correct value for the current terminal in the nil case. */); | |||
| 776 | doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */); | 757 | doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */); |
| 777 | /* Initialized by ‘main’. */ | 758 | /* Initialized by ‘main’. */ |
| 778 | 759 | ||
| 760 | defsubr (&Sdocumentation_stringp); | ||
| 779 | defsubr (&Sdocumentation); | 761 | defsubr (&Sdocumentation); |
| 780 | defsubr (&Ssubr_documentation); | 762 | defsubr (&Ssubr_documentation); |
| 781 | defsubr (&Sdocumentation_property); | 763 | defsubr (&Sdocumentation_property); |
diff --git a/src/editfns.c b/src/editfns.c index 0cecd81c07f..4ccf765bd4b 100644 --- a/src/editfns.c +++ b/src/editfns.c | |||
| @@ -272,24 +272,6 @@ If you set the marker not to point anywhere, the buffer will have no mark. */) | |||
| 272 | } | 272 | } |
| 273 | 273 | ||
| 274 | 274 | ||
| 275 | /* Find all the overlays in the current buffer that touch position POS. | ||
| 276 | Return the number found, and store them in a vector in VEC | ||
| 277 | of length LEN. | ||
| 278 | |||
| 279 | Note: this can return overlays that do not touch POS. The caller | ||
| 280 | should filter these out. */ | ||
| 281 | |||
| 282 | static ptrdiff_t | ||
| 283 | overlays_around (ptrdiff_t pos, Lisp_Object *vec, ptrdiff_t len) | ||
| 284 | { | ||
| 285 | /* Find all potentially rear-advance overlays at (POS - 1). Find | ||
| 286 | all overlays at POS, so end at (POS + 1). Find even empty | ||
| 287 | overlays, which due to the way 'overlays-in' works implies that | ||
| 288 | we might also fetch empty overlays starting at (POS + 1). */ | ||
| 289 | return overlays_in (pos - 1, pos + 1, false, &vec, &len, | ||
| 290 | true, false, NULL); | ||
| 291 | } | ||
| 292 | |||
| 293 | DEFUN ("get-pos-property", Fget_pos_property, Sget_pos_property, 2, 3, 0, | 275 | DEFUN ("get-pos-property", Fget_pos_property, Sget_pos_property, 2, 3, 0, |
| 294 | doc: /* Return the value of POSITION's property PROP, in OBJECT. | 276 | doc: /* Return the value of POSITION's property PROP, in OBJECT. |
| 295 | Almost identical to `get-char-property' except for the following difference: | 277 | Almost identical to `get-char-property' except for the following difference: |
| @@ -315,53 +297,44 @@ at POSITION. */) | |||
| 315 | else | 297 | else |
| 316 | { | 298 | { |
| 317 | EMACS_INT posn = XFIXNUM (position); | 299 | EMACS_INT posn = XFIXNUM (position); |
| 318 | ptrdiff_t noverlays; | 300 | Lisp_Object tem; |
| 319 | Lisp_Object *overlay_vec, tem; | ||
| 320 | struct buffer *obuf = current_buffer; | 301 | struct buffer *obuf = current_buffer; |
| 321 | USE_SAFE_ALLOCA; | 302 | struct itree_node *node; |
| 322 | 303 | struct sortvec items[2]; | |
| 323 | set_buffer_temp (XBUFFER (object)); | 304 | struct buffer *b = XBUFFER (object); |
| 305 | struct sortvec *result = NULL; | ||
| 306 | Lisp_Object res = Qnil; | ||
| 324 | 307 | ||
| 325 | /* First try with room for 40 overlays. */ | 308 | set_buffer_temp (b); |
| 326 | Lisp_Object overlay_vecbuf[40]; | ||
| 327 | noverlays = ARRAYELTS (overlay_vecbuf); | ||
| 328 | overlay_vec = overlay_vecbuf; | ||
| 329 | noverlays = overlays_around (posn, overlay_vec, noverlays); | ||
| 330 | 309 | ||
| 331 | /* If there are more than 40, | 310 | ITREE_FOREACH (node, b->overlays, posn - 1, posn + 1, ASCENDING) |
| 332 | make enough space for all, and try again. */ | ||
| 333 | if (ARRAYELTS (overlay_vecbuf) < noverlays) | ||
| 334 | { | 311 | { |
| 335 | SAFE_ALLOCA_LISP (overlay_vec, noverlays); | 312 | Lisp_Object ol = node->data; |
| 336 | noverlays = overlays_around (posn, overlay_vec, noverlays); | ||
| 337 | } | ||
| 338 | noverlays = sort_overlays (overlay_vec, noverlays, NULL); | ||
| 339 | |||
| 340 | set_buffer_temp (obuf); | ||
| 341 | |||
| 342 | /* Now check the overlays in order of decreasing priority. */ | ||
| 343 | while (--noverlays >= 0) | ||
| 344 | { | ||
| 345 | Lisp_Object ol = overlay_vec[noverlays]; | ||
| 346 | tem = Foverlay_get (ol, prop); | 313 | tem = Foverlay_get (ol, prop); |
| 347 | if (!NILP (tem)) | 314 | if (NILP (tem) |
| 348 | { | ||
| 349 | /* Check the overlay is indeed active at point. */ | 315 | /* Check the overlay is indeed active at point. */ |
| 350 | if ((OVERLAY_START (ol) == posn | 316 | || ((node->begin == posn |
| 351 | && OVERLAY_FRONT_ADVANCE_P (ol)) | 317 | && OVERLAY_FRONT_ADVANCE_P (ol)) |
| 352 | || (OVERLAY_END (ol) == posn | 318 | || (node->end == posn |
| 353 | && ! OVERLAY_REAR_ADVANCE_P (ol)) | 319 | && ! OVERLAY_REAR_ADVANCE_P (ol)) |
| 354 | || OVERLAY_START (ol) > posn | 320 | || node->begin > posn |
| 355 | || OVERLAY_END (ol) < posn) | 321 | || node->end < posn)) |
| 356 | ; /* The overlay will not cover a char inserted at point. */ | 322 | /* The overlay will not cover a char inserted at point. */ |
| 357 | else | 323 | continue; |
| 358 | { | 324 | |
| 359 | SAFE_FREE (); | 325 | struct sortvec *this = (result == items ? items + 1 : items); |
| 360 | return tem; | 326 | if (NILP (res) |
| 361 | } | 327 | || (make_sortvec_item (this, node->data), |
| 362 | } | 328 | compare_overlays (result, this) < 0)) |
| 329 | { | ||
| 330 | result = this; | ||
| 331 | res = tem; | ||
| 332 | } | ||
| 363 | } | 333 | } |
| 364 | SAFE_FREE (); | 334 | set_buffer_temp (obuf); |
| 335 | |||
| 336 | if (!NILP (res)) | ||
| 337 | return res; | ||
| 365 | 338 | ||
| 366 | { /* Now check the text properties. */ | 339 | { /* Now check the text properties. */ |
| 367 | int stickiness = text_property_stickiness (prop, position, object); | 340 | int stickiness = text_property_stickiness (prop, position, object); |
diff --git a/src/emacs.c b/src/emacs.c index 97c65fbfd33..f4bfb9a6bbd 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -3116,10 +3116,6 @@ shut_down_emacs (int sig, Lisp_Object stuff) | |||
| 3116 | check_message_stack (); | 3116 | check_message_stack (); |
| 3117 | } | 3117 | } |
| 3118 | 3118 | ||
| 3119 | #ifdef HAVE_NATIVE_COMP | ||
| 3120 | eln_load_path_final_clean_up (); | ||
| 3121 | #endif | ||
| 3122 | |||
| 3123 | #ifdef MSDOS | 3119 | #ifdef MSDOS |
| 3124 | dos_cleanup (); | 3120 | dos_cleanup (); |
| 3125 | #endif | 3121 | #endif |
diff --git a/src/eval.c b/src/eval.c index 6f1c39ffb0e..9d3b98eb359 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -3122,19 +3122,6 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) | |||
| 3122 | xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); | 3122 | xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); |
| 3123 | } | 3123 | } |
| 3124 | 3124 | ||
| 3125 | /* Call the compiled Lisp function FUN. If we have not yet read FUN's | ||
| 3126 | bytecode string and constants vector, fetch them from the file first. */ | ||
| 3127 | |||
| 3128 | static Lisp_Object | ||
| 3129 | fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, | ||
| 3130 | ptrdiff_t nargs, Lisp_Object *args) | ||
| 3131 | { | ||
| 3132 | if (CONSP (AREF (fun, COMPILED_BYTECODE))) | ||
| 3133 | Ffetch_bytecode (fun); | ||
| 3134 | |||
| 3135 | return exec_byte_code (fun, args_template, nargs, args); | ||
| 3136 | } | ||
| 3137 | |||
| 3138 | static Lisp_Object | 3125 | static Lisp_Object |
| 3139 | apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count) | 3126 | apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count) |
| 3140 | { | 3127 | { |
| @@ -3204,8 +3191,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, | |||
| 3204 | ARGLIST slot value: pass the arguments to the byte-code | 3191 | ARGLIST slot value: pass the arguments to the byte-code |
| 3205 | engine directly. */ | 3192 | engine directly. */ |
| 3206 | if (FIXNUMP (syms_left)) | 3193 | if (FIXNUMP (syms_left)) |
| 3207 | return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left), | 3194 | return exec_byte_code (fun, XFIXNUM (syms_left), nargs, arg_vector); |
| 3208 | nargs, arg_vector); | ||
| 3209 | /* Otherwise the bytecode object uses dynamic binding and the | 3195 | /* Otherwise the bytecode object uses dynamic binding and the |
| 3210 | ARGLIST slot contains a standard formal argument list whose | 3196 | ARGLIST slot contains a standard formal argument list whose |
| 3211 | variables are bound dynamically below. */ | 3197 | variables are bound dynamically below. */ |
| @@ -3293,7 +3279,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, | |||
| 3293 | val = XSUBR (fun)->function.a0 (); | 3279 | val = XSUBR (fun)->function.a0 (); |
| 3294 | } | 3280 | } |
| 3295 | else | 3281 | else |
| 3296 | val = fetch_and_exec_byte_code (fun, 0, 0, NULL); | 3282 | val = exec_byte_code (fun, 0, 0, NULL); |
| 3297 | 3283 | ||
| 3298 | return unbind_to (count, val); | 3284 | return unbind_to (count, val); |
| 3299 | } | 3285 | } |
| @@ -3411,46 +3397,6 @@ lambda_arity (Lisp_Object fun) | |||
| 3411 | return Fcons (make_fixnum (minargs), make_fixnum (maxargs)); | 3397 | return Fcons (make_fixnum (minargs), make_fixnum (maxargs)); |
| 3412 | } | 3398 | } |
| 3413 | 3399 | ||
| 3414 | DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, | ||
| 3415 | 1, 1, 0, | ||
| 3416 | doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */) | ||
| 3417 | (Lisp_Object object) | ||
| 3418 | { | ||
| 3419 | Lisp_Object tem; | ||
| 3420 | |||
| 3421 | if (COMPILEDP (object)) | ||
| 3422 | { | ||
| 3423 | if (CONSP (AREF (object, COMPILED_BYTECODE))) | ||
| 3424 | { | ||
| 3425 | tem = read_doc_string (AREF (object, COMPILED_BYTECODE)); | ||
| 3426 | if (! (CONSP (tem) && STRINGP (XCAR (tem)) | ||
| 3427 | && VECTORP (XCDR (tem)))) | ||
| 3428 | { | ||
| 3429 | tem = AREF (object, COMPILED_BYTECODE); | ||
| 3430 | if (CONSP (tem) && STRINGP (XCAR (tem))) | ||
| 3431 | error ("Invalid byte code in %s", SDATA (XCAR (tem))); | ||
| 3432 | else | ||
| 3433 | error ("Invalid byte code"); | ||
| 3434 | } | ||
| 3435 | |||
| 3436 | Lisp_Object bytecode = XCAR (tem); | ||
| 3437 | if (STRING_MULTIBYTE (bytecode)) | ||
| 3438 | { | ||
| 3439 | /* BYTECODE must have been produced by Emacs 20.2 or earlier | ||
| 3440 | because it produced a raw 8-bit string for byte-code and now | ||
| 3441 | such a byte-code string is loaded as multibyte with raw 8-bit | ||
| 3442 | characters converted to multibyte form. Convert them back to | ||
| 3443 | the original unibyte form. */ | ||
| 3444 | bytecode = Fstring_as_unibyte (bytecode); | ||
| 3445 | } | ||
| 3446 | |||
| 3447 | pin_string (bytecode); | ||
| 3448 | ASET (object, COMPILED_BYTECODE, bytecode); | ||
| 3449 | ASET (object, COMPILED_CONSTANTS, XCDR (tem)); | ||
| 3450 | } | ||
| 3451 | } | ||
| 3452 | return object; | ||
| 3453 | } | ||
| 3454 | 3400 | ||
| 3455 | /* Return true if SYMBOL's default currently has a let-binding | 3401 | /* Return true if SYMBOL's default currently has a let-binding |
| 3456 | which was made in the buffer that is now current. */ | 3402 | which was made in the buffer that is now current. */ |
| @@ -3529,7 +3475,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3529 | switch (sym->u.s.redirect) | 3475 | switch (sym->u.s.redirect) |
| 3530 | { | 3476 | { |
| 3531 | case SYMBOL_VARALIAS: | 3477 | case SYMBOL_VARALIAS: |
| 3532 | sym = SYMBOL_ALIAS (sym); XSETSYMBOL (symbol, sym); goto start; | 3478 | sym = SYMBOL_ALIAS (sym); symbol = make_lisp_symbol (sym); goto start; |
| 3533 | case SYMBOL_PLAINVAL: | 3479 | case SYMBOL_PLAINVAL: |
| 3534 | /* The most common case is that of a non-constant symbol with a | 3480 | /* The most common case is that of a non-constant symbol with a |
| 3535 | trivial value. Make that as fast as we can. */ | 3481 | trivial value. Make that as fast as we can. */ |
| @@ -4512,7 +4458,6 @@ alist of active lexical bindings. */); | |||
| 4512 | defsubr (&Srun_hook_with_args_until_success); | 4458 | defsubr (&Srun_hook_with_args_until_success); |
| 4513 | defsubr (&Srun_hook_with_args_until_failure); | 4459 | defsubr (&Srun_hook_with_args_until_failure); |
| 4514 | defsubr (&Srun_hook_wrapped); | 4460 | defsubr (&Srun_hook_wrapped); |
| 4515 | defsubr (&Sfetch_bytecode); | ||
| 4516 | defsubr (&Sbacktrace_debug); | 4461 | defsubr (&Sbacktrace_debug); |
| 4517 | DEFSYM (QCdebug_on_exit, ":debug-on-exit"); | 4462 | DEFSYM (QCdebug_on_exit, ":debug-on-exit"); |
| 4518 | defsubr (&Smapbacktrace); | 4463 | defsubr (&Smapbacktrace); |
diff --git a/src/fileio.c b/src/fileio.c index a92da93ae48..483498fd879 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -5628,7 +5628,15 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, | |||
| 5628 | changed to a call to `stat'. */ | 5628 | changed to a call to `stat'. */ |
| 5629 | 5629 | ||
| 5630 | if (emacs_fstatat (AT_FDCWD, fn, &st1, 0) == 0 | 5630 | if (emacs_fstatat (AT_FDCWD, fn, &st1, 0) == 0 |
| 5631 | && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino) | 5631 | && st.st_dev == st1.st_dev |
| 5632 | && (st.st_ino == st1.st_ino | ||
| 5633 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY | ||
| 5634 | /* `st1.st_ino' == 0 indicates that the inode number | ||
| 5635 | cannot be extracted from this document file, despite | ||
| 5636 | `st' potentially being backed by a real file. */ | ||
| 5637 | || st1.st_ino == 0 | ||
| 5638 | #endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ | ||
| 5639 | )) | ||
| 5632 | { | 5640 | { |
| 5633 | /* Use the heuristic if it appears to be valid. With neither | 5641 | /* Use the heuristic if it appears to be valid. With neither |
| 5634 | O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the | 5642 | O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the |
| @@ -2782,13 +2782,8 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, | |||
| 2782 | 2782 | ||
| 2783 | /* A symbol with position compares the contained symbol, and is | 2783 | /* A symbol with position compares the contained symbol, and is |
| 2784 | `equal' to the corresponding ordinary symbol. */ | 2784 | `equal' to the corresponding ordinary symbol. */ |
| 2785 | if (symbols_with_pos_enabled) | 2785 | o1 = maybe_remove_pos_from_symbol (o1); |
| 2786 | { | 2786 | o2 = maybe_remove_pos_from_symbol (o2); |
| 2787 | if (SYMBOL_WITH_POS_P (o1)) | ||
| 2788 | o1 = SYMBOL_WITH_POS_SYM (o1); | ||
| 2789 | if (SYMBOL_WITH_POS_P (o2)) | ||
| 2790 | o2 = SYMBOL_WITH_POS_SYM (o2); | ||
| 2791 | } | ||
| 2792 | 2787 | ||
| 2793 | if (BASE_EQ (o1, o2)) | 2788 | if (BASE_EQ (o1, o2)) |
| 2794 | return true; | 2789 | return true; |
| @@ -2869,11 +2864,14 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, | |||
| 2869 | if (TS_NODEP (o1)) | 2864 | if (TS_NODEP (o1)) |
| 2870 | return treesit_node_eq (o1, o2); | 2865 | return treesit_node_eq (o1, o2); |
| 2871 | #endif | 2866 | #endif |
| 2872 | if (SYMBOL_WITH_POS_P(o1)) /* symbols_with_pos_enabled is false. */ | 2867 | if (SYMBOL_WITH_POS_P (o1)) |
| 2873 | return (BASE_EQ (XSYMBOL_WITH_POS (o1)->sym, | 2868 | { |
| 2874 | XSYMBOL_WITH_POS (o2)->sym) | 2869 | eassert (!symbols_with_pos_enabled); |
| 2875 | && BASE_EQ (XSYMBOL_WITH_POS (o1)->pos, | 2870 | return (BASE_EQ (XSYMBOL_WITH_POS_SYM (o1), |
| 2876 | XSYMBOL_WITH_POS (o2)->pos)); | 2871 | XSYMBOL_WITH_POS_SYM (o2)) |
| 2872 | && BASE_EQ (XSYMBOL_WITH_POS_POS (o1), | ||
| 2873 | XSYMBOL_WITH_POS_POS (o2))); | ||
| 2874 | } | ||
| 2877 | 2875 | ||
| 2878 | /* Aside from them, only true vectors, char-tables, compiled | 2876 | /* Aside from them, only true vectors, char-tables, compiled |
| 2879 | functions, and fonts (font-spec, font-entity, font-object) | 2877 | functions, and fonts (font-spec, font-entity, font-object) |
| @@ -3211,7 +3209,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) | |||
| 3211 | Lisp_Object | 3209 | Lisp_Object |
| 3212 | do_yes_or_no_p (Lisp_Object prompt) | 3210 | do_yes_or_no_p (Lisp_Object prompt) |
| 3213 | { | 3211 | { |
| 3214 | return call1 (intern ("yes-or-no-p"), prompt); | 3212 | return call1 (Qyes_or_no_p, prompt); |
| 3215 | } | 3213 | } |
| 3216 | 3214 | ||
| 3217 | DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, | 3215 | DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, |
| @@ -3256,7 +3254,7 @@ by a mouse, or by some window-system gesture, or via a menu. */) | |||
| 3256 | } | 3254 | } |
| 3257 | 3255 | ||
| 3258 | if (use_short_answers) | 3256 | if (use_short_answers) |
| 3259 | return call1 (intern ("y-or-n-p"), prompt); | 3257 | return call1 (Qy_or_n_p, prompt); |
| 3260 | 3258 | ||
| 3261 | { | 3259 | { |
| 3262 | char *s = SSDATA (prompt); | 3260 | char *s = SSDATA (prompt); |
| @@ -4291,7 +4289,7 @@ set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, hash_hash_t val) | |||
| 4291 | static void | 4289 | static void |
| 4292 | set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) | 4290 | set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) |
| 4293 | { | 4291 | { |
| 4294 | eassert (idx >= 0 && idx < h->index_size); | 4292 | eassert (idx >= 0 && idx < hash_table_index_size (h)); |
| 4295 | h->index[idx] = val; | 4293 | h->index[idx] = val; |
| 4296 | } | 4294 | } |
| 4297 | 4295 | ||
| @@ -4392,7 +4390,7 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) | |||
| 4392 | static ptrdiff_t | 4390 | static ptrdiff_t |
| 4393 | HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) | 4391 | HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) |
| 4394 | { | 4392 | { |
| 4395 | eassert (idx >= 0 && idx < h->index_size); | 4393 | eassert (idx >= 0 && idx < hash_table_index_size (h)); |
| 4396 | return h->index[idx]; | 4394 | return h->index[idx]; |
| 4397 | } | 4395 | } |
| 4398 | 4396 | ||
| @@ -4452,22 +4450,11 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, | |||
| 4452 | return hash_table_user_defined_call (ARRAYELTS (args), args, h); | 4450 | return hash_table_user_defined_call (ARRAYELTS (args), args, h); |
| 4453 | } | 4451 | } |
| 4454 | 4452 | ||
| 4455 | /* Reduce an EMACS_UINT hash value to hash_hash_t. */ | ||
| 4456 | static inline hash_hash_t | ||
| 4457 | reduce_emacs_uint_to_hash_hash (EMACS_UINT x) | ||
| 4458 | { | ||
| 4459 | verify (sizeof x <= 2 * sizeof (hash_hash_t)); | ||
| 4460 | return (sizeof x == sizeof (hash_hash_t) | ||
| 4461 | ? x | ||
| 4462 | : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); | ||
| 4463 | } | ||
| 4464 | |||
| 4465 | static EMACS_INT | 4453 | static EMACS_INT |
| 4466 | sxhash_eq (Lisp_Object key) | 4454 | sxhash_eq (Lisp_Object key) |
| 4467 | { | 4455 | { |
| 4468 | if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) | 4456 | Lisp_Object k = maybe_remove_pos_from_symbol (key); |
| 4469 | key = SYMBOL_WITH_POS_SYM (key); | 4457 | return XHASH (k) ^ XTYPE (k); |
| 4470 | return XHASH (key) ^ XTYPE (key); | ||
| 4471 | } | 4458 | } |
| 4472 | 4459 | ||
| 4473 | static EMACS_INT | 4460 | static EMACS_INT |
| @@ -4527,26 +4514,19 @@ allocate_hash_table (void) | |||
| 4527 | return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE); | 4514 | return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE); |
| 4528 | } | 4515 | } |
| 4529 | 4516 | ||
| 4530 | /* Compute the size of the index from the table capacity. */ | 4517 | /* Compute the size of the index (as log2) from the table capacity. */ |
| 4531 | static ptrdiff_t | 4518 | static int |
| 4532 | hash_index_size (ptrdiff_t size) | 4519 | compute_hash_index_bits (hash_idx_t size) |
| 4533 | { | 4520 | { |
| 4534 | /* An upper bound on the size of a hash table index. It must fit in | 4521 | /* An upper bound on the size of a hash table index index. */ |
| 4535 | ptrdiff_t and be a valid Emacs fixnum. */ | 4522 | hash_idx_t upper_bound = min (MOST_POSITIVE_FIXNUM, |
| 4536 | ptrdiff_t upper_bound = min (MOST_POSITIVE_FIXNUM, | 4523 | min (TYPE_MAXIMUM (hash_idx_t), |
| 4537 | min (TYPE_MAXIMUM (hash_idx_t), | 4524 | PTRDIFF_MAX / sizeof (hash_idx_t))); |
| 4538 | PTRDIFF_MAX / sizeof (ptrdiff_t))); | 4525 | /* Use next higher power of 2. This works even for size=0. */ |
| 4539 | /* Single-element index vectors are used iff size=0. */ | 4526 | int bits = elogb (size) + 1; |
| 4540 | eassert (size > 0); | 4527 | if (bits >= TYPE_WIDTH (uintmax_t) || ((uintmax_t)1 << bits) > upper_bound) |
| 4541 | ptrdiff_t lower_bound = 2; | ||
| 4542 | ptrdiff_t index_size = size + max (size >> 2, 1); /* 1.25x larger */ | ||
| 4543 | if (index_size < upper_bound) | ||
| 4544 | index_size = (index_size < lower_bound | ||
| 4545 | ? lower_bound | ||
| 4546 | : next_almost_prime (index_size)); | ||
| 4547 | if (index_size > upper_bound) | ||
| 4548 | error ("Hash table too large"); | 4528 | error ("Hash table too large"); |
| 4549 | return index_size; | 4529 | return bits; |
| 4550 | } | 4530 | } |
| 4551 | 4531 | ||
| 4552 | /* Constant hash index vector used when the table size is zero. | 4532 | /* Constant hash index vector used when the table size is zero. |
| @@ -4587,7 +4567,7 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, | |||
| 4587 | h->key_and_value = NULL; | 4567 | h->key_and_value = NULL; |
| 4588 | h->hash = NULL; | 4568 | h->hash = NULL; |
| 4589 | h->next = NULL; | 4569 | h->next = NULL; |
| 4590 | h->index_size = 1; | 4570 | h->index_bits = 0; |
| 4591 | h->index = (hash_idx_t *)empty_hash_index_vector; | 4571 | h->index = (hash_idx_t *)empty_hash_index_vector; |
| 4592 | h->next_free = -1; | 4572 | h->next_free = -1; |
| 4593 | } | 4573 | } |
| @@ -4605,8 +4585,9 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, | |||
| 4605 | h->next[i] = i + 1; | 4585 | h->next[i] = i + 1; |
| 4606 | h->next[size - 1] = -1; | 4586 | h->next[size - 1] = -1; |
| 4607 | 4587 | ||
| 4608 | int index_size = hash_index_size (size); | 4588 | int index_bits = compute_hash_index_bits (size); |
| 4609 | h->index_size = index_size; | 4589 | h->index_bits = index_bits; |
| 4590 | ptrdiff_t index_size = hash_table_index_size (h); | ||
| 4610 | h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); | 4591 | h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); |
| 4611 | for (ptrdiff_t i = 0; i < index_size; i++) | 4592 | for (ptrdiff_t i = 0; i < index_size; i++) |
| 4612 | h->index[i] = -1; | 4593 | h->index[i] = -1; |
| @@ -4617,13 +4598,7 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, | |||
| 4617 | h->next_weak = NULL; | 4598 | h->next_weak = NULL; |
| 4618 | h->purecopy = purecopy; | 4599 | h->purecopy = purecopy; |
| 4619 | h->mutable = true; | 4600 | h->mutable = true; |
| 4620 | 4601 | return make_lisp_hash_table (h); | |
| 4621 | Lisp_Object table; | ||
| 4622 | XSET_HASH_TABLE (table, h); | ||
| 4623 | eassert (HASH_TABLE_P (table)); | ||
| 4624 | eassert (XHASH_TABLE (table) == h); | ||
| 4625 | |||
| 4626 | return table; | ||
| 4627 | } | 4602 | } |
| 4628 | 4603 | ||
| 4629 | 4604 | ||
| @@ -4633,7 +4608,6 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, | |||
| 4633 | static Lisp_Object | 4608 | static Lisp_Object |
| 4634 | copy_hash_table (struct Lisp_Hash_Table *h1) | 4609 | copy_hash_table (struct Lisp_Hash_Table *h1) |
| 4635 | { | 4610 | { |
| 4636 | Lisp_Object table; | ||
| 4637 | struct Lisp_Hash_Table *h2; | 4611 | struct Lisp_Hash_Table *h2; |
| 4638 | 4612 | ||
| 4639 | h2 = allocate_hash_table (); | 4613 | h2 = allocate_hash_table (); |
| @@ -4654,22 +4628,18 @@ copy_hash_table (struct Lisp_Hash_Table *h1) | |||
| 4654 | h2->next = hash_table_alloc_bytes (next_bytes); | 4628 | h2->next = hash_table_alloc_bytes (next_bytes); |
| 4655 | memcpy (h2->next, h1->next, next_bytes); | 4629 | memcpy (h2->next, h1->next, next_bytes); |
| 4656 | 4630 | ||
| 4657 | ptrdiff_t index_bytes = h1->index_size * sizeof *h1->index; | 4631 | ptrdiff_t index_bytes = hash_table_index_size (h1) * sizeof *h1->index; |
| 4658 | h2->index = hash_table_alloc_bytes (index_bytes); | 4632 | h2->index = hash_table_alloc_bytes (index_bytes); |
| 4659 | memcpy (h2->index, h1->index, index_bytes); | 4633 | memcpy (h2->index, h1->index, index_bytes); |
| 4660 | } | 4634 | } |
| 4661 | XSET_HASH_TABLE (table, h2); | 4635 | return make_lisp_hash_table (h2); |
| 4662 | |||
| 4663 | return table; | ||
| 4664 | } | 4636 | } |
| 4665 | 4637 | ||
| 4666 | |||
| 4667 | /* Compute index into the index vector from a hash value. */ | 4638 | /* Compute index into the index vector from a hash value. */ |
| 4668 | static inline ptrdiff_t | 4639 | static inline ptrdiff_t |
| 4669 | hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash) | 4640 | hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash) |
| 4670 | { | 4641 | { |
| 4671 | eassert (h->index_size > 0); | 4642 | return knuth_hash (hash, h->index_bits); |
| 4672 | return hash % h->index_size; | ||
| 4673 | } | 4643 | } |
| 4674 | 4644 | ||
| 4675 | /* Resize hash table H if it's too full. If H cannot be resized | 4645 | /* Resize hash table H if it's too full. If H cannot be resized |
| @@ -4681,7 +4651,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) | |||
| 4681 | if (h->next_free < 0) | 4651 | if (h->next_free < 0) |
| 4682 | { | 4652 | { |
| 4683 | ptrdiff_t old_size = HASH_TABLE_SIZE (h); | 4653 | ptrdiff_t old_size = HASH_TABLE_SIZE (h); |
| 4684 | ptrdiff_t min_size = 8; | 4654 | ptrdiff_t min_size = 6; |
| 4685 | ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2); | 4655 | ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2); |
| 4686 | /* Grow aggressively at small sizes, then just double. */ | 4656 | /* Grow aggressively at small sizes, then just double. */ |
| 4687 | ptrdiff_t new_size = | 4657 | ptrdiff_t new_size = |
| @@ -4706,13 +4676,14 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) | |||
| 4706 | hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash); | 4676 | hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash); |
| 4707 | memcpy (hash, h->hash, old_size * sizeof *hash); | 4677 | memcpy (hash, h->hash, old_size * sizeof *hash); |
| 4708 | 4678 | ||
| 4709 | ptrdiff_t old_index_size = h->index_size; | 4679 | ptrdiff_t old_index_size = hash_table_index_size (h); |
| 4710 | ptrdiff_t index_size = hash_index_size (new_size); | 4680 | ptrdiff_t index_bits = compute_hash_index_bits (new_size); |
| 4681 | ptrdiff_t index_size = (ptrdiff_t)1 << index_bits; | ||
| 4711 | hash_idx_t *index = hash_table_alloc_bytes (index_size * sizeof *index); | 4682 | hash_idx_t *index = hash_table_alloc_bytes (index_size * sizeof *index); |
| 4712 | for (ptrdiff_t i = 0; i < index_size; i++) | 4683 | for (ptrdiff_t i = 0; i < index_size; i++) |
| 4713 | index[i] = -1; | 4684 | index[i] = -1; |
| 4714 | 4685 | ||
| 4715 | h->index_size = index_size; | 4686 | h->index_bits = index_bits; |
| 4716 | h->table_size = new_size; | 4687 | h->table_size = new_size; |
| 4717 | h->next_free = old_size; | 4688 | h->next_free = old_size; |
| 4718 | 4689 | ||
| @@ -4778,18 +4749,19 @@ hash_table_thaw (Lisp_Object hash_table) | |||
| 4778 | h->key_and_value = NULL; | 4749 | h->key_and_value = NULL; |
| 4779 | h->hash = NULL; | 4750 | h->hash = NULL; |
| 4780 | h->next = NULL; | 4751 | h->next = NULL; |
| 4781 | h->index_size = 1; | 4752 | h->index_bits = 0; |
| 4782 | h->index = (hash_idx_t *)empty_hash_index_vector; | 4753 | h->index = (hash_idx_t *)empty_hash_index_vector; |
| 4783 | } | 4754 | } |
| 4784 | else | 4755 | else |
| 4785 | { | 4756 | { |
| 4786 | ptrdiff_t index_size = hash_index_size (size); | 4757 | ptrdiff_t index_bits = compute_hash_index_bits (size); |
| 4787 | h->index_size = index_size; | 4758 | h->index_bits = index_bits; |
| 4788 | 4759 | ||
| 4789 | h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); | 4760 | h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); |
| 4790 | 4761 | ||
| 4791 | h->next = hash_table_alloc_bytes (size * sizeof *h->next); | 4762 | h->next = hash_table_alloc_bytes (size * sizeof *h->next); |
| 4792 | 4763 | ||
| 4764 | ptrdiff_t index_size = hash_table_index_size (h); | ||
| 4793 | h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); | 4765 | h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); |
| 4794 | for (ptrdiff_t i = 0; i < index_size; i++) | 4766 | for (ptrdiff_t i = 0; i < index_size; i++) |
| 4795 | h->index[i] = -1; | 4767 | h->index[i] = -1; |
| @@ -4937,7 +4909,8 @@ hash_clear (struct Lisp_Hash_Table *h) | |||
| 4937 | set_hash_value_slot (h, i, Qnil); | 4909 | set_hash_value_slot (h, i, Qnil); |
| 4938 | } | 4910 | } |
| 4939 | 4911 | ||
| 4940 | for (ptrdiff_t i = 0; i < h->index_size; i++) | 4912 | ptrdiff_t index_size = hash_table_index_size (h); |
| 4913 | for (ptrdiff_t i = 0; i < index_size; i++) | ||
| 4941 | h->index[i] = -1; | 4914 | h->index[i] = -1; |
| 4942 | 4915 | ||
| 4943 | h->next_free = 0; | 4916 | h->next_free = 0; |
| @@ -4976,7 +4949,7 @@ keep_entry_p (hash_table_weakness_t weakness, | |||
| 4976 | bool | 4949 | bool |
| 4977 | sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) | 4950 | sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) |
| 4978 | { | 4951 | { |
| 4979 | ptrdiff_t n = h->index_size; | 4952 | ptrdiff_t n = hash_table_index_size (h); |
| 4980 | bool marked = false; | 4953 | bool marked = false; |
| 4981 | 4954 | ||
| 4982 | for (ptrdiff_t bucket = 0; bucket < n; ++bucket) | 4955 | for (ptrdiff_t bucket = 0; bucket < n; ++bucket) |
| @@ -5072,24 +5045,52 @@ hash_string (char const *ptr, ptrdiff_t len) | |||
| 5072 | EMACS_UINT hash = len; | 5045 | EMACS_UINT hash = len; |
| 5073 | /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course, | 5046 | /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course, |
| 5074 | * but dividing by 8 is cheaper. */ | 5047 | * but dividing by 8 is cheaper. */ |
| 5075 | ptrdiff_t step = sizeof hash + ((end - p) >> 3); | 5048 | ptrdiff_t step = max (sizeof hash, ((end - p) >> 3)); |
| 5076 | 5049 | ||
| 5077 | while (p + sizeof hash <= end) | 5050 | if (p + sizeof hash <= end) |
| 5078 | { | 5051 | { |
| 5052 | do | ||
| 5053 | { | ||
| 5054 | EMACS_UINT c; | ||
| 5055 | /* We presume that the compiler will replace this `memcpy` with | ||
| 5056 | a single load/move instruction when applicable. */ | ||
| 5057 | memcpy (&c, p, sizeof hash); | ||
| 5058 | p += step; | ||
| 5059 | hash = sxhash_combine (hash, c); | ||
| 5060 | } | ||
| 5061 | while (p + sizeof hash <= end); | ||
| 5062 | /* Hash the last wordful of bytes in the string, because that is | ||
| 5063 | is often the part where strings differ. This may cause some | ||
| 5064 | bytes to be hashed twice but we assume that's not a big problem. */ | ||
| 5079 | EMACS_UINT c; | 5065 | EMACS_UINT c; |
| 5080 | /* We presume that the compiler will replace this `memcpy` with | 5066 | memcpy (&c, end - sizeof c, sizeof c); |
| 5081 | a single load/move instruction when applicable. */ | ||
| 5082 | memcpy (&c, p, sizeof hash); | ||
| 5083 | p += step; | ||
| 5084 | hash = sxhash_combine (hash, c); | 5067 | hash = sxhash_combine (hash, c); |
| 5085 | } | 5068 | } |
| 5086 | /* A few last bytes may remain (smaller than an EMACS_UINT). */ | 5069 | else |
| 5087 | /* FIXME: We could do this without a loop, but it'd require | ||
| 5088 | endian-dependent code :-( */ | ||
| 5089 | while (p < end) | ||
| 5090 | { | 5070 | { |
| 5091 | unsigned char c = *p++; | 5071 | /* String is shorter than an EMACS_UINT. Use smaller loads. */ |
| 5092 | hash = sxhash_combine (hash, c); | 5072 | eassume (p <= end && end - p < sizeof (EMACS_UINT)); |
| 5073 | EMACS_UINT tail = 0; | ||
| 5074 | verify (sizeof tail <= 8); | ||
| 5075 | #if EMACS_INT_MAX > INT32_MAX | ||
| 5076 | if (end - p >= 4) | ||
| 5077 | { | ||
| 5078 | uint32_t c; | ||
| 5079 | memcpy (&c, p, sizeof c); | ||
| 5080 | tail = (tail << (8 * sizeof c)) + c; | ||
| 5081 | p += sizeof c; | ||
| 5082 | } | ||
| 5083 | #endif | ||
| 5084 | if (end - p >= 2) | ||
| 5085 | { | ||
| 5086 | uint16_t c; | ||
| 5087 | memcpy (&c, p, sizeof c); | ||
| 5088 | tail = (tail << (8 * sizeof c)) + c; | ||
| 5089 | p += sizeof c; | ||
| 5090 | } | ||
| 5091 | if (p < end) | ||
| 5092 | tail = (tail << 8) + (unsigned char)*p; | ||
| 5093 | hash = sxhash_combine (hash, tail); | ||
| 5093 | } | 5094 | } |
| 5094 | 5095 | ||
| 5095 | return hash; | 5096 | return hash; |
| @@ -5177,7 +5178,7 @@ sxhash_bignum (Lisp_Object bignum) | |||
| 5177 | { | 5178 | { |
| 5178 | mpz_t const *n = xbignum_val (bignum); | 5179 | mpz_t const *n = xbignum_val (bignum); |
| 5179 | size_t i, nlimbs = mpz_size (*n); | 5180 | size_t i, nlimbs = mpz_size (*n); |
| 5180 | EMACS_UINT hash = 0; | 5181 | EMACS_UINT hash = mpz_sgn(*n) < 0; |
| 5181 | 5182 | ||
| 5182 | for (i = 0; i < nlimbs; ++i) | 5183 | for (i = 0; i < nlimbs; ++i) |
| 5183 | hash = sxhash_combine (hash, mpz_getlimbn (*n, i)); | 5184 | hash = sxhash_combine (hash, mpz_getlimbn (*n, i)); |
| @@ -5247,12 +5248,15 @@ sxhash_obj (Lisp_Object obj, int depth) | |||
| 5247 | hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth)); | 5248 | hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth)); |
| 5248 | return hash; | 5249 | return hash; |
| 5249 | } | 5250 | } |
| 5250 | else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) | ||
| 5251 | return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1); | ||
| 5252 | else | 5251 | else |
| 5253 | /* Others are 'equal' if they are 'eq', so take their | 5252 | { |
| 5254 | address as hash. */ | 5253 | if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) |
| 5255 | return XHASH (obj); | 5254 | obj = XSYMBOL_WITH_POS_SYM (obj); |
| 5255 | |||
| 5256 | /* Others are 'equal' if they are 'eq', so take their | ||
| 5257 | address as hash. */ | ||
| 5258 | return XHASH (obj); | ||
| 5259 | } | ||
| 5256 | } | 5260 | } |
| 5257 | 5261 | ||
| 5258 | case Lisp_Cons: | 5262 | case Lisp_Cons: |
| @@ -5374,6 +5378,8 @@ mark_fns (void) | |||
| 5374 | } | 5378 | } |
| 5375 | } | 5379 | } |
| 5376 | 5380 | ||
| 5381 | /* Find the hash_table_test object corresponding to the (bare) symbol TEST, | ||
| 5382 | creating one if none existed. */ | ||
| 5377 | static struct hash_table_test * | 5383 | static struct hash_table_test * |
| 5378 | get_hash_table_user_test (Lisp_Object test) | 5384 | get_hash_table_user_test (Lisp_Object test) |
| 5379 | { | 5385 | { |
| @@ -5384,7 +5390,8 @@ get_hash_table_user_test (Lisp_Object test) | |||
| 5384 | Lisp_Object equal_fn = XCAR (prop); | 5390 | Lisp_Object equal_fn = XCAR (prop); |
| 5385 | Lisp_Object hash_fn = XCAR (XCDR (prop)); | 5391 | Lisp_Object hash_fn = XCAR (XCDR (prop)); |
| 5386 | struct hash_table_user_test *ut = hash_table_user_tests; | 5392 | struct hash_table_user_test *ut = hash_table_user_tests; |
| 5387 | while (ut && !(EQ (equal_fn, ut->test.user_cmp_function) | 5393 | while (ut && !(BASE_EQ (test, ut->test.name) |
| 5394 | && EQ (equal_fn, ut->test.user_cmp_function) | ||
| 5388 | && EQ (hash_fn, ut->test.user_hash_function))) | 5395 | && EQ (hash_fn, ut->test.user_hash_function))) |
| 5389 | ut = ut->next; | 5396 | ut = ut->next; |
| 5390 | if (!ut) | 5397 | if (!ut) |
| @@ -5444,9 +5451,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) | |||
| 5444 | 5451 | ||
| 5445 | /* See if there's a `:test TEST' among the arguments. */ | 5452 | /* See if there's a `:test TEST' among the arguments. */ |
| 5446 | ptrdiff_t i = get_key_arg (QCtest, nargs, args, used); | 5453 | ptrdiff_t i = get_key_arg (QCtest, nargs, args, used); |
| 5447 | Lisp_Object test = i ? args[i] : Qeql; | 5454 | Lisp_Object test = i ? maybe_remove_pos_from_symbol (args[i]) : Qeql; |
| 5448 | if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (test)) | ||
| 5449 | test = SYMBOL_WITH_POS_SYM (test); | ||
| 5450 | const struct hash_table_test *testdesc; | 5455 | const struct hash_table_test *testdesc; |
| 5451 | if (BASE_EQ (test, Qeq)) | 5456 | if (BASE_EQ (test, Qeq)) |
| 5452 | testdesc = &hashtest_eq; | 5457 | testdesc = &hashtest_eq; |
| @@ -5698,7 +5703,7 @@ DEFUN ("internal--hash-table-histogram", | |||
| 5698 | struct Lisp_Hash_Table *h = check_hash_table (hash_table); | 5703 | struct Lisp_Hash_Table *h = check_hash_table (hash_table); |
| 5699 | ptrdiff_t size = HASH_TABLE_SIZE (h); | 5704 | ptrdiff_t size = HASH_TABLE_SIZE (h); |
| 5700 | ptrdiff_t *freq = xzalloc (size * sizeof *freq); | 5705 | ptrdiff_t *freq = xzalloc (size * sizeof *freq); |
| 5701 | ptrdiff_t index_size = h->index_size; | 5706 | ptrdiff_t index_size = hash_table_index_size (h); |
| 5702 | for (ptrdiff_t i = 0; i < index_size; i++) | 5707 | for (ptrdiff_t i = 0; i < index_size; i++) |
| 5703 | { | 5708 | { |
| 5704 | ptrdiff_t n = 0; | 5709 | ptrdiff_t n = 0; |
| @@ -5726,7 +5731,7 @@ Internal use only. */) | |||
| 5726 | { | 5731 | { |
| 5727 | struct Lisp_Hash_Table *h = check_hash_table (hash_table); | 5732 | struct Lisp_Hash_Table *h = check_hash_table (hash_table); |
| 5728 | Lisp_Object ret = Qnil; | 5733 | Lisp_Object ret = Qnil; |
| 5729 | ptrdiff_t index_size = h->index_size; | 5734 | ptrdiff_t index_size = hash_table_index_size (h); |
| 5730 | for (ptrdiff_t i = 0; i < index_size; i++) | 5735 | for (ptrdiff_t i = 0; i < index_size; i++) |
| 5731 | { | 5736 | { |
| 5732 | Lisp_Object bucket = Qnil; | 5737 | Lisp_Object bucket = Qnil; |
| @@ -5747,7 +5752,7 @@ DEFUN ("internal--hash-table-index-size", | |||
| 5747 | (Lisp_Object hash_table) | 5752 | (Lisp_Object hash_table) |
| 5748 | { | 5753 | { |
| 5749 | struct Lisp_Hash_Table *h = check_hash_table (hash_table); | 5754 | struct Lisp_Hash_Table *h = check_hash_table (hash_table); |
| 5750 | return make_int (h->index_size); | 5755 | return make_int (hash_table_index_size (h)); |
| 5751 | } | 5756 | } |
| 5752 | 5757 | ||
| 5753 | 5758 | ||
| @@ -6615,4 +6620,6 @@ For best results this should end in a space. */); | |||
| 6615 | 6620 | ||
| 6616 | DEFSYM (Qreal_this_command, "real-this-command"); | 6621 | DEFSYM (Qreal_this_command, "real-this-command"); |
| 6617 | DEFSYM (Qfrom__tty_menu_p, "from--tty-menu-p"); | 6622 | DEFSYM (Qfrom__tty_menu_p, "from--tty-menu-p"); |
| 6623 | DEFSYM (Qyes_or_no_p, "yes-or-no-p"); | ||
| 6624 | DEFSYM (Qy_or_n_p, "y-or-n-p"); | ||
| 6618 | } | 6625 | } |
diff --git a/src/inotify.c b/src/inotify.c index 2ee874530cc..7140568f1b6 100644 --- a/src/inotify.c +++ b/src/inotify.c | |||
| @@ -26,6 +26,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 26 | #include "termhooks.h" | 26 | #include "termhooks.h" |
| 27 | 27 | ||
| 28 | #include <errno.h> | 28 | #include <errno.h> |
| 29 | #include <fcntl.h> | ||
| 30 | |||
| 29 | #include <sys/inotify.h> | 31 | #include <sys/inotify.h> |
| 30 | #include <sys/ioctl.h> | 32 | #include <sys/ioctl.h> |
| 31 | 33 | ||
| @@ -434,7 +436,15 @@ IN_ONESHOT */) | |||
| 434 | 436 | ||
| 435 | if (inotifyfd < 0) | 437 | if (inotifyfd < 0) |
| 436 | { | 438 | { |
| 439 | #ifdef HAVE_INOTIFY_INIT1 | ||
| 437 | inotifyfd = inotify_init1 (IN_NONBLOCK | IN_CLOEXEC); | 440 | inotifyfd = inotify_init1 (IN_NONBLOCK | IN_CLOEXEC); |
| 441 | #else /* !HAVE_INOTIFY_INIT1 */ | ||
| 442 | /* This is prey to race conditions with other threads calling | ||
| 443 | exec. */ | ||
| 444 | inotifyfd = inotify_init (); | ||
| 445 | fcntl (inotifyfd, F_SETFL, O_NONBLOCK); | ||
| 446 | fcntl (inotifyfd, F_SETFD, O_CLOEXEC); | ||
| 447 | #endif /* HAVE_INOTIFY_INIT1 */ | ||
| 438 | if (inotifyfd < 0) | 448 | if (inotifyfd < 0) |
| 439 | report_file_notify_error ("File watching is not available", Qnil); | 449 | report_file_notify_error ("File watching is not available", Qnil); |
| 440 | watch_list = Qnil; | 450 | watch_list = Qnil; |
diff --git a/src/keyboard.c b/src/keyboard.c index 1f7253a7da1..eb0de98bad1 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -580,7 +580,10 @@ echo_dash (void) | |||
| 580 | idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 1); | 580 | idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 1); |
| 581 | last_char = Faref (KVAR (current_kboard, echo_string), idx); | 581 | last_char = Faref (KVAR (current_kboard, echo_string), idx); |
| 582 | 582 | ||
| 583 | if (XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ') | 583 | if ((XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ') |
| 584 | /* Or a keystroke help message. */ | ||
| 585 | || (echo_keystrokes_help | ||
| 586 | && XFIXNUM (last_char) == ')' && XFIXNUM (prev_char) == 'p')) | ||
| 584 | return; | 587 | return; |
| 585 | } | 588 | } |
| 586 | 589 | ||
| @@ -589,6 +592,12 @@ echo_dash (void) | |||
| 589 | AUTO_STRING (dash, "-"); | 592 | AUTO_STRING (dash, "-"); |
| 590 | kset_echo_string (current_kboard, | 593 | kset_echo_string (current_kboard, |
| 591 | concat2 (KVAR (current_kboard, echo_string), dash)); | 594 | concat2 (KVAR (current_kboard, echo_string), dash)); |
| 595 | |||
| 596 | if (echo_keystrokes_help) | ||
| 597 | kset_echo_string (current_kboard, | ||
| 598 | calln (Qhelp__append_keystrokes_help, | ||
| 599 | KVAR (current_kboard, echo_string))); | ||
| 600 | |||
| 592 | echo_now (); | 601 | echo_now (); |
| 593 | } | 602 | } |
| 594 | 603 | ||
| @@ -1067,8 +1076,9 @@ Default value of `command-error-function'. */) | |||
| 1067 | write to stderr and quit. In daemon mode, there are | 1076 | write to stderr and quit. In daemon mode, there are |
| 1068 | many other potential errors that do not prevent frames | 1077 | many other potential errors that do not prevent frames |
| 1069 | from being created, so continuing as normal is better in | 1078 | from being created, so continuing as normal is better in |
| 1070 | that case. */ | 1079 | that case, as long as the daemon has actually finished |
| 1071 | || (!IS_DAEMON && FRAME_INITIAL_P (sf)) | 1080 | initialization. */ |
| 1081 | || (!(IS_DAEMON && !DAEMON_RUNNING) && FRAME_INITIAL_P (sf)) | ||
| 1072 | || noninteractive)) | 1082 | || noninteractive)) |
| 1073 | { | 1083 | { |
| 1074 | print_error_message (data, Qexternal_debugging_output, | 1084 | print_error_message (data, Qexternal_debugging_output, |
| @@ -12948,6 +12958,8 @@ syms_of_keyboard (void) | |||
| 12948 | 12958 | ||
| 12949 | DEFSYM (Qhelp_key_binding, "help-key-binding"); | 12959 | DEFSYM (Qhelp_key_binding, "help-key-binding"); |
| 12950 | 12960 | ||
| 12961 | DEFSYM (Qhelp__append_keystrokes_help, "help--append-keystrokes-help"); | ||
| 12962 | |||
| 12951 | DEFSYM (Qecho_keystrokes, "echo-keystrokes"); | 12963 | DEFSYM (Qecho_keystrokes, "echo-keystrokes"); |
| 12952 | 12964 | ||
| 12953 | Fset (Qinput_method_exit_on_first_char, Qnil); | 12965 | Fset (Qinput_method_exit_on_first_char, Qnil); |
| @@ -13223,11 +13235,17 @@ Emacs also does a garbage collection if that seems to be warranted. */); | |||
| 13223 | XSETFASTINT (Vauto_save_timeout, 30); | 13235 | XSETFASTINT (Vauto_save_timeout, 30); |
| 13224 | 13236 | ||
| 13225 | DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes, | 13237 | DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes, |
| 13226 | doc: /* Nonzero means echo unfinished commands after this many seconds of pause. | 13238 | doc: /* Nonzero means echo unfinished commands after this many seconds of pause. |
| 13227 | The value may be integer or floating point. | 13239 | The value may be integer or floating point. |
| 13228 | If the value is zero, don't echo at all. */); | 13240 | If the value is zero, don't echo at all. */); |
| 13229 | Vecho_keystrokes = make_fixnum (1); | 13241 | Vecho_keystrokes = make_fixnum (1); |
| 13230 | 13242 | ||
| 13243 | DEFVAR_BOOL ("echo-keystrokes-help", echo_keystrokes_help, | ||
| 13244 | doc: /* Whether to append help text to echoed commands. | ||
| 13245 | When non-nil, a reference to `C-h' is printed after echoed | ||
| 13246 | keystrokes. */); | ||
| 13247 | echo_keystrokes_help = true; | ||
| 13248 | |||
| 13231 | DEFVAR_LISP ("polling-period", Vpolling_period, | 13249 | DEFVAR_LISP ("polling-period", Vpolling_period, |
| 13232 | doc: /* Interval between polling for input during Lisp execution. | 13250 | doc: /* Interval between polling for input during Lisp execution. |
| 13233 | The reason for polling is to make C-g work to stop a running program. | 13251 | The reason for polling is to make C-g work to stop a running program. |
diff --git a/src/lisp.h b/src/lisp.h index 75134425a07..4fc44745211 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -330,7 +330,8 @@ typedef EMACS_INT Lisp_Word; | |||
| 330 | without worrying about the implementations diverging, since | 330 | without worrying about the implementations diverging, since |
| 331 | lisp_h_OP defines the actual implementation. The lisp_h_OP macros | 331 | lisp_h_OP defines the actual implementation. The lisp_h_OP macros |
| 332 | are intended to be private to this include file, and should not be | 332 | are intended to be private to this include file, and should not be |
| 333 | used elsewhere. | 333 | used elsewhere. They should evaluate each argument exactly once, |
| 334 | so that they behave like their functional counterparts. | ||
| 334 | 335 | ||
| 335 | FIXME: Remove the lisp_h_OP macros, and define just the inline OP | 336 | FIXME: Remove the lisp_h_OP macros, and define just the inline OP |
| 336 | functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well | 337 | functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well |
| @@ -372,39 +373,12 @@ typedef EMACS_INT Lisp_Word; | |||
| 372 | # define lisp_h_Qnil {0} | 373 | # define lisp_h_Qnil {0} |
| 373 | #endif | 374 | #endif |
| 374 | 375 | ||
| 375 | #define lisp_h_PSEUDOVECTORP(a,code) \ | ||
| 376 | (lisp_h_VECTORLIKEP (a) \ | ||
| 377 | && ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size \ | ||
| 378 | & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ | ||
| 379 | == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)))) | ||
| 380 | |||
| 381 | #define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x) | 376 | #define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x) |
| 382 | #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) | 377 | #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) |
| 383 | #define lisp_h_CHECK_TYPE(ok, predicate, x) \ | 378 | #define lisp_h_CHECK_TYPE(ok, predicate, x) \ |
| 384 | ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) | 379 | ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) |
| 385 | #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) | 380 | #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) |
| 386 | #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) | 381 | #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) |
| 387 | #define lisp_h_BASE2_EQ(x, y) \ | ||
| 388 | (BASE_EQ (x, y) \ | ||
| 389 | || (symbols_with_pos_enabled \ | ||
| 390 | && SYMBOL_WITH_POS_P (x) \ | ||
| 391 | && BASE_EQ (XSYMBOL_WITH_POS (x)->sym, y))) | ||
| 392 | |||
| 393 | /* FIXME: Do we really need to inline the whole thing? | ||
| 394 | * What about keeping the part after `symbols_with_pos_enabled` in | ||
| 395 | * a separate function? */ | ||
| 396 | #define lisp_h_EQ(x, y) \ | ||
| 397 | (XLI (x) == XLI (y) \ | ||
| 398 | || (symbols_with_pos_enabled \ | ||
| 399 | && (SYMBOL_WITH_POS_P (x) \ | ||
| 400 | ? (BARE_SYMBOL_P (y) \ | ||
| 401 | ? XLI (XSYMBOL_WITH_POS (x)->sym) == XLI (y) \ | ||
| 402 | : (SYMBOL_WITH_POS_P (y) \ | ||
| 403 | && (XLI (XSYMBOL_WITH_POS (x)->sym) \ | ||
| 404 | == XLI (XSYMBOL_WITH_POS (y)->sym)))) \ | ||
| 405 | : (SYMBOL_WITH_POS_P (y) \ | ||
| 406 | && BARE_SYMBOL_P (x) \ | ||
| 407 | && (XLI (x) == XLI (XSYMBOL_WITH_POS (y)->sym)))))) | ||
| 408 | 382 | ||
| 409 | #define lisp_h_FIXNUMP(x) \ | 383 | #define lisp_h_FIXNUMP(x) \ |
| 410 | (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ | 384 | (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ |
| @@ -412,18 +386,11 @@ typedef EMACS_INT Lisp_Word; | |||
| 412 | & ((1 << INTTYPEBITS) - 1))) | 386 | & ((1 << INTTYPEBITS) - 1))) |
| 413 | #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) | 387 | #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) |
| 414 | #define lisp_h_NILP(x) BASE_EQ (x, Qnil) | 388 | #define lisp_h_NILP(x) BASE_EQ (x, Qnil) |
| 415 | #define lisp_h_SET_SYMBOL_VAL(sym, v) \ | ||
| 416 | (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ | ||
| 417 | (sym)->u.s.val.value = (v)) | ||
| 418 | #define lisp_h_SYMBOL_CONSTANT_P(sym) \ | 389 | #define lisp_h_SYMBOL_CONSTANT_P(sym) \ |
| 419 | (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE) | 390 | (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE) |
| 420 | #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) | 391 | #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) |
| 421 | #define lisp_h_SYMBOL_VAL(sym) \ | ||
| 422 | (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) | ||
| 423 | #define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP (x, PVEC_SYMBOL_WITH_POS) | 392 | #define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP (x, PVEC_SYMBOL_WITH_POS) |
| 424 | #define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol) | 393 | #define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol) |
| 425 | #define lisp_h_SYMBOLP(x) \ | ||
| 426 | (BARE_SYMBOL_P (x) || (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x))) | ||
| 427 | #define lisp_h_TAGGEDP(a, tag) \ | 394 | #define lisp_h_TAGGEDP(a, tag) \ |
| 428 | (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ | 395 | (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ |
| 429 | - (unsigned) (tag)) \ | 396 | - (unsigned) (tag)) \ |
| @@ -431,8 +398,6 @@ typedef EMACS_INT Lisp_Word; | |||
| 431 | #define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike) | 398 | #define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike) |
| 432 | #define lisp_h_XCAR(c) XCONS (c)->u.s.car | 399 | #define lisp_h_XCAR(c) XCONS (c)->u.s.car |
| 433 | #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr | 400 | #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr |
| 434 | #define lisp_h_XCONS(a) \ | ||
| 435 | (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons)) | ||
| 436 | #define lisp_h_XHASH(a) XUFIXNUM_RAW (a) | 401 | #define lisp_h_XHASH(a) XUFIXNUM_RAW (a) |
| 437 | #if USE_LSB_TAG | 402 | #if USE_LSB_TAG |
| 438 | # define lisp_h_make_fixnum_wrap(n) \ | 403 | # define lisp_h_make_fixnum_wrap(n) \ |
| @@ -474,20 +439,15 @@ typedef EMACS_INT Lisp_Word; | |||
| 474 | # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) | 439 | # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) |
| 475 | # define CONSP(x) lisp_h_CONSP (x) | 440 | # define CONSP(x) lisp_h_CONSP (x) |
| 476 | # define BASE_EQ(x, y) lisp_h_BASE_EQ (x, y) | 441 | # define BASE_EQ(x, y) lisp_h_BASE_EQ (x, y) |
| 477 | # define BASE2_EQ(x, y) lisp_h_BASE2_EQ (x, y) | ||
| 478 | # define FLOATP(x) lisp_h_FLOATP (x) | 442 | # define FLOATP(x) lisp_h_FLOATP (x) |
| 479 | # define FIXNUMP(x) lisp_h_FIXNUMP (x) | 443 | # define FIXNUMP(x) lisp_h_FIXNUMP (x) |
| 480 | # define NILP(x) lisp_h_NILP (x) | 444 | # define NILP(x) lisp_h_NILP (x) |
| 481 | # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) | ||
| 482 | # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) | 445 | # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) |
| 483 | # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) | 446 | # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) |
| 484 | # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) | ||
| 485 | /* # define SYMBOLP(x) lisp_h_SYMBOLP (x) */ /* X is accessed more than once. */ | ||
| 486 | # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) | 447 | # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) |
| 487 | # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) | 448 | # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) |
| 488 | # define XCAR(c) lisp_h_XCAR (c) | 449 | # define XCAR(c) lisp_h_XCAR (c) |
| 489 | # define XCDR(c) lisp_h_XCDR (c) | 450 | # define XCDR(c) lisp_h_XCDR (c) |
| 490 | # define XCONS(a) lisp_h_XCONS (a) | ||
| 491 | # define XHASH(a) lisp_h_XHASH (a) | 451 | # define XHASH(a) lisp_h_XHASH (a) |
| 492 | # if USE_LSB_TAG | 452 | # if USE_LSB_TAG |
| 493 | # define make_fixnum(n) lisp_h_make_fixnum (n) | 453 | # define make_fixnum(n) lisp_h_make_fixnum (n) |
| @@ -518,6 +478,16 @@ typedef EMACS_INT Lisp_Word; | |||
| 518 | #endif | 478 | #endif |
| 519 | 479 | ||
| 520 | 480 | ||
| 481 | /* Lisp_Object tagging scheme: | ||
| 482 | Tag location | ||
| 483 | Upper bits Lower bits Type Payload | ||
| 484 | 000....... .......000 symbol offset from lispsym to struct Lisp_Symbol | ||
| 485 | 001....... .......001 unused | ||
| 486 | 01........ ........10 fixnum signed integer of FIXNUM_BITS | ||
| 487 | 110....... .......011 cons pointer to struct Lisp_Cons | ||
| 488 | 100....... .......100 string pointer to struct Lisp_String | ||
| 489 | 101....... .......101 vectorlike pointer to union vectorlike_header | ||
| 490 | 111....... .......111 float pointer to struct Lisp_Float */ | ||
| 521 | enum Lisp_Type | 491 | enum Lisp_Type |
| 522 | { | 492 | { |
| 523 | /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ | 493 | /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ |
| @@ -1062,6 +1032,7 @@ enum pvec_type | |||
| 1062 | PVEC_BOOL_VECTOR, | 1032 | PVEC_BOOL_VECTOR, |
| 1063 | PVEC_BUFFER, | 1033 | PVEC_BUFFER, |
| 1064 | PVEC_HASH_TABLE, | 1034 | PVEC_HASH_TABLE, |
| 1035 | PVEC_OBARRAY, | ||
| 1065 | PVEC_TERMINAL, | 1036 | PVEC_TERMINAL, |
| 1066 | PVEC_WINDOW_CONFIGURATION, | 1037 | PVEC_WINDOW_CONFIGURATION, |
| 1067 | PVEC_SUBR, | 1038 | PVEC_SUBR, |
| @@ -1121,7 +1092,10 @@ enum More_Lisp_Bits | |||
| 1121 | INLINE bool | 1092 | INLINE bool |
| 1122 | PSEUDOVECTORP (Lisp_Object a, int code) | 1093 | PSEUDOVECTORP (Lisp_Object a, int code) |
| 1123 | { | 1094 | { |
| 1124 | return lisp_h_PSEUDOVECTORP (a, code); | 1095 | return (lisp_h_VECTORLIKEP (a) |
| 1096 | && ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size | ||
| 1097 | & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) | ||
| 1098 | == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)))); | ||
| 1125 | } | 1099 | } |
| 1126 | 1100 | ||
| 1127 | INLINE bool | 1101 | INLINE bool |
| @@ -1137,9 +1111,10 @@ INLINE bool | |||
| 1137 | } | 1111 | } |
| 1138 | 1112 | ||
| 1139 | INLINE bool | 1113 | INLINE bool |
| 1140 | (SYMBOLP) (Lisp_Object x) | 1114 | SYMBOLP (Lisp_Object x) |
| 1141 | { | 1115 | { |
| 1142 | return lisp_h_SYMBOLP (x); | 1116 | return (BARE_SYMBOL_P (x) |
| 1117 | || (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x))); | ||
| 1143 | } | 1118 | } |
| 1144 | 1119 | ||
| 1145 | INLINE struct Lisp_Symbol_With_Pos * | 1120 | INLINE struct Lisp_Symbol_With_Pos * |
| @@ -1149,6 +1124,27 @@ XSYMBOL_WITH_POS (Lisp_Object a) | |||
| 1149 | return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); | 1124 | return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); |
| 1150 | } | 1125 | } |
| 1151 | 1126 | ||
| 1127 | INLINE Lisp_Object | ||
| 1128 | XSYMBOL_WITH_POS_SYM (Lisp_Object a) | ||
| 1129 | { | ||
| 1130 | Lisp_Object sym = XSYMBOL_WITH_POS (a)->sym; | ||
| 1131 | eassume (BARE_SYMBOL_P (sym)); | ||
| 1132 | return sym; | ||
| 1133 | } | ||
| 1134 | |||
| 1135 | INLINE Lisp_Object | ||
| 1136 | XSYMBOL_WITH_POS_POS (Lisp_Object a) | ||
| 1137 | { | ||
| 1138 | return XSYMBOL_WITH_POS (a)->pos; | ||
| 1139 | } | ||
| 1140 | |||
| 1141 | INLINE Lisp_Object | ||
| 1142 | maybe_remove_pos_from_symbol (Lisp_Object x) | ||
| 1143 | { | ||
| 1144 | return (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) | ||
| 1145 | ? XSYMBOL_WITH_POS_SYM (x) : x); | ||
| 1146 | } | ||
| 1147 | |||
| 1152 | INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED | 1148 | INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED |
| 1153 | XBARE_SYMBOL (Lisp_Object a) | 1149 | XBARE_SYMBOL (Lisp_Object a) |
| 1154 | { | 1150 | { |
| @@ -1163,8 +1159,8 @@ XSYMBOL (Lisp_Object a) | |||
| 1163 | { | 1159 | { |
| 1164 | if (!BARE_SYMBOL_P (a)) | 1160 | if (!BARE_SYMBOL_P (a)) |
| 1165 | { | 1161 | { |
| 1166 | eassert (symbols_with_pos_enabled); | 1162 | eassume (symbols_with_pos_enabled); |
| 1167 | a = XSYMBOL_WITH_POS (a)->sym; | 1163 | a = XSYMBOL_WITH_POS_SYM (a); |
| 1168 | } | 1164 | } |
| 1169 | return XBARE_SYMBOL (a); | 1165 | return XBARE_SYMBOL (a); |
| 1170 | } | 1166 | } |
| @@ -1352,20 +1348,15 @@ INLINE bool | |||
| 1352 | return lisp_h_BASE_EQ (x, y); | 1348 | return lisp_h_BASE_EQ (x, y); |
| 1353 | } | 1349 | } |
| 1354 | 1350 | ||
| 1355 | /* Return true if X and Y are the same object, reckoning X to be the | ||
| 1356 | same as a bare symbol Y if X is Y with position. */ | ||
| 1357 | INLINE bool | ||
| 1358 | (BASE2_EQ) (Lisp_Object x, Lisp_Object y) | ||
| 1359 | { | ||
| 1360 | return lisp_h_BASE2_EQ (x, y); | ||
| 1361 | } | ||
| 1362 | |||
| 1363 | /* Return true if X and Y are the same object, reckoning a symbol with | 1351 | /* Return true if X and Y are the same object, reckoning a symbol with |
| 1364 | position as being the same as the bare symbol. */ | 1352 | position as being the same as the bare symbol. */ |
| 1365 | INLINE bool | 1353 | INLINE bool |
| 1366 | (EQ) (Lisp_Object x, Lisp_Object y) | 1354 | EQ (Lisp_Object x, Lisp_Object y) |
| 1367 | { | 1355 | { |
| 1368 | return lisp_h_EQ (x, y); | 1356 | return BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) |
| 1357 | ? XSYMBOL_WITH_POS_SYM (x) : x), | ||
| 1358 | (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) | ||
| 1359 | ? XSYMBOL_WITH_POS_SYM (y) : y)); | ||
| 1369 | } | 1360 | } |
| 1370 | 1361 | ||
| 1371 | INLINE intmax_t | 1362 | INLINE intmax_t |
| @@ -1389,7 +1380,6 @@ make_lisp_ptr (void *ptr, enum Lisp_Type type) | |||
| 1389 | #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) | 1380 | #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) |
| 1390 | #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) | 1381 | #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) |
| 1391 | #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) | 1382 | #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) |
| 1392 | #define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) | ||
| 1393 | #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) | 1383 | #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) |
| 1394 | 1384 | ||
| 1395 | /* Return a Lisp_Object value that does not correspond to any object. | 1385 | /* Return a Lisp_Object value that does not correspond to any object. |
| @@ -1510,9 +1500,10 @@ CHECK_CONS (Lisp_Object x) | |||
| 1510 | } | 1500 | } |
| 1511 | 1501 | ||
| 1512 | INLINE struct Lisp_Cons * | 1502 | INLINE struct Lisp_Cons * |
| 1513 | (XCONS) (Lisp_Object a) | 1503 | XCONS (Lisp_Object a) |
| 1514 | { | 1504 | { |
| 1515 | return lisp_h_XCONS (a); | 1505 | eassert (CONSP (a)); |
| 1506 | return XUNTAG (a, Lisp_Cons, struct Lisp_Cons); | ||
| 1516 | } | 1507 | } |
| 1517 | 1508 | ||
| 1518 | /* Take the car or cdr of something known to be a cons cell. */ | 1509 | /* Take the car or cdr of something known to be a cons cell. */ |
| @@ -2297,9 +2288,10 @@ typedef jmp_buf sys_jmp_buf; | |||
| 2297 | /* Value is name of symbol. */ | 2288 | /* Value is name of symbol. */ |
| 2298 | 2289 | ||
| 2299 | INLINE Lisp_Object | 2290 | INLINE Lisp_Object |
| 2300 | (SYMBOL_VAL) (struct Lisp_Symbol *sym) | 2291 | SYMBOL_VAL (struct Lisp_Symbol *sym) |
| 2301 | { | 2292 | { |
| 2302 | return lisp_h_SYMBOL_VAL (sym); | 2293 | eassert (sym->u.s.redirect == SYMBOL_PLAINVAL); |
| 2294 | return sym->u.s.val.value; | ||
| 2303 | } | 2295 | } |
| 2304 | 2296 | ||
| 2305 | INLINE struct Lisp_Symbol * | 2297 | INLINE struct Lisp_Symbol * |
| @@ -2322,9 +2314,10 @@ SYMBOL_FWD (struct Lisp_Symbol *sym) | |||
| 2322 | } | 2314 | } |
| 2323 | 2315 | ||
| 2324 | INLINE void | 2316 | INLINE void |
| 2325 | (SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v) | 2317 | SET_SYMBOL_VAL (struct Lisp_Symbol *sym, Lisp_Object v) |
| 2326 | { | 2318 | { |
| 2327 | lisp_h_SET_SYMBOL_VAL (sym, v); | 2319 | eassert (sym->u.s.redirect == SYMBOL_PLAINVAL); |
| 2320 | sym->u.s.val.value = v; | ||
| 2328 | } | 2321 | } |
| 2329 | 2322 | ||
| 2330 | INLINE void | 2323 | INLINE void |
| @@ -2393,6 +2386,118 @@ INLINE int | |||
| 2393 | definition is done by lread.c's define_symbol. */ | 2386 | definition is done by lread.c's define_symbol. */ |
| 2394 | #define DEFSYM(sym, name) /* empty */ | 2387 | #define DEFSYM(sym, name) /* empty */ |
| 2395 | 2388 | ||
| 2389 | |||
| 2390 | struct Lisp_Obarray | ||
| 2391 | { | ||
| 2392 | union vectorlike_header header; | ||
| 2393 | |||
| 2394 | /* Array of 2**size_bits values, each being either a (bare) symbol or | ||
| 2395 | the fixnum 0. The symbols for each bucket are chained via | ||
| 2396 | their s.next field. */ | ||
| 2397 | Lisp_Object *buckets; | ||
| 2398 | |||
| 2399 | unsigned size_bits; /* log2(size of buckets vector) */ | ||
| 2400 | unsigned count; /* number of symbols in obarray */ | ||
| 2401 | }; | ||
| 2402 | |||
| 2403 | INLINE bool | ||
| 2404 | OBARRAYP (Lisp_Object a) | ||
| 2405 | { | ||
| 2406 | return PSEUDOVECTORP (a, PVEC_OBARRAY); | ||
| 2407 | } | ||
| 2408 | |||
| 2409 | INLINE struct Lisp_Obarray * | ||
| 2410 | XOBARRAY (Lisp_Object a) | ||
| 2411 | { | ||
| 2412 | eassert (OBARRAYP (a)); | ||
| 2413 | return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Obarray); | ||
| 2414 | } | ||
| 2415 | |||
| 2416 | INLINE void | ||
| 2417 | CHECK_OBARRAY (Lisp_Object x) | ||
| 2418 | { | ||
| 2419 | CHECK_TYPE (OBARRAYP (x), Qobarrayp, x); | ||
| 2420 | } | ||
| 2421 | |||
| 2422 | INLINE Lisp_Object | ||
| 2423 | make_lisp_obarray (struct Lisp_Obarray *o) | ||
| 2424 | { | ||
| 2425 | eassert (PSEUDOVECTOR_TYPEP (&o->header, PVEC_OBARRAY)); | ||
| 2426 | return make_lisp_ptr (o, Lisp_Vectorlike); | ||
| 2427 | } | ||
| 2428 | |||
| 2429 | INLINE ptrdiff_t | ||
| 2430 | obarray_size (const struct Lisp_Obarray *o) | ||
| 2431 | { | ||
| 2432 | return (ptrdiff_t)1 << o->size_bits; | ||
| 2433 | } | ||
| 2434 | |||
| 2435 | Lisp_Object check_obarray_slow (Lisp_Object); | ||
| 2436 | |||
| 2437 | /* Return an obarray object from OBARRAY or signal an error. */ | ||
| 2438 | INLINE Lisp_Object | ||
| 2439 | check_obarray (Lisp_Object obarray) | ||
| 2440 | { | ||
| 2441 | return OBARRAYP (obarray) ? obarray : check_obarray_slow (obarray); | ||
| 2442 | } | ||
| 2443 | |||
| 2444 | /* Obarray iterator state. Don't access these members directly. | ||
| 2445 | The iterator functions must be called in the order followed by DOOBARRAY. */ | ||
| 2446 | typedef struct { | ||
| 2447 | struct Lisp_Obarray *o; | ||
| 2448 | ptrdiff_t idx; /* Current bucket index. */ | ||
| 2449 | struct Lisp_Symbol *symbol; /* Current symbol, or NULL if at end | ||
| 2450 | of current bucket. */ | ||
| 2451 | } obarray_iter_t; | ||
| 2452 | |||
| 2453 | INLINE obarray_iter_t | ||
| 2454 | make_obarray_iter (struct Lisp_Obarray *oa) | ||
| 2455 | { | ||
| 2456 | return (obarray_iter_t){.o = oa, .idx = -1, .symbol = NULL}; | ||
| 2457 | } | ||
| 2458 | |||
| 2459 | /* Whether IT has reached the end and there are no more symbols. | ||
| 2460 | If true, IT is dead and cannot be used any more. */ | ||
| 2461 | INLINE bool | ||
| 2462 | obarray_iter_at_end (obarray_iter_t *it) | ||
| 2463 | { | ||
| 2464 | if (it->symbol) | ||
| 2465 | return false; | ||
| 2466 | ptrdiff_t size = obarray_size (it->o); | ||
| 2467 | while (++it->idx < size) | ||
| 2468 | { | ||
| 2469 | Lisp_Object obj = it->o->buckets[it->idx]; | ||
| 2470 | if (!BASE_EQ (obj, make_fixnum (0))) | ||
| 2471 | { | ||
| 2472 | it->symbol = XBARE_SYMBOL (obj); | ||
| 2473 | return false; | ||
| 2474 | } | ||
| 2475 | } | ||
| 2476 | return true; | ||
| 2477 | } | ||
| 2478 | |||
| 2479 | /* Advance IT to the next symbol if any. */ | ||
| 2480 | INLINE void | ||
| 2481 | obarray_iter_step (obarray_iter_t *it) | ||
| 2482 | { | ||
| 2483 | it->symbol = it->symbol->u.s.next; | ||
| 2484 | } | ||
| 2485 | |||
| 2486 | /* The Lisp symbol at IT, if obarray_iter_at_end returned false. */ | ||
| 2487 | INLINE Lisp_Object | ||
| 2488 | obarray_iter_symbol (obarray_iter_t *it) | ||
| 2489 | { | ||
| 2490 | return make_lisp_symbol (it->symbol); | ||
| 2491 | } | ||
| 2492 | |||
| 2493 | /* Iterate IT over the symbols of the obarray OA. | ||
| 2494 | The body shouldn't add or remove symbols in OA, but disobeying that rule | ||
| 2495 | only risks symbols to be iterated more than once or not at all, | ||
| 2496 | not crashes or data corruption. */ | ||
| 2497 | #define DOOBARRAY(oa, it) \ | ||
| 2498 | for (obarray_iter_t it = make_obarray_iter (oa); \ | ||
| 2499 | !obarray_iter_at_end (&it); obarray_iter_step (&it)) | ||
| 2500 | |||
| 2396 | 2501 | ||
| 2397 | /*********************************************************************** | 2502 | /*********************************************************************** |
| 2398 | Hash Tables | 2503 | Hash Tables |
| @@ -2475,14 +2580,11 @@ struct Lisp_Hash_Table | |||
| 2475 | The table is physically split into three vectors (hash, next, | 2580 | The table is physically split into three vectors (hash, next, |
| 2476 | key_and_value) which may or may not be beneficial. */ | 2581 | key_and_value) which may or may not be beneficial. */ |
| 2477 | 2582 | ||
| 2478 | hash_idx_t index_size; /* Size of the index vector. */ | ||
| 2479 | hash_idx_t table_size; /* Size of the next and hash vectors. */ | ||
| 2480 | |||
| 2481 | /* Bucket vector. An entry of -1 indicates no item is present, | 2583 | /* Bucket vector. An entry of -1 indicates no item is present, |
| 2482 | and a nonnegative entry is the index of the first item in | 2584 | and a nonnegative entry is the index of the first item in |
| 2483 | a collision chain. | 2585 | a collision chain. |
| 2484 | This vector is index_size entries long. | 2586 | This vector is 2**index_bits entries long. |
| 2485 | If index_size is 1 (and table_size is 0), then this is the | 2587 | If index_bits is 0 (and table_size is 0), then this is the |
| 2486 | constant read-only vector {-1}, shared between all instances. | 2588 | constant read-only vector {-1}, shared between all instances. |
| 2487 | Otherwise it is heap-allocated. */ | 2589 | Otherwise it is heap-allocated. */ |
| 2488 | hash_idx_t *index; | 2590 | hash_idx_t *index; |
| @@ -2514,20 +2616,24 @@ struct Lisp_Hash_Table | |||
| 2514 | /* Index of first free entry in free list, or -1 if none. */ | 2616 | /* Index of first free entry in free list, or -1 if none. */ |
| 2515 | hash_idx_t next_free; | 2617 | hash_idx_t next_free; |
| 2516 | 2618 | ||
| 2619 | hash_idx_t table_size; /* Size of the next and hash vectors. */ | ||
| 2620 | |||
| 2621 | unsigned char index_bits; /* log2 (size of the index vector). */ | ||
| 2622 | |||
| 2517 | /* Weakness of the table. */ | 2623 | /* Weakness of the table. */ |
| 2518 | hash_table_weakness_t weakness : 8; | 2624 | hash_table_weakness_t weakness : 3; |
| 2519 | 2625 | ||
| 2520 | /* Hash table test (only used when frozen in dump) */ | 2626 | /* Hash table test (only used when frozen in dump) */ |
| 2521 | hash_table_std_test_t frozen_test : 8; | 2627 | hash_table_std_test_t frozen_test : 2; |
| 2522 | 2628 | ||
| 2523 | /* True if the table can be purecopied. The table cannot be | 2629 | /* True if the table can be purecopied. The table cannot be |
| 2524 | changed afterwards. */ | 2630 | changed afterwards. */ |
| 2525 | bool purecopy; | 2631 | bool_bf purecopy : 1; |
| 2526 | 2632 | ||
| 2527 | /* True if the table is mutable. Ordinarily tables are mutable, but | 2633 | /* True if the table is mutable. Ordinarily tables are mutable, but |
| 2528 | pure tables are not, and while a table is being mutated it is | 2634 | pure tables are not, and while a table is being mutated it is |
| 2529 | immutable for recursive attempts to mutate it. */ | 2635 | immutable for recursive attempts to mutate it. */ |
| 2530 | bool mutable; | 2636 | bool_bf mutable : 1; |
| 2531 | 2637 | ||
| 2532 | /* Next weak hash table if this is a weak hash table. The head of | 2638 | /* Next weak hash table if this is a weak hash table. The head of |
| 2533 | the list is in weak_hash_tables. Used only during garbage | 2639 | the list is in weak_hash_tables. Used only during garbage |
| @@ -2563,8 +2669,12 @@ XHASH_TABLE (Lisp_Object a) | |||
| 2563 | return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Hash_Table); | 2669 | return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Hash_Table); |
| 2564 | } | 2670 | } |
| 2565 | 2671 | ||
| 2566 | #define XSET_HASH_TABLE(VAR, PTR) \ | 2672 | INLINE Lisp_Object |
| 2567 | XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE) | 2673 | make_lisp_hash_table (struct Lisp_Hash_Table *h) |
| 2674 | { | ||
| 2675 | eassert (PSEUDOVECTOR_TYPEP (&h->header, PVEC_HASH_TABLE)); | ||
| 2676 | return make_lisp_ptr (h, Lisp_Vectorlike); | ||
| 2677 | } | ||
| 2568 | 2678 | ||
| 2569 | /* Value is the key part of entry IDX in hash table H. */ | 2679 | /* Value is the key part of entry IDX in hash table H. */ |
| 2570 | INLINE Lisp_Object | 2680 | INLINE Lisp_Object |
| @@ -2597,6 +2707,13 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) | |||
| 2597 | return h->table_size; | 2707 | return h->table_size; |
| 2598 | } | 2708 | } |
| 2599 | 2709 | ||
| 2710 | /* Size of the index vector in hash table H. */ | ||
| 2711 | INLINE ptrdiff_t | ||
| 2712 | hash_table_index_size (const struct Lisp_Hash_Table *h) | ||
| 2713 | { | ||
| 2714 | return (ptrdiff_t)1 << h->index_bits; | ||
| 2715 | } | ||
| 2716 | |||
| 2600 | /* Hash value for KEY in hash table H. */ | 2717 | /* Hash value for KEY in hash table H. */ |
| 2601 | INLINE hash_hash_t | 2718 | INLINE hash_hash_t |
| 2602 | hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) | 2719 | hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) |
| @@ -2661,6 +2778,28 @@ SXHASH_REDUCE (EMACS_UINT x) | |||
| 2661 | return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK; | 2778 | return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK; |
| 2662 | } | 2779 | } |
| 2663 | 2780 | ||
| 2781 | /* Reduce an EMACS_UINT hash value to hash_hash_t. */ | ||
| 2782 | INLINE hash_hash_t | ||
| 2783 | reduce_emacs_uint_to_hash_hash (EMACS_UINT x) | ||
| 2784 | { | ||
| 2785 | verify (sizeof x <= 2 * sizeof (hash_hash_t)); | ||
| 2786 | return (sizeof x == sizeof (hash_hash_t) | ||
| 2787 | ? x | ||
| 2788 | : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); | ||
| 2789 | } | ||
| 2790 | |||
| 2791 | /* Reduce HASH to a value BITS wide. */ | ||
| 2792 | INLINE ptrdiff_t | ||
| 2793 | knuth_hash (hash_hash_t hash, unsigned bits) | ||
| 2794 | { | ||
| 2795 | /* Knuth multiplicative hashing, tailored for 32-bit indices | ||
| 2796 | (avoiding a 64-bit multiply). */ | ||
| 2797 | uint32_t alpha = 2654435769; /* 2**32/phi */ | ||
| 2798 | /* Note the cast to uint64_t, to make it work for bits=0. */ | ||
| 2799 | return (uint64_t)((uint32_t)hash * alpha) >> (32 - bits); | ||
| 2800 | } | ||
| 2801 | |||
| 2802 | |||
| 2664 | struct Lisp_Marker | 2803 | struct Lisp_Marker |
| 2665 | { | 2804 | { |
| 2666 | union vectorlike_header header; | 2805 | union vectorlike_header header; |
| @@ -2839,22 +2978,6 @@ XOVERLAY (Lisp_Object a) | |||
| 2839 | return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); | 2978 | return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); |
| 2840 | } | 2979 | } |
| 2841 | 2980 | ||
| 2842 | INLINE Lisp_Object | ||
| 2843 | SYMBOL_WITH_POS_SYM (Lisp_Object a) | ||
| 2844 | { | ||
| 2845 | if (!SYMBOL_WITH_POS_P (a)) | ||
| 2846 | wrong_type_argument (Qsymbol_with_pos_p, a); | ||
| 2847 | return XSYMBOL_WITH_POS (a)->sym; | ||
| 2848 | } | ||
| 2849 | |||
| 2850 | INLINE Lisp_Object | ||
| 2851 | SYMBOL_WITH_POS_POS (Lisp_Object a) | ||
| 2852 | { | ||
| 2853 | if (!SYMBOL_WITH_POS_P (a)) | ||
| 2854 | wrong_type_argument (Qsymbol_with_pos_p, a); | ||
| 2855 | return XSYMBOL_WITH_POS (a)->pos; | ||
| 2856 | } | ||
| 2857 | |||
| 2858 | INLINE bool | 2981 | INLINE bool |
| 2859 | USER_PTRP (Lisp_Object x) | 2982 | USER_PTRP (Lisp_Object x) |
| 2860 | { | 2983 | { |
| @@ -4596,7 +4719,6 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char *, ptrdiff_t, | |||
| 4596 | ATTRIBUTE_FORMAT_PRINTF (5, 0); | 4719 | ATTRIBUTE_FORMAT_PRINTF (5, 0); |
| 4597 | 4720 | ||
| 4598 | /* Defined in lread.c. */ | 4721 | /* Defined in lread.c. */ |
| 4599 | extern Lisp_Object check_obarray (Lisp_Object); | ||
| 4600 | extern Lisp_Object intern_1 (const char *, ptrdiff_t); | 4722 | extern Lisp_Object intern_1 (const char *, ptrdiff_t); |
| 4601 | extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); | 4723 | extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); |
| 4602 | extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object); | 4724 | extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object); |
| @@ -4802,7 +4924,7 @@ extern void syms_of_editfns (void); | |||
| 4802 | 4924 | ||
| 4803 | /* Defined in buffer.c. */ | 4925 | /* Defined in buffer.c. */ |
| 4804 | extern bool mouse_face_overlay_overlaps (Lisp_Object); | 4926 | extern bool mouse_face_overlay_overlaps (Lisp_Object); |
| 4805 | extern Lisp_Object disable_line_numbers_overlay_at_eob (void); | 4927 | extern bool disable_line_numbers_overlay_at_eob (void); |
| 4806 | extern AVOID nsberror (Lisp_Object); | 4928 | extern AVOID nsberror (Lisp_Object); |
| 4807 | extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t, bool); | 4929 | extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t, bool); |
| 4808 | extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t); | 4930 | extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t); |
| @@ -5030,6 +5152,7 @@ extern bool build_details; | |||
| 5030 | /* 0 not a daemon, 1 foreground daemon, 2 background daemon. */ | 5152 | /* 0 not a daemon, 1 foreground daemon, 2 background daemon. */ |
| 5031 | extern int daemon_type; | 5153 | extern int daemon_type; |
| 5032 | #define IS_DAEMON (daemon_type != 0) | 5154 | #define IS_DAEMON (daemon_type != 0) |
| 5155 | /* Non-zero means daemon-initialized has not yet been called. */ | ||
| 5033 | #define DAEMON_RUNNING (daemon_type >= 0) | 5156 | #define DAEMON_RUNNING (daemon_type >= 0) |
| 5034 | #else /* WINDOWSNT */ | 5157 | #else /* WINDOWSNT */ |
| 5035 | extern void *w32_daemon_event; | 5158 | extern void *w32_daemon_event; |
| @@ -5550,7 +5673,7 @@ safe_free_unbind_to (specpdl_ref count, specpdl_ref sa_count, Lisp_Object val) | |||
| 5550 | https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109577 | 5673 | https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109577 |
| 5551 | which causes GCC to mistakenly complain about the | 5674 | which causes GCC to mistakenly complain about the |
| 5552 | memory allocation in SAFE_ALLOCA_LISP_EXTRA. */ | 5675 | memory allocation in SAFE_ALLOCA_LISP_EXTRA. */ |
| 5553 | #if GNUC_PREREQ (13, 0, 0) | 5676 | #if GNUC_PREREQ (13, 0, 0) && !GNUC_PREREQ (14, 0, 0) |
| 5554 | # pragma GCC diagnostic ignored "-Wanalyzer-allocation-size" | 5677 | # pragma GCC diagnostic ignored "-Wanalyzer-allocation-size" |
| 5555 | #endif | 5678 | #endif |
| 5556 | 5679 | ||
diff --git a/src/lread.c b/src/lread.c index 929f86ef283..49683d02401 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -2369,8 +2369,14 @@ build_load_history (Lisp_Object filename, bool entire) | |||
| 2369 | front of load-history, the most-recently-loaded position. Also | 2369 | front of load-history, the most-recently-loaded position. Also |
| 2370 | do this if we didn't find an existing member for the file. */ | 2370 | do this if we didn't find an existing member for the file. */ |
| 2371 | if (entire || !foundit) | 2371 | if (entire || !foundit) |
| 2372 | Vload_history = Fcons (Fnreverse (Vcurrent_load_list), | 2372 | { |
| 2373 | Vload_history); | 2373 | Lisp_Object tem = Fnreverse (Vcurrent_load_list); |
| 2374 | eassert (EQ (filename, Fcar (tem))); | ||
| 2375 | Vload_history = Fcons (tem, Vload_history); | ||
| 2376 | /* FIXME: There should be an unbind_to right after calling us which | ||
| 2377 | should re-establish the previous value of Vcurrent_load_list. */ | ||
| 2378 | Vcurrent_load_list = Qt; | ||
| 2379 | } | ||
| 2374 | } | 2380 | } |
| 2375 | 2381 | ||
| 2376 | static void | 2382 | static void |
| @@ -2437,11 +2443,13 @@ readevalloop (Lisp_Object readcharfun, | |||
| 2437 | bool whole_buffer = 0; | 2443 | bool whole_buffer = 0; |
| 2438 | /* True on the first time around. */ | 2444 | /* True on the first time around. */ |
| 2439 | bool first_sexp = 1; | 2445 | bool first_sexp = 1; |
| 2440 | Lisp_Object macroexpand = intern ("internal-macroexpand-for-load"); | 2446 | Lisp_Object macroexpand; |
| 2441 | 2447 | ||
| 2442 | if (!NILP (sourcename)) | 2448 | if (!NILP (sourcename)) |
| 2443 | CHECK_STRING (sourcename); | 2449 | CHECK_STRING (sourcename); |
| 2444 | 2450 | ||
| 2451 | macroexpand = Qinternal_macroexpand_for_load; | ||
| 2452 | |||
| 2445 | if (NILP (Ffboundp (macroexpand)) | 2453 | if (NILP (Ffboundp (macroexpand)) |
| 2446 | || (STRINGP (sourcename) && suffix_p (sourcename, ".elc"))) | 2454 | || (STRINGP (sourcename) && suffix_p (sourcename, ".elc"))) |
| 2447 | /* Don't macroexpand before the corresponding function is defined | 2455 | /* Don't macroexpand before the corresponding function is defined |
| @@ -3481,6 +3489,8 @@ vector_from_rev_list (Lisp_Object elems) | |||
| 3481 | return obj; | 3489 | return obj; |
| 3482 | } | 3490 | } |
| 3483 | 3491 | ||
| 3492 | static Lisp_Object get_lazy_string (Lisp_Object val); | ||
| 3493 | |||
| 3484 | static Lisp_Object | 3494 | static Lisp_Object |
| 3485 | bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) | 3495 | bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) |
| 3486 | { | 3496 | { |
| @@ -3488,49 +3498,50 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) | |||
| 3488 | Lisp_Object *vec = XVECTOR (obj)->contents; | 3498 | Lisp_Object *vec = XVECTOR (obj)->contents; |
| 3489 | ptrdiff_t size = ASIZE (obj); | 3499 | ptrdiff_t size = ASIZE (obj); |
| 3490 | 3500 | ||
| 3501 | if (infile && size >= COMPILED_CONSTANTS) | ||
| 3502 | { | ||
| 3503 | /* Always read 'lazily-loaded' bytecode (generated by the | ||
| 3504 | `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to | ||
| 3505 | avoid code in the fast path during execution. */ | ||
| 3506 | if (CONSP (vec[COMPILED_BYTECODE]) | ||
| 3507 | && FIXNUMP (XCDR (vec[COMPILED_BYTECODE]))) | ||
| 3508 | vec[COMPILED_BYTECODE] = get_lazy_string (vec[COMPILED_BYTECODE]); | ||
| 3509 | |||
| 3510 | /* Lazily-loaded bytecode is represented by the constant slot being nil | ||
| 3511 | and the bytecode slot a (lazily loaded) string containing the | ||
| 3512 | print representation of (BYTECODE . CONSTANTS). Unpack the | ||
| 3513 | pieces by coerceing the string to unibyte and reading the result. */ | ||
| 3514 | if (NILP (vec[COMPILED_CONSTANTS]) && STRINGP (vec[COMPILED_BYTECODE])) | ||
| 3515 | { | ||
| 3516 | Lisp_Object enc = vec[COMPILED_BYTECODE]; | ||
| 3517 | Lisp_Object pair = Fread (Fcons (enc, readcharfun)); | ||
| 3518 | if (!CONSP (pair)) | ||
| 3519 | invalid_syntax ("Invalid byte-code object", readcharfun); | ||
| 3520 | |||
| 3521 | vec[COMPILED_BYTECODE] = XCAR (pair); | ||
| 3522 | vec[COMPILED_CONSTANTS] = XCDR (pair); | ||
| 3523 | } | ||
| 3524 | } | ||
| 3525 | |||
| 3491 | if (!(size >= COMPILED_STACK_DEPTH + 1 && size <= COMPILED_INTERACTIVE + 1 | 3526 | if (!(size >= COMPILED_STACK_DEPTH + 1 && size <= COMPILED_INTERACTIVE + 1 |
| 3492 | && (FIXNUMP (vec[COMPILED_ARGLIST]) | 3527 | && (FIXNUMP (vec[COMPILED_ARGLIST]) |
| 3493 | || CONSP (vec[COMPILED_ARGLIST]) | 3528 | || CONSP (vec[COMPILED_ARGLIST]) |
| 3494 | || NILP (vec[COMPILED_ARGLIST])) | 3529 | || NILP (vec[COMPILED_ARGLIST])) |
| 3530 | && STRINGP (vec[COMPILED_BYTECODE]) | ||
| 3531 | && VECTORP (vec[COMPILED_CONSTANTS]) | ||
| 3495 | && FIXNATP (vec[COMPILED_STACK_DEPTH]))) | 3532 | && FIXNATP (vec[COMPILED_STACK_DEPTH]))) |
| 3496 | invalid_syntax ("Invalid byte-code object", readcharfun); | 3533 | invalid_syntax ("Invalid byte-code object", readcharfun); |
| 3497 | 3534 | ||
| 3498 | if (load_force_doc_strings | 3535 | if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) |
| 3499 | && NILP (vec[COMPILED_CONSTANTS]) | 3536 | /* BYTESTR must have been produced by Emacs 20.2 or earlier |
| 3500 | && STRINGP (vec[COMPILED_BYTECODE])) | 3537 | because it produced a raw 8-bit string for byte-code and |
| 3501 | { | 3538 | now such a byte-code string is loaded as multibyte with |
| 3502 | /* Lazily-loaded bytecode is represented by the constant slot being nil | 3539 | raw 8-bit characters converted to multibyte form. |
| 3503 | and the bytecode slot a (lazily loaded) string containing the | 3540 | Convert them back to the original unibyte form. */ |
| 3504 | print representation of (BYTECODE . CONSTANTS). Unpack the | 3541 | vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]); |
| 3505 | pieces by coerceing the string to unibyte and reading the result. */ | ||
| 3506 | Lisp_Object enc = vec[COMPILED_BYTECODE]; | ||
| 3507 | Lisp_Object pair = Fread (Fcons (enc, readcharfun)); | ||
| 3508 | if (!CONSP (pair)) | ||
| 3509 | invalid_syntax ("Invalid byte-code object", readcharfun); | ||
| 3510 | |||
| 3511 | vec[COMPILED_BYTECODE] = XCAR (pair); | ||
| 3512 | vec[COMPILED_CONSTANTS] = XCDR (pair); | ||
| 3513 | } | ||
| 3514 | |||
| 3515 | if (!((STRINGP (vec[COMPILED_BYTECODE]) | ||
| 3516 | && VECTORP (vec[COMPILED_CONSTANTS])) | ||
| 3517 | || CONSP (vec[COMPILED_BYTECODE]))) | ||
| 3518 | invalid_syntax ("Invalid byte-code object", readcharfun); | ||
| 3519 | 3542 | ||
| 3520 | if (STRINGP (vec[COMPILED_BYTECODE])) | 3543 | /* Bytecode must be immovable. */ |
| 3521 | { | 3544 | pin_string (vec[COMPILED_BYTECODE]); |
| 3522 | if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) | ||
| 3523 | { | ||
| 3524 | /* BYTESTR must have been produced by Emacs 20.2 or earlier | ||
| 3525 | because it produced a raw 8-bit string for byte-code and | ||
| 3526 | now such a byte-code string is loaded as multibyte with | ||
| 3527 | raw 8-bit characters converted to multibyte form. | ||
| 3528 | Convert them back to the original unibyte form. */ | ||
| 3529 | vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]); | ||
| 3530 | } | ||
| 3531 | /* Bytecode must be immovable. */ | ||
| 3532 | pin_string (vec[COMPILED_BYTECODE]); | ||
| 3533 | } | ||
| 3534 | 3545 | ||
| 3535 | XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED); | 3546 | XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED); |
| 3536 | return obj; | 3547 | return obj; |
| @@ -4469,7 +4480,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) | |||
| 4469 | &longhand_chars, | 4480 | &longhand_chars, |
| 4470 | &longhand_bytes); | 4481 | &longhand_bytes); |
| 4471 | 4482 | ||
| 4472 | if (SYMBOLP (found)) | 4483 | if (BARE_SYMBOL_P (found)) |
| 4473 | result = found; | 4484 | result = found; |
| 4474 | else if (longhand) | 4485 | else if (longhand) |
| 4475 | { | 4486 | { |
| @@ -4875,49 +4886,65 @@ static Lisp_Object initial_obarray; | |||
| 4875 | 4886 | ||
| 4876 | static size_t oblookup_last_bucket_number; | 4887 | static size_t oblookup_last_bucket_number; |
| 4877 | 4888 | ||
| 4878 | /* Get an error if OBARRAY is not an obarray. | 4889 | static Lisp_Object make_obarray (unsigned bits); |
| 4879 | If it is one, return it. */ | ||
| 4880 | 4890 | ||
| 4891 | /* Slow path obarray check: return the obarray to use or signal an error. */ | ||
| 4881 | Lisp_Object | 4892 | Lisp_Object |
| 4882 | check_obarray (Lisp_Object obarray) | 4893 | check_obarray_slow (Lisp_Object obarray) |
| 4883 | { | 4894 | { |
| 4884 | /* We don't want to signal a wrong-type-argument error when we are | 4895 | /* For compatibility, we accept vectors whose first element is 0, |
| 4885 | shutting down due to a fatal error, and we don't want to hit | 4896 | and store an obarray object there. */ |
| 4886 | assertions in VECTORP and ASIZE if the fatal error was during GC. */ | 4897 | if (VECTORP (obarray) && ASIZE (obarray) > 0) |
| 4887 | if (!fatal_error_in_progress | ||
| 4888 | && (!VECTORP (obarray) || ASIZE (obarray) == 0)) | ||
| 4889 | { | 4898 | { |
| 4890 | /* If Vobarray is now invalid, force it to be valid. */ | 4899 | Lisp_Object obj = AREF (obarray, 0); |
| 4891 | if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; | 4900 | if (OBARRAYP (obj)) |
| 4892 | wrong_type_argument (Qvectorp, obarray); | 4901 | return obj; |
| 4902 | if (BASE_EQ (obj, make_fixnum (0))) | ||
| 4903 | { | ||
| 4904 | /* Put an actual obarray object in the first slot. | ||
| 4905 | The rest of the vector remains unused. */ | ||
| 4906 | obj = make_obarray (0); | ||
| 4907 | ASET (obarray, 0, obj); | ||
| 4908 | return obj; | ||
| 4909 | } | ||
| 4893 | } | 4910 | } |
| 4894 | return obarray; | 4911 | /* Reset Vobarray to the standard obarray for nicer error handling. */ |
| 4912 | if (BASE_EQ (Vobarray, obarray)) Vobarray = initial_obarray; | ||
| 4913 | |||
| 4914 | wrong_type_argument (Qobarrayp, obarray); | ||
| 4895 | } | 4915 | } |
| 4896 | 4916 | ||
| 4917 | static void grow_obarray (struct Lisp_Obarray *o); | ||
| 4918 | |||
| 4897 | /* Intern symbol SYM in OBARRAY using bucket INDEX. */ | 4919 | /* Intern symbol SYM in OBARRAY using bucket INDEX. */ |
| 4898 | 4920 | ||
| 4921 | /* FIXME: retype arguments as pure C types */ | ||
| 4899 | static Lisp_Object | 4922 | static Lisp_Object |
| 4900 | intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) | 4923 | intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) |
| 4901 | { | 4924 | { |
| 4902 | Lisp_Object *ptr; | 4925 | eassert (BARE_SYMBOL_P (sym) && OBARRAYP (obarray) && FIXNUMP (index)); |
| 4926 | struct Lisp_Symbol *s = XBARE_SYMBOL (sym); | ||
| 4927 | s->u.s.interned = (BASE_EQ (obarray, initial_obarray) | ||
| 4928 | ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY | ||
| 4929 | : SYMBOL_INTERNED); | ||
| 4903 | 4930 | ||
| 4904 | XSYMBOL (sym)->u.s.interned = (EQ (obarray, initial_obarray) | 4931 | if (SREF (s->u.s.name, 0) == ':' && BASE_EQ (obarray, initial_obarray)) |
| 4905 | ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY | ||
| 4906 | : SYMBOL_INTERNED); | ||
| 4907 | |||
| 4908 | if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) | ||
| 4909 | { | 4932 | { |
| 4910 | make_symbol_constant (sym); | 4933 | s->u.s.trapped_write = SYMBOL_NOWRITE; |
| 4911 | XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL; | 4934 | s->u.s.redirect = SYMBOL_PLAINVAL; |
| 4912 | /* Mark keywords as special. This makes (let ((:key 'foo)) ...) | 4935 | /* Mark keywords as special. This makes (let ((:key 'foo)) ...) |
| 4913 | in lexically bound elisp signal an error, as documented. */ | 4936 | in lexically bound elisp signal an error, as documented. */ |
| 4914 | XSYMBOL (sym)->u.s.declared_special = true; | 4937 | s->u.s.declared_special = true; |
| 4915 | SET_SYMBOL_VAL (XSYMBOL (sym), sym); | 4938 | SET_SYMBOL_VAL (s, sym); |
| 4916 | } | 4939 | } |
| 4917 | 4940 | ||
| 4918 | ptr = aref_addr (obarray, XFIXNUM (index)); | 4941 | struct Lisp_Obarray *o = XOBARRAY (obarray); |
| 4919 | set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL); | 4942 | Lisp_Object *ptr = o->buckets + XFIXNUM (index); |
| 4943 | s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL; | ||
| 4920 | *ptr = sym; | 4944 | *ptr = sym; |
| 4945 | o->count++; | ||
| 4946 | if (o->count > obarray_size (o)) | ||
| 4947 | grow_obarray (o); | ||
| 4921 | return sym; | 4948 | return sym; |
| 4922 | } | 4949 | } |
| 4923 | 4950 | ||
| @@ -4926,7 +4953,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) | |||
| 4926 | Lisp_Object | 4953 | Lisp_Object |
| 4927 | intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index) | 4954 | intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index) |
| 4928 | { | 4955 | { |
| 4929 | SET_SYMBOL_VAL (XSYMBOL (Qobarray_cache), Qnil); | 4956 | SET_SYMBOL_VAL (XBARE_SYMBOL (Qobarray_cache), Qnil); |
| 4930 | return intern_sym (Fmake_symbol (string), obarray, index); | 4957 | return intern_sym (Fmake_symbol (string), obarray, index); |
| 4931 | } | 4958 | } |
| 4932 | 4959 | ||
| @@ -4939,7 +4966,7 @@ intern_1 (const char *str, ptrdiff_t len) | |||
| 4939 | Lisp_Object obarray = check_obarray (Vobarray); | 4966 | Lisp_Object obarray = check_obarray (Vobarray); |
| 4940 | Lisp_Object tem = oblookup (obarray, str, len, len); | 4967 | Lisp_Object tem = oblookup (obarray, str, len, len); |
| 4941 | 4968 | ||
| 4942 | return (SYMBOLP (tem) ? tem | 4969 | return (BARE_SYMBOL_P (tem) ? tem |
| 4943 | /* The above `oblookup' was done on the basis of nchars==nbytes, so | 4970 | /* The above `oblookup' was done on the basis of nchars==nbytes, so |
| 4944 | the string has to be unibyte. */ | 4971 | the string has to be unibyte. */ |
| 4945 | : intern_driver (make_unibyte_string (str, len), | 4972 | : intern_driver (make_unibyte_string (str, len), |
| @@ -4952,7 +4979,7 @@ intern_c_string_1 (const char *str, ptrdiff_t len) | |||
| 4952 | Lisp_Object obarray = check_obarray (Vobarray); | 4979 | Lisp_Object obarray = check_obarray (Vobarray); |
| 4953 | Lisp_Object tem = oblookup (obarray, str, len, len); | 4980 | Lisp_Object tem = oblookup (obarray, str, len, len); |
| 4954 | 4981 | ||
| 4955 | if (!SYMBOLP (tem)) | 4982 | if (!BARE_SYMBOL_P (tem)) |
| 4956 | { | 4983 | { |
| 4957 | Lisp_Object string; | 4984 | Lisp_Object string; |
| 4958 | 4985 | ||
| @@ -5004,7 +5031,7 @@ it defaults to the value of `obarray'. */) | |||
| 5004 | &longhand, &longhand_chars, | 5031 | &longhand, &longhand_chars, |
| 5005 | &longhand_bytes); | 5032 | &longhand_bytes); |
| 5006 | 5033 | ||
| 5007 | if (!SYMBOLP (tem)) | 5034 | if (!BARE_SYMBOL_P (tem)) |
| 5008 | { | 5035 | { |
| 5009 | if (longhand) | 5036 | if (longhand) |
| 5010 | { | 5037 | { |
| @@ -5053,10 +5080,11 @@ it defaults to the value of `obarray'. */) | |||
| 5053 | { | 5080 | { |
| 5054 | /* If already a symbol, we don't do shorthand-longhand translation, | 5081 | /* If already a symbol, we don't do shorthand-longhand translation, |
| 5055 | as promised in the docstring. */ | 5082 | as promised in the docstring. */ |
| 5056 | string = SYMBOL_NAME (name); | 5083 | Lisp_Object sym = maybe_remove_pos_from_symbol (name); |
| 5084 | string = XSYMBOL (name)->u.s.name; | ||
| 5057 | tem | 5085 | tem |
| 5058 | = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); | 5086 | = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); |
| 5059 | return EQ (name, tem) ? name : Qnil; | 5087 | return BASE_EQ (sym, tem) ? name : Qnil; |
| 5060 | } | 5088 | } |
| 5061 | } | 5089 | } |
| 5062 | 5090 | ||
| @@ -5071,13 +5099,16 @@ usage: (unintern NAME OBARRAY) */) | |||
| 5071 | { | 5099 | { |
| 5072 | register Lisp_Object tem; | 5100 | register Lisp_Object tem; |
| 5073 | Lisp_Object string; | 5101 | Lisp_Object string; |
| 5074 | size_t hash; | ||
| 5075 | 5102 | ||
| 5076 | if (NILP (obarray)) obarray = Vobarray; | 5103 | if (NILP (obarray)) obarray = Vobarray; |
| 5077 | obarray = check_obarray (obarray); | 5104 | obarray = check_obarray (obarray); |
| 5078 | 5105 | ||
| 5079 | if (SYMBOLP (name)) | 5106 | if (SYMBOLP (name)) |
| 5080 | string = SYMBOL_NAME (name); | 5107 | { |
| 5108 | if (!BARE_SYMBOL_P (name)) | ||
| 5109 | name = XSYMBOL_WITH_POS (name)->sym; | ||
| 5110 | string = SYMBOL_NAME (name); | ||
| 5111 | } | ||
| 5081 | else | 5112 | else |
| 5082 | { | 5113 | { |
| 5083 | CHECK_STRING (name); | 5114 | CHECK_STRING (name); |
| @@ -5097,7 +5128,7 @@ usage: (unintern NAME OBARRAY) */) | |||
| 5097 | if (FIXNUMP (tem)) | 5128 | if (FIXNUMP (tem)) |
| 5098 | return Qnil; | 5129 | return Qnil; |
| 5099 | /* If arg was a symbol, don't delete anything but that symbol itself. */ | 5130 | /* If arg was a symbol, don't delete anything but that symbol itself. */ |
| 5100 | if (SYMBOLP (name) && !EQ (name, tem)) | 5131 | if (BARE_SYMBOL_P (name) && !BASE_EQ (name, tem)) |
| 5101 | return Qnil; | 5132 | return Qnil; |
| 5102 | 5133 | ||
| 5103 | /* There are plenty of other symbols which will screw up the Emacs | 5134 | /* There are plenty of other symbols which will screw up the Emacs |
| @@ -5107,41 +5138,42 @@ usage: (unintern NAME OBARRAY) */) | |||
| 5107 | /* if (NILP (tem) || EQ (tem, Qt)) | 5138 | /* if (NILP (tem) || EQ (tem, Qt)) |
| 5108 | error ("Attempt to unintern t or nil"); */ | 5139 | error ("Attempt to unintern t or nil"); */ |
| 5109 | 5140 | ||
| 5110 | XSYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED; | 5141 | struct Lisp_Symbol *sym = XBARE_SYMBOL (tem); |
| 5142 | sym->u.s.interned = SYMBOL_UNINTERNED; | ||
| 5111 | 5143 | ||
| 5112 | hash = oblookup_last_bucket_number; | 5144 | ptrdiff_t idx = oblookup_last_bucket_number; |
| 5145 | Lisp_Object *loc = &XOBARRAY (obarray)->buckets[idx]; | ||
| 5113 | 5146 | ||
| 5114 | if (EQ (AREF (obarray, hash), tem)) | 5147 | eassert (BARE_SYMBOL_P (*loc)); |
| 5115 | { | 5148 | struct Lisp_Symbol *prev = XBARE_SYMBOL (*loc); |
| 5116 | if (XSYMBOL (tem)->u.s.next) | 5149 | if (sym == prev) |
| 5117 | { | 5150 | *loc = sym->u.s.next ? make_lisp_symbol (sym->u.s.next) : make_fixnum (0); |
| 5118 | Lisp_Object sym; | ||
| 5119 | XSETSYMBOL (sym, XSYMBOL (tem)->u.s.next); | ||
| 5120 | ASET (obarray, hash, sym); | ||
| 5121 | } | ||
| 5122 | else | ||
| 5123 | ASET (obarray, hash, make_fixnum (0)); | ||
| 5124 | } | ||
| 5125 | else | 5151 | else |
| 5126 | { | 5152 | while (1) |
| 5127 | Lisp_Object tail, following; | 5153 | { |
| 5154 | struct Lisp_Symbol *next = prev->u.s.next; | ||
| 5155 | if (next == sym) | ||
| 5156 | { | ||
| 5157 | prev->u.s.next = next->u.s.next; | ||
| 5158 | break; | ||
| 5159 | } | ||
| 5160 | prev = next; | ||
| 5161 | } | ||
| 5128 | 5162 | ||
| 5129 | for (tail = AREF (obarray, hash); | 5163 | XOBARRAY (obarray)->count--; |
| 5130 | XSYMBOL (tail)->u.s.next; | ||
| 5131 | tail = following) | ||
| 5132 | { | ||
| 5133 | XSETSYMBOL (following, XSYMBOL (tail)->u.s.next); | ||
| 5134 | if (EQ (following, tem)) | ||
| 5135 | { | ||
| 5136 | set_symbol_next (tail, XSYMBOL (following)->u.s.next); | ||
| 5137 | break; | ||
| 5138 | } | ||
| 5139 | } | ||
| 5140 | } | ||
| 5141 | 5164 | ||
| 5142 | return Qt; | 5165 | return Qt; |
| 5143 | } | 5166 | } |
| 5144 | 5167 | ||
| 5168 | |||
| 5169 | /* Bucket index of the string STR of length SIZE_BYTE bytes in obarray OA. */ | ||
| 5170 | static ptrdiff_t | ||
| 5171 | obarray_index (struct Lisp_Obarray *oa, const char *str, ptrdiff_t size_byte) | ||
| 5172 | { | ||
| 5173 | EMACS_UINT hash = hash_string (str, size_byte); | ||
| 5174 | return knuth_hash (reduce_emacs_uint_to_hash_hash (hash), oa->size_bits); | ||
| 5175 | } | ||
| 5176 | |||
| 5145 | /* Return the symbol in OBARRAY whose names matches the string | 5177 | /* Return the symbol in OBARRAY whose names matches the string |
| 5146 | of SIZE characters (SIZE_BYTE bytes) at PTR. | 5178 | of SIZE characters (SIZE_BYTE bytes) at PTR. |
| 5147 | If there is no such symbol, return the integer bucket number of | 5179 | If there is no such symbol, return the integer bucket number of |
| @@ -5152,35 +5184,27 @@ usage: (unintern NAME OBARRAY) */) | |||
| 5152 | Lisp_Object | 5184 | Lisp_Object |
| 5153 | oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte) | 5185 | oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte) |
| 5154 | { | 5186 | { |
| 5155 | size_t hash; | 5187 | struct Lisp_Obarray *o = XOBARRAY (obarray); |
| 5156 | size_t obsize; | 5188 | ptrdiff_t idx = obarray_index (o, ptr, size_byte); |
| 5157 | register Lisp_Object tail; | 5189 | Lisp_Object bucket = o->buckets[idx]; |
| 5158 | Lisp_Object bucket, tem; | ||
| 5159 | 5190 | ||
| 5160 | obarray = check_obarray (obarray); | 5191 | oblookup_last_bucket_number = idx; |
| 5161 | /* This is sometimes needed in the middle of GC. */ | 5192 | if (!BASE_EQ (bucket, make_fixnum (0))) |
| 5162 | obsize = gc_asize (obarray); | 5193 | { |
| 5163 | hash = hash_string (ptr, size_byte) % obsize; | 5194 | Lisp_Object sym = bucket; |
| 5164 | bucket = AREF (obarray, hash); | 5195 | while (1) |
| 5165 | oblookup_last_bucket_number = hash; | 5196 | { |
| 5166 | if (BASE_EQ (bucket, make_fixnum (0))) | 5197 | struct Lisp_Symbol *s = XBARE_SYMBOL (sym); |
| 5167 | ; | 5198 | Lisp_Object name = s->u.s.name; |
| 5168 | else if (!SYMBOLP (bucket)) | 5199 | if (SBYTES (name) == size_byte && SCHARS (name) == size |
| 5169 | /* Like CADR error message. */ | 5200 | && memcmp (SDATA (name), ptr, size_byte) == 0) |
| 5170 | xsignal2 (Qwrong_type_argument, Qobarrayp, | 5201 | return sym; |
| 5171 | build_string ("Bad data in guts of obarray")); | 5202 | if (s->u.s.next == NULL) |
| 5172 | else | 5203 | break; |
| 5173 | for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next)) | 5204 | sym = make_lisp_symbol(s->u.s.next); |
| 5174 | { | 5205 | } |
| 5175 | if (SBYTES (SYMBOL_NAME (tail)) == size_byte | 5206 | } |
| 5176 | && SCHARS (SYMBOL_NAME (tail)) == size | 5207 | return make_fixnum (idx); |
| 5177 | && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte)) | ||
| 5178 | return tail; | ||
| 5179 | else if (XSYMBOL (tail)->u.s.next == 0) | ||
| 5180 | break; | ||
| 5181 | } | ||
| 5182 | XSETINT (tem, hash); | ||
| 5183 | return tem; | ||
| 5184 | } | 5208 | } |
| 5185 | 5209 | ||
| 5186 | /* Like 'oblookup', but considers 'Vread_symbol_shorthands', | 5210 | /* Like 'oblookup', but considers 'Vread_symbol_shorthands', |
| @@ -5247,24 +5271,134 @@ oblookup_considering_shorthand (Lisp_Object obarray, const char *in, | |||
| 5247 | } | 5271 | } |
| 5248 | 5272 | ||
| 5249 | 5273 | ||
| 5250 | void | 5274 | static struct Lisp_Obarray * |
| 5251 | map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) | 5275 | allocate_obarray (void) |
| 5276 | { | ||
| 5277 | return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Obarray, PVEC_OBARRAY); | ||
| 5278 | } | ||
| 5279 | |||
| 5280 | static Lisp_Object | ||
| 5281 | make_obarray (unsigned bits) | ||
| 5282 | { | ||
| 5283 | struct Lisp_Obarray *o = allocate_obarray (); | ||
| 5284 | o->count = 0; | ||
| 5285 | o->size_bits = bits; | ||
| 5286 | ptrdiff_t size = (ptrdiff_t)1 << bits; | ||
| 5287 | o->buckets = hash_table_alloc_bytes (size * sizeof *o->buckets); | ||
| 5288 | for (ptrdiff_t i = 0; i < size; i++) | ||
| 5289 | o->buckets[i] = make_fixnum (0); | ||
| 5290 | return make_lisp_obarray (o); | ||
| 5291 | } | ||
| 5292 | |||
| 5293 | enum { | ||
| 5294 | obarray_default_bits = 3, | ||
| 5295 | word_size_log2 = word_size < 8 ? 5 : 6, /* good enough */ | ||
| 5296 | obarray_max_bits = min (8 * sizeof (int), | ||
| 5297 | 8 * sizeof (ptrdiff_t) - word_size_log2) - 1, | ||
| 5298 | }; | ||
| 5299 | |||
| 5300 | static void | ||
| 5301 | grow_obarray (struct Lisp_Obarray *o) | ||
| 5252 | { | 5302 | { |
| 5253 | ptrdiff_t i; | 5303 | ptrdiff_t old_size = obarray_size (o); |
| 5254 | register Lisp_Object tail; | 5304 | eassert (o->count > old_size); |
| 5255 | CHECK_VECTOR (obarray); | 5305 | Lisp_Object *old_buckets = o->buckets; |
| 5256 | for (i = ASIZE (obarray) - 1; i >= 0; i--) | 5306 | |
| 5307 | int new_bits = o->size_bits + 1; | ||
| 5308 | if (new_bits > obarray_max_bits) | ||
| 5309 | error ("Obarray too big"); | ||
| 5310 | ptrdiff_t new_size = (ptrdiff_t)1 << new_bits; | ||
| 5311 | o->buckets = hash_table_alloc_bytes (new_size * sizeof *o->buckets); | ||
| 5312 | for (ptrdiff_t i = 0; i < new_size; i++) | ||
| 5313 | o->buckets[i] = make_fixnum (0); | ||
| 5314 | o->size_bits = new_bits; | ||
| 5315 | |||
| 5316 | /* Rehash symbols. | ||
| 5317 | FIXME: this is expensive since we need to recompute the hash for every | ||
| 5318 | symbol name. Would it be reasonable to store it in the symbol? */ | ||
| 5319 | for (ptrdiff_t i = 0; i < old_size; i++) | ||
| 5257 | { | 5320 | { |
| 5258 | tail = AREF (obarray, i); | 5321 | Lisp_Object obj = old_buckets[i]; |
| 5259 | if (SYMBOLP (tail)) | 5322 | if (BARE_SYMBOL_P (obj)) |
| 5260 | while (1) | 5323 | { |
| 5261 | { | 5324 | struct Lisp_Symbol *s = XBARE_SYMBOL (obj); |
| 5262 | (*fn) (tail, arg); | 5325 | while (1) |
| 5263 | if (XSYMBOL (tail)->u.s.next == 0) | 5326 | { |
| 5264 | break; | 5327 | Lisp_Object name = s->u.s.name; |
| 5265 | XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next); | 5328 | ptrdiff_t idx = obarray_index (o, SSDATA (name), SBYTES (name)); |
| 5266 | } | 5329 | Lisp_Object *loc = o->buckets + idx; |
| 5330 | struct Lisp_Symbol *next = s->u.s.next; | ||
| 5331 | s->u.s.next = BARE_SYMBOL_P (*loc) ? XBARE_SYMBOL (*loc) : NULL; | ||
| 5332 | *loc = make_lisp_symbol (s); | ||
| 5333 | if (next == NULL) | ||
| 5334 | break; | ||
| 5335 | s = next; | ||
| 5336 | } | ||
| 5337 | } | ||
| 5338 | } | ||
| 5339 | |||
| 5340 | hash_table_free_bytes (old_buckets, old_size * sizeof *old_buckets); | ||
| 5341 | } | ||
| 5342 | |||
| 5343 | DEFUN ("obarray-make", Fobarray_make, Sobarray_make, 0, 1, 0, | ||
| 5344 | doc: /* Return a new obarray of size SIZE. | ||
| 5345 | The obarray will grow to accommodate any number of symbols; the size, if | ||
| 5346 | given, is only a hint for the expected number. */) | ||
| 5347 | (Lisp_Object size) | ||
| 5348 | { | ||
| 5349 | int bits; | ||
| 5350 | if (NILP (size)) | ||
| 5351 | bits = obarray_default_bits; | ||
| 5352 | else | ||
| 5353 | { | ||
| 5354 | CHECK_FIXNAT (size); | ||
| 5355 | EMACS_UINT n = XFIXNUM (size); | ||
| 5356 | bits = elogb (n) + 1; | ||
| 5357 | if (bits > obarray_max_bits) | ||
| 5358 | xsignal (Qargs_out_of_range, size); | ||
| 5267 | } | 5359 | } |
| 5360 | return make_obarray (bits); | ||
| 5361 | } | ||
| 5362 | |||
| 5363 | DEFUN ("obarrayp", Fobarrayp, Sobarrayp, 1, 1, 0, | ||
| 5364 | doc: /* Return t iff OBJECT is an obarray. */) | ||
| 5365 | (Lisp_Object object) | ||
| 5366 | { | ||
| 5367 | return OBARRAYP (object) ? Qt : Qnil; | ||
| 5368 | } | ||
| 5369 | |||
| 5370 | DEFUN ("obarray-clear", Fobarray_clear, Sobarray_clear, 1, 1, 0, | ||
| 5371 | doc: /* Remove all symbols from OBARRAY. */) | ||
| 5372 | (Lisp_Object obarray) | ||
| 5373 | { | ||
| 5374 | CHECK_OBARRAY (obarray); | ||
| 5375 | struct Lisp_Obarray *o = XOBARRAY (obarray); | ||
| 5376 | |||
| 5377 | /* This function does not bother setting the status of its contained symbols | ||
| 5378 | to uninterned. It doesn't matter very much. */ | ||
| 5379 | int new_bits = obarray_default_bits; | ||
| 5380 | int new_size = (ptrdiff_t)1 << new_bits; | ||
| 5381 | Lisp_Object *new_buckets | ||
| 5382 | = hash_table_alloc_bytes (new_size * sizeof *new_buckets); | ||
| 5383 | for (ptrdiff_t i = 0; i < new_size; i++) | ||
| 5384 | new_buckets[i] = make_fixnum (0); | ||
| 5385 | |||
| 5386 | int old_size = obarray_size (o); | ||
| 5387 | hash_table_free_bytes (o->buckets, old_size * sizeof *o->buckets); | ||
| 5388 | o->buckets = new_buckets; | ||
| 5389 | o->size_bits = new_bits; | ||
| 5390 | o->count = 0; | ||
| 5391 | |||
| 5392 | return Qnil; | ||
| 5393 | } | ||
| 5394 | |||
| 5395 | void | ||
| 5396 | map_obarray (Lisp_Object obarray, | ||
| 5397 | void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) | ||
| 5398 | { | ||
| 5399 | CHECK_OBARRAY (obarray); | ||
| 5400 | DOOBARRAY (XOBARRAY (obarray), it) | ||
| 5401 | (*fn) (obarray_iter_symbol (&it), arg); | ||
| 5268 | } | 5402 | } |
| 5269 | 5403 | ||
| 5270 | static void | 5404 | static void |
| @@ -5285,12 +5419,37 @@ OBARRAY defaults to the value of `obarray'. */) | |||
| 5285 | return Qnil; | 5419 | return Qnil; |
| 5286 | } | 5420 | } |
| 5287 | 5421 | ||
| 5288 | #define OBARRAY_SIZE 15121 | 5422 | DEFUN ("internal--obarray-buckets", |
| 5423 | Finternal__obarray_buckets, Sinternal__obarray_buckets, 1, 1, 0, | ||
| 5424 | doc: /* Symbols in each bucket of OBARRAY. Internal use only. */) | ||
| 5425 | (Lisp_Object obarray) | ||
| 5426 | { | ||
| 5427 | obarray = check_obarray (obarray); | ||
| 5428 | ptrdiff_t size = obarray_size (XOBARRAY (obarray)); | ||
| 5429 | |||
| 5430 | Lisp_Object ret = Qnil; | ||
| 5431 | for (ptrdiff_t i = 0; i < size; i++) | ||
| 5432 | { | ||
| 5433 | Lisp_Object bucket = Qnil; | ||
| 5434 | Lisp_Object sym = XOBARRAY (obarray)->buckets[i]; | ||
| 5435 | if (BARE_SYMBOL_P (sym)) | ||
| 5436 | while (1) | ||
| 5437 | { | ||
| 5438 | bucket = Fcons (sym, bucket); | ||
| 5439 | struct Lisp_Symbol *s = XBARE_SYMBOL (sym)->u.s.next; | ||
| 5440 | if (!s) | ||
| 5441 | break; | ||
| 5442 | sym = make_lisp_symbol (s); | ||
| 5443 | } | ||
| 5444 | ret = Fcons (Fnreverse (bucket), ret); | ||
| 5445 | } | ||
| 5446 | return Fnreverse (ret); | ||
| 5447 | } | ||
| 5289 | 5448 | ||
| 5290 | void | 5449 | void |
| 5291 | init_obarray_once (void) | 5450 | init_obarray_once (void) |
| 5292 | { | 5451 | { |
| 5293 | Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0)); | 5452 | Vobarray = make_obarray (15); |
| 5294 | initial_obarray = Vobarray; | 5453 | initial_obarray = Vobarray; |
| 5295 | staticpro (&initial_obarray); | 5454 | staticpro (&initial_obarray); |
| 5296 | 5455 | ||
| @@ -5300,14 +5459,14 @@ init_obarray_once (void) | |||
| 5300 | DEFSYM (Qunbound, "unbound"); | 5459 | DEFSYM (Qunbound, "unbound"); |
| 5301 | 5460 | ||
| 5302 | DEFSYM (Qnil, "nil"); | 5461 | DEFSYM (Qnil, "nil"); |
| 5303 | SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); | 5462 | SET_SYMBOL_VAL (XBARE_SYMBOL (Qnil), Qnil); |
| 5304 | make_symbol_constant (Qnil); | 5463 | make_symbol_constant (Qnil); |
| 5305 | XSYMBOL (Qnil)->u.s.declared_special = true; | 5464 | XBARE_SYMBOL (Qnil)->u.s.declared_special = true; |
| 5306 | 5465 | ||
| 5307 | DEFSYM (Qt, "t"); | 5466 | DEFSYM (Qt, "t"); |
| 5308 | SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); | 5467 | SET_SYMBOL_VAL (XBARE_SYMBOL (Qt), Qt); |
| 5309 | make_symbol_constant (Qt); | 5468 | make_symbol_constant (Qt); |
| 5310 | XSYMBOL (Qt)->u.s.declared_special = true; | 5469 | XBARE_SYMBOL (Qt)->u.s.declared_special = true; |
| 5311 | 5470 | ||
| 5312 | /* Qt is correct even if not dumping. loadup.el will set to nil at end. */ | 5471 | /* Qt is correct even if not dumping. loadup.el will set to nil at end. */ |
| 5313 | Vpurify_flag = Qt; | 5472 | Vpurify_flag = Qt; |
| @@ -5331,16 +5490,6 @@ defsubr (union Aligned_Lisp_Subr *aname) | |||
| 5331 | #endif | 5490 | #endif |
| 5332 | } | 5491 | } |
| 5333 | 5492 | ||
| 5334 | #ifdef NOTDEF /* Use fset in subr.el now! */ | ||
| 5335 | void | ||
| 5336 | defalias (struct Lisp_Subr *sname, char *string) | ||
| 5337 | { | ||
| 5338 | Lisp_Object sym; | ||
| 5339 | sym = intern (string); | ||
| 5340 | XSETSUBR (XSYMBOL (sym)->u.s.function, sname); | ||
| 5341 | } | ||
| 5342 | #endif /* NOTDEF */ | ||
| 5343 | |||
| 5344 | /* Define an "integer variable"; a symbol whose value is forwarded to a | 5493 | /* Define an "integer variable"; a symbol whose value is forwarded to a |
| 5345 | C variable of type intmax_t. Sample call (with "xx" to fool make-docfile): | 5494 | C variable of type intmax_t. Sample call (with "xx" to fool make-docfile): |
| 5346 | DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ | 5495 | DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ |
| @@ -5348,9 +5497,9 @@ void | |||
| 5348 | defvar_int (struct Lisp_Intfwd const *i_fwd, char const *namestring) | 5497 | defvar_int (struct Lisp_Intfwd const *i_fwd, char const *namestring) |
| 5349 | { | 5498 | { |
| 5350 | Lisp_Object sym = intern_c_string (namestring); | 5499 | Lisp_Object sym = intern_c_string (namestring); |
| 5351 | XSYMBOL (sym)->u.s.declared_special = true; | 5500 | XBARE_SYMBOL (sym)->u.s.declared_special = true; |
| 5352 | XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; | 5501 | XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; |
| 5353 | SET_SYMBOL_FWD (XSYMBOL (sym), i_fwd); | 5502 | SET_SYMBOL_FWD (XBARE_SYMBOL (sym), i_fwd); |
| 5354 | } | 5503 | } |
| 5355 | 5504 | ||
| 5356 | /* Similar but define a variable whose value is t if 1, nil if 0. */ | 5505 | /* Similar but define a variable whose value is t if 1, nil if 0. */ |
| @@ -5358,9 +5507,9 @@ void | |||
| 5358 | defvar_bool (struct Lisp_Boolfwd const *b_fwd, char const *namestring) | 5507 | defvar_bool (struct Lisp_Boolfwd const *b_fwd, char const *namestring) |
| 5359 | { | 5508 | { |
| 5360 | Lisp_Object sym = intern_c_string (namestring); | 5509 | Lisp_Object sym = intern_c_string (namestring); |
| 5361 | XSYMBOL (sym)->u.s.declared_special = true; | 5510 | XBARE_SYMBOL (sym)->u.s.declared_special = true; |
| 5362 | XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; | 5511 | XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; |
| 5363 | SET_SYMBOL_FWD (XSYMBOL (sym), b_fwd); | 5512 | SET_SYMBOL_FWD (XBARE_SYMBOL (sym), b_fwd); |
| 5364 | Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); | 5513 | Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); |
| 5365 | } | 5514 | } |
| 5366 | 5515 | ||
| @@ -5373,9 +5522,9 @@ void | |||
| 5373 | defvar_lisp_nopro (struct Lisp_Objfwd const *o_fwd, char const *namestring) | 5522 | defvar_lisp_nopro (struct Lisp_Objfwd const *o_fwd, char const *namestring) |
| 5374 | { | 5523 | { |
| 5375 | Lisp_Object sym = intern_c_string (namestring); | 5524 | Lisp_Object sym = intern_c_string (namestring); |
| 5376 | XSYMBOL (sym)->u.s.declared_special = true; | 5525 | XBARE_SYMBOL (sym)->u.s.declared_special = true; |
| 5377 | XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; | 5526 | XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; |
| 5378 | SET_SYMBOL_FWD (XSYMBOL (sym), o_fwd); | 5527 | SET_SYMBOL_FWD (XBARE_SYMBOL (sym), o_fwd); |
| 5379 | } | 5528 | } |
| 5380 | 5529 | ||
| 5381 | void | 5530 | void |
| @@ -5392,9 +5541,9 @@ void | |||
| 5392 | defvar_kboard (struct Lisp_Kboard_Objfwd const *ko_fwd, char const *namestring) | 5541 | defvar_kboard (struct Lisp_Kboard_Objfwd const *ko_fwd, char const *namestring) |
| 5393 | { | 5542 | { |
| 5394 | Lisp_Object sym = intern_c_string (namestring); | 5543 | Lisp_Object sym = intern_c_string (namestring); |
| 5395 | XSYMBOL (sym)->u.s.declared_special = true; | 5544 | XBARE_SYMBOL (sym)->u.s.declared_special = true; |
| 5396 | XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; | 5545 | XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; |
| 5397 | SET_SYMBOL_FWD (XSYMBOL (sym), ko_fwd); | 5546 | SET_SYMBOL_FWD (XBARE_SYMBOL (sym), ko_fwd); |
| 5398 | } | 5547 | } |
| 5399 | 5548 | ||
| 5400 | /* Check that the elements of lpath exist. */ | 5549 | /* Check that the elements of lpath exist. */ |
| @@ -5682,6 +5831,10 @@ syms_of_lread (void) | |||
| 5682 | defsubr (&Sget_file_char); | 5831 | defsubr (&Sget_file_char); |
| 5683 | defsubr (&Smapatoms); | 5832 | defsubr (&Smapatoms); |
| 5684 | defsubr (&Slocate_file_internal); | 5833 | defsubr (&Slocate_file_internal); |
| 5834 | defsubr (&Sinternal__obarray_buckets); | ||
| 5835 | defsubr (&Sobarray_make); | ||
| 5836 | defsubr (&Sobarrayp); | ||
| 5837 | defsubr (&Sobarray_clear); | ||
| 5685 | 5838 | ||
| 5686 | DEFVAR_LISP ("obarray", Vobarray, | 5839 | DEFVAR_LISP ("obarray", Vobarray, |
| 5687 | doc: /* Symbol table for use by `intern' and `read'. | 5840 | doc: /* Symbol table for use by `intern' and `read'. |
| @@ -5693,7 +5846,7 @@ to find all the symbols in an obarray, use `mapatoms'. */); | |||
| 5693 | doc: /* List of values of all expressions which were read, evaluated and printed. | 5846 | doc: /* List of values of all expressions which were read, evaluated and printed. |
| 5694 | Order is reverse chronological. | 5847 | Order is reverse chronological. |
| 5695 | This variable is obsolete as of Emacs 28.1 and should not be used. */); | 5848 | This variable is obsolete as of Emacs 28.1 and should not be used. */); |
| 5696 | XSYMBOL (intern ("values"))->u.s.declared_special = false; | 5849 | XBARE_SYMBOL (intern ("values"))->u.s.declared_special = false; |
| 5697 | 5850 | ||
| 5698 | DEFVAR_LISP ("standard-input", Vstandard_input, | 5851 | DEFVAR_LISP ("standard-input", Vstandard_input, |
| 5699 | doc: /* Stream for read to get input from. | 5852 | doc: /* Stream for read to get input from. |
| @@ -6007,4 +6160,7 @@ See Info node `(elisp)Shorthands' for more details. */); | |||
| 6007 | doc: /* List of variables declared dynamic in the current scope. | 6160 | doc: /* List of variables declared dynamic in the current scope. |
| 6008 | Only valid during macro-expansion. Internal use only. */); | 6161 | Only valid during macro-expansion. Internal use only. */); |
| 6009 | Vmacroexp__dynvars = Qnil; | 6162 | Vmacroexp__dynvars = Qnil; |
| 6163 | |||
| 6164 | DEFSYM (Qinternal_macroexpand_for_load, | ||
| 6165 | "internal-macroexpand-for-load"); | ||
| 6010 | } | 6166 | } |
diff --git a/src/macfont.m b/src/macfont.m index 6f192b00f1b..e3b3d40df43 100644 --- a/src/macfont.m +++ b/src/macfont.m | |||
| @@ -855,21 +855,42 @@ macfont_store_descriptor_attributes (CTFontDescriptorRef desc, | |||
| 855 | struct { | 855 | struct { |
| 856 | enum font_property_index index; | 856 | enum font_property_index index; |
| 857 | CFStringRef trait; | 857 | CFStringRef trait; |
| 858 | CGPoint points[6]; | 858 | CGPoint points[12]; |
| 859 | CGFloat (*adjust_func) (CTFontDescriptorRef, CGFloat); | 859 | CGFloat (*adjust_func) (CTFontDescriptorRef, CGFloat); |
| 860 | } numeric_traits[] = | 860 | } numeric_traits[] = { |
| 861 | {{FONT_WEIGHT_INDEX, kCTFontWeightTrait, | 861 | { FONT_WEIGHT_INDEX, |
| 862 | {{-0.4, 50}, /* light */ | 862 | kCTFontWeightTrait, |
| 863 | {-0.24, 87.5}, /* (semi-light + normal) / 2 */ | 863 | { { -0.6, 0 }, /* thin */ |
| 864 | {0, 80}, /* normal */ | 864 | { -0.4, 40 }, /* ultra-light, ultralight, extra-light, extralight */ |
| 865 | {0.24, 140}, /* (semi-bold + normal) / 2 */ | 865 | { -0.23, 50 }, /* light */ |
| 866 | {0.4, 200}, /* bold */ | 866 | { -0.115, 55 }, /* semi-light, semilight, demilight */ |
| 867 | {CGFLOAT_MAX, CGFLOAT_MAX}}, | 867 | { 0, 80 }, /* regular, normal, unspecified, book */ |
| 868 | mac_font_descriptor_get_adjusted_weight}, | 868 | { 0.2, 100 }, /* medium */ |
| 869 | {FONT_SLANT_INDEX, kCTFontSlantTrait, | 869 | { 0.3, 180 }, /* semi-bold, semibold, demibold, demi-bold, demi */ |
| 870 | {{0, 100}, {0.1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}, NULL}, | 870 | { 0.4, 200 }, /* bold */ |
| 871 | {FONT_WIDTH_INDEX, kCTFontWidthTrait, | 871 | { 0.6, 205 }, /* extra-bold, extrabold, ultra-bold, ultrabold */ |
| 872 | {{0, 100}, {1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}, NULL}}; | 872 | { 0.8, 210 }, /* black, heavy */ |
| 873 | { 1, 250 }, /* ultra-heavy, ultraheavy */ | ||
| 874 | { CGFLOAT_MAX, CGFLOAT_MAX } }, | ||
| 875 | mac_font_descriptor_get_adjusted_weight }, | ||
| 876 | { FONT_SLANT_INDEX, | ||
| 877 | kCTFontSlantTrait, | ||
| 878 | { { 0, 100 }, { 0.1, 200 }, { CGFLOAT_MAX, CGFLOAT_MAX } }, | ||
| 879 | NULL }, | ||
| 880 | { FONT_WIDTH_INDEX, | ||
| 881 | kCTFontWidthTrait, | ||
| 882 | { { -0.4, 50 }, /* ultra-condensed, ultracondensed */ | ||
| 883 | { -0.3, 63 }, /* extra-condensed, extracondensed */ | ||
| 884 | { -0.2, 75 }, /* condensed, compressed, narrow */ | ||
| 885 | { -0.1, 87 }, /* semi-condensed, semicondensed, demicondensed */ | ||
| 886 | { 0, 100 }, /* normal, medium, regular, unspecified */ | ||
| 887 | { 0.1, 113 }, /* semi-expanded, semiexpanded, demiexpanded */ | ||
| 888 | { 0.2, 125 }, /* expanded */ | ||
| 889 | { 0.3, 150 }, /* extra-expanded, extraexpanded */ | ||
| 890 | { 0.4, 200 }, /* ultra-expanded, ultraexpanded, wide */ | ||
| 891 | { CGFLOAT_MAX, CGFLOAT_MAX } }, | ||
| 892 | NULL } | ||
| 893 | }; | ||
| 873 | int i; | 894 | int i; |
| 874 | 895 | ||
| 875 | for (i = 0; i < ARRAYELTS (numeric_traits); i++) | 896 | for (i = 0; i < ARRAYELTS (numeric_traits); i++) |
| @@ -1941,19 +1962,38 @@ macfont_create_attributes_with_spec (Lisp_Object spec) | |||
| 1941 | struct { | 1962 | struct { |
| 1942 | enum font_property_index index; | 1963 | enum font_property_index index; |
| 1943 | CFStringRef trait; | 1964 | CFStringRef trait; |
| 1944 | CGPoint points[6]; | 1965 | CGPoint points[12]; |
| 1945 | } numeric_traits[] = | 1966 | } numeric_traits[] = { |
| 1946 | {{FONT_WEIGHT_INDEX, kCTFontWeightTrait, | 1967 | { FONT_WEIGHT_INDEX, |
| 1947 | {{-0.4, 50}, /* light */ | 1968 | kCTFontWeightTrait, |
| 1948 | {-0.24, 87.5}, /* (semi-light + normal) / 2 */ | 1969 | { { -0.6, 0 }, /* thin */ |
| 1949 | {0, 100}, /* normal */ | 1970 | { -0.4, 40 }, /* ultra-light, ultralight, extra-light, extralight */ |
| 1950 | {0.24, 140}, /* (semi-bold + normal) / 2 */ | 1971 | { -0.23, 50 }, /* light */ |
| 1951 | {0.4, 200}, /* bold */ | 1972 | { -0.115, 55 }, /* semi-light, semilight, demilight */ |
| 1952 | {CGFLOAT_MAX, CGFLOAT_MAX}}}, | 1973 | { 0, 80 }, /* regular, normal, unspecified, book */ |
| 1953 | {FONT_SLANT_INDEX, kCTFontSlantTrait, | 1974 | { 0.2, 100 }, /* medium */ |
| 1954 | {{0, 100}, {0.1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}}, | 1975 | { 0.3, 180 }, /* semi-bold, semibold, demibold, demi-bold, demi */ |
| 1955 | {FONT_WIDTH_INDEX, kCTFontWidthTrait, | 1976 | { 0.4, 200 }, /* bold */ |
| 1956 | {{0, 100}, {1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}}}; | 1977 | { 0.6, 205 }, /* extra-bold, extrabold, ultra-bold, ultrabold */ |
| 1978 | { 0.8, 210 }, /* black, heavy */ | ||
| 1979 | { 1, 250 }, /* ultra-heavy, ultraheavy */ | ||
| 1980 | { CGFLOAT_MAX, CGFLOAT_MAX } } }, | ||
| 1981 | { FONT_SLANT_INDEX, | ||
| 1982 | kCTFontSlantTrait, | ||
| 1983 | { { 0, 100 }, { 0.1, 200 }, { CGFLOAT_MAX, CGFLOAT_MAX } } }, | ||
| 1984 | { FONT_WIDTH_INDEX, | ||
| 1985 | kCTFontWidthTrait, | ||
| 1986 | { { -0.4, 50 }, /* ultra-condensed, ultracondensed */ | ||
| 1987 | { -0.3, 63 }, /* extra-condensed, extracondensed */ | ||
| 1988 | { -0.2, 75 }, /* condensed, compressed, narrow */ | ||
| 1989 | { -0.1, 87 }, /* semi-condensed, semicondensed, demicondensed */ | ||
| 1990 | { 0, 100 }, /* normal, medium, regular, unspecified */ | ||
| 1991 | { 0.1, 113 }, /* semi-expanded, semiexpanded, demiexpanded */ | ||
| 1992 | { 0.2, 125 }, /* expanded */ | ||
| 1993 | { 0.3, 150 }, /* extra-expanded, extraexpanded */ | ||
| 1994 | { 0.4, 200 }, /* ultra-expanded, ultraexpanded, wide */ | ||
| 1995 | { CGFLOAT_MAX, CGFLOAT_MAX } } } | ||
| 1996 | }; | ||
| 1957 | 1997 | ||
| 1958 | registry = AREF (spec, FONT_REGISTRY_INDEX); | 1998 | registry = AREF (spec, FONT_REGISTRY_INDEX); |
| 1959 | if (NILP (registry) | 1999 | if (NILP (registry) |
diff --git a/src/marker.c b/src/marker.c index 0101e144b4d..1559dd52719 100644 --- a/src/marker.c +++ b/src/marker.c | |||
| @@ -21,7 +21,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 21 | #include <config.h> | 21 | #include <config.h> |
| 22 | 22 | ||
| 23 | /* Work around GCC bug 113253. */ | 23 | /* Work around GCC bug 113253. */ |
| 24 | #if 13 <= __GNUC__ | 24 | #if __GNUC__ == 13 |
| 25 | # pragma GCC diagnostic ignored "-Wanalyzer-deref-before-check" | 25 | # pragma GCC diagnostic ignored "-Wanalyzer-deref-before-check" |
| 26 | #endif | 26 | #endif |
| 27 | 27 | ||
diff --git a/src/minibuf.c b/src/minibuf.c index 7c0c9799a60..df6ca7ce1d8 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -1615,13 +1615,15 @@ or from one of the possible completions. */) | |||
| 1615 | ptrdiff_t bestmatchsize = 0; | 1615 | ptrdiff_t bestmatchsize = 0; |
| 1616 | /* These are in bytes, too. */ | 1616 | /* These are in bytes, too. */ |
| 1617 | ptrdiff_t compare, matchsize; | 1617 | ptrdiff_t compare, matchsize; |
| 1618 | if (VECTORP (collection)) | ||
| 1619 | collection = check_obarray (collection); | ||
| 1618 | enum { function_table, list_table, obarray_table, hash_table} | 1620 | enum { function_table, list_table, obarray_table, hash_table} |
| 1619 | type = (HASH_TABLE_P (collection) ? hash_table | 1621 | type = (HASH_TABLE_P (collection) ? hash_table |
| 1620 | : VECTORP (collection) ? obarray_table | 1622 | : OBARRAYP (collection) ? obarray_table |
| 1621 | : ((NILP (collection) | 1623 | : ((NILP (collection) |
| 1622 | || (CONSP (collection) && !FUNCTIONP (collection))) | 1624 | || (CONSP (collection) && !FUNCTIONP (collection))) |
| 1623 | ? list_table : function_table)); | 1625 | ? list_table : function_table)); |
| 1624 | ptrdiff_t idx = 0, obsize = 0; | 1626 | ptrdiff_t idx = 0; |
| 1625 | int matchcount = 0; | 1627 | int matchcount = 0; |
| 1626 | Lisp_Object bucket, zero, end, tem; | 1628 | Lisp_Object bucket, zero, end, tem; |
| 1627 | 1629 | ||
| @@ -1634,12 +1636,9 @@ or from one of the possible completions. */) | |||
| 1634 | 1636 | ||
| 1635 | /* If COLLECTION is not a list, set TAIL just for gc pro. */ | 1637 | /* If COLLECTION is not a list, set TAIL just for gc pro. */ |
| 1636 | tail = collection; | 1638 | tail = collection; |
| 1639 | obarray_iter_t obit; | ||
| 1637 | if (type == obarray_table) | 1640 | if (type == obarray_table) |
| 1638 | { | 1641 | obit = make_obarray_iter (XOBARRAY (collection)); |
| 1639 | collection = check_obarray (collection); | ||
| 1640 | obsize = ASIZE (collection); | ||
| 1641 | bucket = AREF (collection, idx); | ||
| 1642 | } | ||
| 1643 | 1642 | ||
| 1644 | while (1) | 1643 | while (1) |
| 1645 | { | 1644 | { |
| @@ -1658,24 +1657,10 @@ or from one of the possible completions. */) | |||
| 1658 | } | 1657 | } |
| 1659 | else if (type == obarray_table) | 1658 | else if (type == obarray_table) |
| 1660 | { | 1659 | { |
| 1661 | if (!EQ (bucket, zero)) | 1660 | if (obarray_iter_at_end (&obit)) |
| 1662 | { | ||
| 1663 | if (!SYMBOLP (bucket)) | ||
| 1664 | error ("Bad data in guts of obarray"); | ||
| 1665 | elt = bucket; | ||
| 1666 | eltstring = elt; | ||
| 1667 | if (XSYMBOL (bucket)->u.s.next) | ||
| 1668 | XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next); | ||
| 1669 | else | ||
| 1670 | XSETFASTINT (bucket, 0); | ||
| 1671 | } | ||
| 1672 | else if (++idx >= obsize) | ||
| 1673 | break; | 1661 | break; |
| 1674 | else | 1662 | elt = eltstring = obarray_iter_symbol (&obit); |
| 1675 | { | 1663 | obarray_iter_step (&obit); |
| 1676 | bucket = AREF (collection, idx); | ||
| 1677 | continue; | ||
| 1678 | } | ||
| 1679 | } | 1664 | } |
| 1680 | else /* if (type == hash_table) */ | 1665 | else /* if (type == hash_table) */ |
| 1681 | { | 1666 | { |
| @@ -1858,10 +1843,12 @@ with a space are ignored unless STRING itself starts with a space. */) | |||
| 1858 | { | 1843 | { |
| 1859 | Lisp_Object tail, elt, eltstring; | 1844 | Lisp_Object tail, elt, eltstring; |
| 1860 | Lisp_Object allmatches; | 1845 | Lisp_Object allmatches; |
| 1846 | if (VECTORP (collection)) | ||
| 1847 | collection = check_obarray (collection); | ||
| 1861 | int type = HASH_TABLE_P (collection) ? 3 | 1848 | int type = HASH_TABLE_P (collection) ? 3 |
| 1862 | : VECTORP (collection) ? 2 | 1849 | : OBARRAYP (collection) ? 2 |
| 1863 | : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); | 1850 | : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); |
| 1864 | ptrdiff_t idx = 0, obsize = 0; | 1851 | ptrdiff_t idx = 0; |
| 1865 | Lisp_Object bucket, tem, zero; | 1852 | Lisp_Object bucket, tem, zero; |
| 1866 | 1853 | ||
| 1867 | CHECK_STRING (string); | 1854 | CHECK_STRING (string); |
| @@ -1872,12 +1859,9 @@ with a space are ignored unless STRING itself starts with a space. */) | |||
| 1872 | 1859 | ||
| 1873 | /* If COLLECTION is not a list, set TAIL just for gc pro. */ | 1860 | /* If COLLECTION is not a list, set TAIL just for gc pro. */ |
| 1874 | tail = collection; | 1861 | tail = collection; |
| 1862 | obarray_iter_t obit; | ||
| 1875 | if (type == 2) | 1863 | if (type == 2) |
| 1876 | { | 1864 | obit = make_obarray_iter (XOBARRAY (collection)); |
| 1877 | collection = check_obarray (collection); | ||
| 1878 | obsize = ASIZE (collection); | ||
| 1879 | bucket = AREF (collection, idx); | ||
| 1880 | } | ||
| 1881 | 1865 | ||
| 1882 | while (1) | 1866 | while (1) |
| 1883 | { | 1867 | { |
| @@ -1896,24 +1880,10 @@ with a space are ignored unless STRING itself starts with a space. */) | |||
| 1896 | } | 1880 | } |
| 1897 | else if (type == 2) | 1881 | else if (type == 2) |
| 1898 | { | 1882 | { |
| 1899 | if (!EQ (bucket, zero)) | 1883 | if (obarray_iter_at_end (&obit)) |
| 1900 | { | ||
| 1901 | if (!SYMBOLP (bucket)) | ||
| 1902 | error ("Bad data in guts of obarray"); | ||
| 1903 | elt = bucket; | ||
| 1904 | eltstring = elt; | ||
| 1905 | if (XSYMBOL (bucket)->u.s.next) | ||
| 1906 | XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next); | ||
| 1907 | else | ||
| 1908 | XSETFASTINT (bucket, 0); | ||
| 1909 | } | ||
| 1910 | else if (++idx >= obsize) | ||
| 1911 | break; | 1884 | break; |
| 1912 | else | 1885 | elt = eltstring = obarray_iter_symbol (&obit); |
| 1913 | { | 1886 | obarray_iter_step (&obit); |
| 1914 | bucket = AREF (collection, idx); | ||
| 1915 | continue; | ||
| 1916 | } | ||
| 1917 | } | 1887 | } |
| 1918 | else /* if (type == 3) */ | 1888 | else /* if (type == 3) */ |
| 1919 | { | 1889 | { |
| @@ -2059,7 +2029,7 @@ If COLLECTION is a function, it is called with three arguments: | |||
| 2059 | the values STRING, PREDICATE and `lambda'. */) | 2029 | the values STRING, PREDICATE and `lambda'. */) |
| 2060 | (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) | 2030 | (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) |
| 2061 | { | 2031 | { |
| 2062 | Lisp_Object tail, tem = Qnil, arg = Qnil; | 2032 | Lisp_Object tem = Qnil, arg = Qnil; |
| 2063 | 2033 | ||
| 2064 | CHECK_STRING (string); | 2034 | CHECK_STRING (string); |
| 2065 | 2035 | ||
| @@ -2069,38 +2039,30 @@ the values STRING, PREDICATE and `lambda'. */) | |||
| 2069 | if (NILP (tem)) | 2039 | if (NILP (tem)) |
| 2070 | return Qnil; | 2040 | return Qnil; |
| 2071 | } | 2041 | } |
| 2072 | else if (VECTORP (collection)) | 2042 | else if (OBARRAYP (collection) || VECTORP (collection)) |
| 2073 | { | 2043 | { |
| 2044 | collection = check_obarray (collection); | ||
| 2074 | /* Bypass intern-soft as that loses for nil. */ | 2045 | /* Bypass intern-soft as that loses for nil. */ |
| 2075 | tem = oblookup (collection, | 2046 | tem = oblookup (collection, |
| 2076 | SSDATA (string), | 2047 | SSDATA (string), |
| 2077 | SCHARS (string), | 2048 | SCHARS (string), |
| 2078 | SBYTES (string)); | 2049 | SBYTES (string)); |
| 2079 | if (completion_ignore_case && !SYMBOLP (tem)) | 2050 | if (completion_ignore_case && !BARE_SYMBOL_P (tem)) |
| 2080 | { | 2051 | DOOBARRAY (XOBARRAY (collection), it) |
| 2081 | for (ptrdiff_t i = ASIZE (collection) - 1; i >= 0; i--) | 2052 | { |
| 2082 | { | 2053 | Lisp_Object obj = obarray_iter_symbol (&it); |
| 2083 | tail = AREF (collection, i); | 2054 | if (BASE_EQ (Fcompare_strings (string, make_fixnum (0), |
| 2084 | if (SYMBOLP (tail)) | 2055 | Qnil, |
| 2085 | while (1) | 2056 | Fsymbol_name (obj), |
| 2086 | { | 2057 | make_fixnum (0) , Qnil, Qt), |
| 2087 | if (BASE_EQ (Fcompare_strings (string, make_fixnum (0), | 2058 | Qt)) |
| 2088 | Qnil, | 2059 | { |
| 2089 | Fsymbol_name (tail), | 2060 | tem = obj; |
| 2090 | make_fixnum (0) , Qnil, Qt), | 2061 | break; |
| 2091 | Qt)) | 2062 | } |
| 2092 | { | 2063 | } |
| 2093 | tem = tail; | ||
| 2094 | break; | ||
| 2095 | } | ||
| 2096 | if (XSYMBOL (tail)->u.s.next == 0) | ||
| 2097 | break; | ||
| 2098 | XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next); | ||
| 2099 | } | ||
| 2100 | } | ||
| 2101 | } | ||
| 2102 | 2064 | ||
| 2103 | if (!SYMBOLP (tem)) | 2065 | if (!BARE_SYMBOL_P (tem)) |
| 2104 | return Qnil; | 2066 | return Qnil; |
| 2105 | } | 2067 | } |
| 2106 | else if (HASH_TABLE_P (collection)) | 2068 | else if (HASH_TABLE_P (collection)) |
diff --git a/src/pdumper.c b/src/pdumper.c index ee554cda55a..f0bce09cbde 100644 --- a/src/pdumper.c +++ b/src/pdumper.c | |||
| @@ -2688,7 +2688,7 @@ hash_table_freeze (struct Lisp_Hash_Table *h) | |||
| 2688 | h->hash = NULL; | 2688 | h->hash = NULL; |
| 2689 | h->index = NULL; | 2689 | h->index = NULL; |
| 2690 | h->table_size = 0; | 2690 | h->table_size = 0; |
| 2691 | h->index_size = 0; | 2691 | h->index_bits = 0; |
| 2692 | h->frozen_test = hash_table_std_test (h->test); | 2692 | h->frozen_test = hash_table_std_test (h->test); |
| 2693 | h->test = NULL; | 2693 | h->test = NULL; |
| 2694 | } | 2694 | } |
| @@ -2719,7 +2719,7 @@ dump_hash_table_contents (struct dump_context *ctx, struct Lisp_Hash_Table *h) | |||
| 2719 | static dump_off | 2719 | static dump_off |
| 2720 | dump_hash_table (struct dump_context *ctx, Lisp_Object object) | 2720 | dump_hash_table (struct dump_context *ctx, Lisp_Object object) |
| 2721 | { | 2721 | { |
| 2722 | #if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_313A489F0A | 2722 | #if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_0360833954 |
| 2723 | # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." | 2723 | # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." |
| 2724 | #endif | 2724 | #endif |
| 2725 | const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); | 2725 | const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); |
| @@ -2749,6 +2749,51 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) | |||
| 2749 | } | 2749 | } |
| 2750 | 2750 | ||
| 2751 | static dump_off | 2751 | static dump_off |
| 2752 | dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o) | ||
| 2753 | { | ||
| 2754 | dump_align_output (ctx, DUMP_ALIGNMENT); | ||
| 2755 | dump_off start_offset = ctx->offset; | ||
| 2756 | ptrdiff_t n = obarray_size (o); | ||
| 2757 | |||
| 2758 | struct dump_flags old_flags = ctx->flags; | ||
| 2759 | ctx->flags.pack_objects = true; | ||
| 2760 | |||
| 2761 | for (ptrdiff_t i = 0; i < n; i++) | ||
| 2762 | { | ||
| 2763 | Lisp_Object out; | ||
| 2764 | const Lisp_Object *slot = &o->buckets[i]; | ||
| 2765 | dump_object_start (ctx, &out, sizeof out); | ||
| 2766 | dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG); | ||
| 2767 | dump_object_finish (ctx, &out, sizeof out); | ||
| 2768 | } | ||
| 2769 | |||
| 2770 | ctx->flags = old_flags; | ||
| 2771 | return start_offset; | ||
| 2772 | } | ||
| 2773 | |||
| 2774 | static dump_off | ||
| 2775 | dump_obarray (struct dump_context *ctx, Lisp_Object object) | ||
| 2776 | { | ||
| 2777 | #if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_D2757E61AD | ||
| 2778 | # error "Lisp_Obarray changed. See CHECK_STRUCTS comment in config.h." | ||
| 2779 | #endif | ||
| 2780 | const struct Lisp_Obarray *in_oa = XOBARRAY (object); | ||
| 2781 | struct Lisp_Obarray munged_oa = *in_oa; | ||
| 2782 | struct Lisp_Obarray *oa = &munged_oa; | ||
| 2783 | START_DUMP_PVEC (ctx, &oa->header, struct Lisp_Obarray, out); | ||
| 2784 | dump_pseudovector_lisp_fields (ctx, &out->header, &oa->header); | ||
| 2785 | DUMP_FIELD_COPY (out, oa, count); | ||
| 2786 | DUMP_FIELD_COPY (out, oa, size_bits); | ||
| 2787 | dump_field_fixup_later (ctx, out, oa, &oa->buckets); | ||
| 2788 | dump_off offset = finish_dump_pvec (ctx, &out->header); | ||
| 2789 | dump_remember_fixup_ptr_raw | ||
| 2790 | (ctx, | ||
| 2791 | offset + dump_offsetof (struct Lisp_Obarray, buckets), | ||
| 2792 | dump_obarray_buckets (ctx, oa)); | ||
| 2793 | return offset; | ||
| 2794 | } | ||
| 2795 | |||
| 2796 | static dump_off | ||
| 2752 | dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) | 2797 | dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) |
| 2753 | { | 2798 | { |
| 2754 | #if CHECK_STRUCTS && !defined HASH_buffer_EBBA38AEFA | 2799 | #if CHECK_STRUCTS && !defined HASH_buffer_EBBA38AEFA |
| @@ -2912,17 +2957,17 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) | |||
| 2912 | dump_object_start (ctx, &out, sizeof (out)); | 2957 | dump_object_start (ctx, &out, sizeof (out)); |
| 2913 | DUMP_FIELD_COPY (&out, subr, header.size); | 2958 | DUMP_FIELD_COPY (&out, subr, header.size); |
| 2914 | #ifdef HAVE_NATIVE_COMP | 2959 | #ifdef HAVE_NATIVE_COMP |
| 2915 | bool native_comp = !NILP (subr->native_comp_u); | 2960 | bool non_primitive = !NILP (subr->native_comp_u); |
| 2916 | #else | 2961 | #else |
| 2917 | bool native_comp = false; | 2962 | bool non_primitive = false; |
| 2918 | #endif | 2963 | #endif |
| 2919 | if (native_comp) | 2964 | if (non_primitive) |
| 2920 | out.function.a0 = NULL; | 2965 | out.function.a0 = NULL; |
| 2921 | else | 2966 | else |
| 2922 | dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0); | 2967 | dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0); |
| 2923 | DUMP_FIELD_COPY (&out, subr, min_args); | 2968 | DUMP_FIELD_COPY (&out, subr, min_args); |
| 2924 | DUMP_FIELD_COPY (&out, subr, max_args); | 2969 | DUMP_FIELD_COPY (&out, subr, max_args); |
| 2925 | if (native_comp) | 2970 | if (non_primitive) |
| 2926 | { | 2971 | { |
| 2927 | dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name); | 2972 | dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name); |
| 2928 | dump_remember_cold_op (ctx, | 2973 | dump_remember_cold_op (ctx, |
| @@ -2947,7 +2992,7 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) | |||
| 2947 | dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL); | 2992 | dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL); |
| 2948 | #endif | 2993 | #endif |
| 2949 | dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out)); | 2994 | dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out)); |
| 2950 | if (native_comp && ctx->flags.dump_object_contents) | 2995 | if (non_primitive && ctx->flags.dump_object_contents) |
| 2951 | /* We'll do the final addr relocation during VERY_LATE_RELOCS time | 2996 | /* We'll do the final addr relocation during VERY_LATE_RELOCS time |
| 2952 | after the compilation units has been loaded. */ | 2997 | after the compilation units has been loaded. */ |
| 2953 | dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS], | 2998 | dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS], |
| @@ -3004,7 +3049,7 @@ dump_vectorlike (struct dump_context *ctx, | |||
| 3004 | Lisp_Object lv, | 3049 | Lisp_Object lv, |
| 3005 | dump_off offset) | 3050 | dump_off offset) |
| 3006 | { | 3051 | { |
| 3007 | #if CHECK_STRUCTS && !defined HASH_pvec_type_D8A254BC70 | 3052 | #if CHECK_STRUCTS && !defined HASH_pvec_type_2D583AC566 |
| 3008 | # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." | 3053 | # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." |
| 3009 | #endif | 3054 | #endif |
| 3010 | const struct Lisp_Vector *v = XVECTOR (lv); | 3055 | const struct Lisp_Vector *v = XVECTOR (lv); |
| @@ -3031,6 +3076,8 @@ dump_vectorlike (struct dump_context *ctx, | |||
| 3031 | return dump_bool_vector(ctx, v); | 3076 | return dump_bool_vector(ctx, v); |
| 3032 | case PVEC_HASH_TABLE: | 3077 | case PVEC_HASH_TABLE: |
| 3033 | return dump_hash_table (ctx, lv); | 3078 | return dump_hash_table (ctx, lv); |
| 3079 | case PVEC_OBARRAY: | ||
| 3080 | return dump_obarray (ctx, lv); | ||
| 3034 | case PVEC_BUFFER: | 3081 | case PVEC_BUFFER: |
| 3035 | return dump_buffer (ctx, XBUFFER (lv)); | 3082 | return dump_buffer (ctx, XBUFFER (lv)); |
| 3036 | case PVEC_SUBR: | 3083 | case PVEC_SUBR: |
| @@ -5593,10 +5640,7 @@ pdumper_load (const char *dump_filename, char *argv0) | |||
| 5593 | 5640 | ||
| 5594 | struct dump_header header_buf = { 0 }; | 5641 | struct dump_header header_buf = { 0 }; |
| 5595 | struct dump_header *header = &header_buf; | 5642 | struct dump_header *header = &header_buf; |
| 5596 | struct dump_memory_map sections[NUMBER_DUMP_SECTIONS]; | 5643 | struct dump_memory_map sections[NUMBER_DUMP_SECTIONS] = { 0 }; |
| 5597 | |||
| 5598 | /* Use memset instead of "= { 0 }" to work around GCC bug 105961. */ | ||
| 5599 | memset (sections, 0, sizeof sections); | ||
| 5600 | 5644 | ||
| 5601 | const struct timespec start_time = current_timespec (); | 5645 | const struct timespec start_time = current_timespec (); |
| 5602 | char *dump_filename_copy; | 5646 | char *dump_filename_copy; |
diff --git a/src/pgtkterm.c b/src/pgtkterm.c index b731f52983d..1ec6bfcda4e 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c | |||
| @@ -5825,8 +5825,8 @@ note_mouse_movement (struct frame *frame, | |||
| 5825 | /* Has the mouse moved off the glyph it was on at the last sighting? */ | 5825 | /* Has the mouse moved off the glyph it was on at the last sighting? */ |
| 5826 | r = &dpyinfo->last_mouse_glyph; | 5826 | r = &dpyinfo->last_mouse_glyph; |
| 5827 | if (frame != dpyinfo->last_mouse_glyph_frame | 5827 | if (frame != dpyinfo->last_mouse_glyph_frame |
| 5828 | || event->x < r->x || event->x >= r->x + r->width | 5828 | || event->x < r->x || event->x >= r->x + (int) r->width |
| 5829 | || event->y < r->y || event->y >= r->y + r->height) | 5829 | || event->y < r->y || event->y >= r->y + (int) r->height) |
| 5830 | { | 5830 | { |
| 5831 | frame->mouse_moved = true; | 5831 | frame->mouse_moved = true; |
| 5832 | dpyinfo->last_mouse_scroll_bar = NULL; | 5832 | dpyinfo->last_mouse_scroll_bar = NULL; |
diff --git a/src/print.c b/src/print.c index c6a3dba3163..76c577ec800 100644 --- a/src/print.c +++ b/src/print.c | |||
| @@ -1412,7 +1412,7 @@ print_preprocess (Lisp_Object obj) | |||
| 1412 | && SYMBOLP (obj) | 1412 | && SYMBOLP (obj) |
| 1413 | && !SYMBOL_INTERNED_P (obj))) | 1413 | && !SYMBOL_INTERNED_P (obj))) |
| 1414 | { /* OBJ appears more than once. Let's remember that. */ | 1414 | { /* OBJ appears more than once. Let's remember that. */ |
| 1415 | if (!FIXNUMP (num)) | 1415 | if (SYMBOLP (num)) /* In practice, nil or t. */ |
| 1416 | { | 1416 | { |
| 1417 | print_number_index++; | 1417 | print_number_index++; |
| 1418 | /* Negative number indicates it hasn't been printed yet. */ | 1418 | /* Negative number indicates it hasn't been printed yet. */ |
| @@ -2078,6 +2078,16 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun, | |||
| 2078 | } | 2078 | } |
| 2079 | return; | 2079 | return; |
| 2080 | 2080 | ||
| 2081 | case PVEC_OBARRAY: | ||
| 2082 | { | ||
| 2083 | struct Lisp_Obarray *o = XOBARRAY (obj); | ||
| 2084 | /* FIXME: Would it make sense to print the actual symbols (up to | ||
| 2085 | a limit)? */ | ||
| 2086 | int i = sprintf (buf, "#<obarray n=%u>", o->count); | ||
| 2087 | strout (buf, i, i, printcharfun); | ||
| 2088 | return; | ||
| 2089 | } | ||
| 2090 | |||
| 2081 | /* Types handled earlier. */ | 2091 | /* Types handled earlier. */ |
| 2082 | case PVEC_NORMAL_VECTOR: | 2092 | case PVEC_NORMAL_VECTOR: |
| 2083 | case PVEC_RECORD: | 2093 | case PVEC_RECORD: |
| @@ -2265,6 +2275,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) | |||
| 2265 | goto next_obj; | 2275 | goto next_obj; |
| 2266 | } | 2276 | } |
| 2267 | } | 2277 | } |
| 2278 | else if (STRINGP (num)) | ||
| 2279 | { | ||
| 2280 | strout (SSDATA (num), SCHARS (num), SBYTES (num), printcharfun); | ||
| 2281 | goto next_obj; | ||
| 2282 | } | ||
| 2268 | } | 2283 | } |
| 2269 | 2284 | ||
| 2270 | print_depth++; | 2285 | print_depth++; |
| @@ -2554,11 +2569,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) | |||
| 2554 | goto next_obj; | 2569 | goto next_obj; |
| 2555 | case PVEC_SUB_CHAR_TABLE: | 2570 | case PVEC_SUB_CHAR_TABLE: |
| 2556 | { | 2571 | { |
| 2557 | /* Make each lowest sub_char_table start a new line. | ||
| 2558 | Otherwise we'll make a line extremely long, which | ||
| 2559 | results in slow redisplay. */ | ||
| 2560 | if (XSUB_CHAR_TABLE (obj)->depth == 3) | ||
| 2561 | printchar ('\n', printcharfun); | ||
| 2562 | print_c_string ("#^^[", printcharfun); | 2572 | print_c_string ("#^^[", printcharfun); |
| 2563 | int n = sprintf (buf, "%d %d", | 2573 | int n = sprintf (buf, "%d %d", |
| 2564 | XSUB_CHAR_TABLE (obj)->depth, | 2574 | XSUB_CHAR_TABLE (obj)->depth, |
| @@ -2664,7 +2674,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) | |||
| 2664 | /* With the print-circle feature. */ | 2674 | /* With the print-circle feature. */ |
| 2665 | Lisp_Object num = Fgethash (next, Vprint_number_table, | 2675 | Lisp_Object num = Fgethash (next, Vprint_number_table, |
| 2666 | Qnil); | 2676 | Qnil); |
| 2667 | if (FIXNUMP (num)) | 2677 | if (!(NILP (num) || EQ (num, Qt))) |
| 2668 | { | 2678 | { |
| 2669 | print_c_string (" . ", printcharfun); | 2679 | print_c_string (" . ", printcharfun); |
| 2670 | obj = next; | 2680 | obj = next; |
| @@ -2928,7 +2938,10 @@ This variable should not be set with `setq'; bind it with a `let' instead. */); | |||
| 2928 | DEFVAR_LISP ("print-number-table", Vprint_number_table, | 2938 | DEFVAR_LISP ("print-number-table", Vprint_number_table, |
| 2929 | doc: /* A vector used internally to produce `#N=' labels and `#N#' references. | 2939 | doc: /* A vector used internally to produce `#N=' labels and `#N#' references. |
| 2930 | The Lisp printer uses this vector to detect Lisp objects referenced more | 2940 | The Lisp printer uses this vector to detect Lisp objects referenced more |
| 2931 | than once. | 2941 | than once. If an entry contains a number, then the corresponding key is |
| 2942 | referenced more than once: a positive sign indicates that it's already been | ||
| 2943 | printed, and the absolute value indicates the number to use when printing. | ||
| 2944 | If an entry contains a string, that string is printed instead. | ||
| 2932 | 2945 | ||
| 2933 | When you bind `print-continuous-numbering' to t, you should probably | 2946 | When you bind `print-continuous-numbering' to t, you should probably |
| 2934 | also bind `print-number-table' to nil. This ensures that the value of | 2947 | also bind `print-number-table' to nil. This ensures that the value of |
diff --git a/src/process.c b/src/process.c index ddab9ed6c01..48a2c0c8e53 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -5209,6 +5209,27 @@ wait_reading_process_output_1 (void) | |||
| 5209 | { | 5209 | { |
| 5210 | } | 5210 | } |
| 5211 | 5211 | ||
| 5212 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY \ | ||
| 5213 | && defined THREADS_ENABLED | ||
| 5214 | |||
| 5215 | /* Wrapper around `android_select' that exposes a calling interface with | ||
| 5216 | an extra argument for compatibility with `thread_pselect'. */ | ||
| 5217 | |||
| 5218 | static int | ||
| 5219 | android_select_wrapper (int nfds, fd_set *readfds, fd_set *writefds, | ||
| 5220 | fd_set *exceptfds, const struct timespec *timeout, | ||
| 5221 | const sigset_t *sigmask) | ||
| 5222 | { | ||
| 5223 | /* sigmask is not supported. */ | ||
| 5224 | if (sigmask) | ||
| 5225 | emacs_abort (); | ||
| 5226 | |||
| 5227 | return android_select (nfds, readfds, writefds, exceptfds, | ||
| 5228 | (struct timespec *) timeout); | ||
| 5229 | } | ||
| 5230 | |||
| 5231 | #endif /* HAVE_ANDROID && !ANDROID_STUBIFY && THREADS_ENABLED */ | ||
| 5232 | |||
| 5212 | /* Read and dispose of subprocess output while waiting for timeout to | 5233 | /* Read and dispose of subprocess output while waiting for timeout to |
| 5213 | elapse and/or keyboard input to be available. | 5234 | elapse and/or keyboard input to be available. |
| 5214 | 5235 | ||
| @@ -5701,13 +5722,19 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, | |||
| 5701 | timeout = short_timeout; | 5722 | timeout = short_timeout; |
| 5702 | #endif | 5723 | #endif |
| 5703 | 5724 | ||
| 5704 | /* Android doesn't support threads and requires using a | 5725 | /* Android requires using a replacement for pselect in |
| 5705 | replacement for pselect in android.c to poll for | 5726 | android.c to poll for events. */ |
| 5706 | events. */ | ||
| 5707 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY | 5727 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY |
| 5728 | #ifndef THREADS_ENABLED | ||
| 5708 | nfds = android_select (max_desc + 1, | 5729 | nfds = android_select (max_desc + 1, |
| 5709 | &Available, (check_write ? &Writeok : 0), | 5730 | &Available, (check_write ? &Writeok : 0), |
| 5710 | NULL, &timeout); | 5731 | NULL, &timeout); |
| 5732 | #else /* THREADS_ENABLED */ | ||
| 5733 | nfds = thread_select (android_select_wrapper, | ||
| 5734 | max_desc + 1, | ||
| 5735 | &Available, (check_write ? &Writeok : 0), | ||
| 5736 | NULL, &timeout, NULL); | ||
| 5737 | #endif /* THREADS_ENABLED */ | ||
| 5711 | #else | 5738 | #else |
| 5712 | 5739 | ||
| 5713 | /* Non-macOS HAVE_GLIB builds call thread_select in | 5740 | /* Non-macOS HAVE_GLIB builds call thread_select in |
diff --git a/src/sfnt.c b/src/sfnt.c index 6df43af4293..8598b052044 100644 --- a/src/sfnt.c +++ b/src/sfnt.c | |||
| @@ -2798,12 +2798,6 @@ sfnt_decompose_compound_glyph (struct sfnt_glyph *glyph, | |||
| 2798 | if (component->flags & 04000) /* SCALED_COMPONENT_OFFSET */ | 2798 | if (component->flags & 04000) /* SCALED_COMPONENT_OFFSET */ |
| 2799 | sfnt_transform_coordinates (component, &x, &y, 1, | 2799 | sfnt_transform_coordinates (component, &x, &y, 1, |
| 2800 | 0, 0); | 2800 | 0, 0); |
| 2801 | |||
| 2802 | if (component->flags & 04) /* ROUND_XY_TO_GRID */ | ||
| 2803 | { | ||
| 2804 | x = sfnt_round_fixed (x); | ||
| 2805 | y = sfnt_round_fixed (y); | ||
| 2806 | } | ||
| 2807 | } | 2801 | } |
| 2808 | else | 2802 | else |
| 2809 | { | 2803 | { |
| @@ -20800,8 +20794,8 @@ main (int argc, char **argv) | |||
| 20800 | return 1; | 20794 | return 1; |
| 20801 | } | 20795 | } |
| 20802 | 20796 | ||
| 20803 | #define FANCY_PPEM 12 | 20797 | #define FANCY_PPEM 18 |
| 20804 | #define EASY_PPEM 12 | 20798 | #define EASY_PPEM 18 |
| 20805 | 20799 | ||
| 20806 | interpreter = NULL; | 20800 | interpreter = NULL; |
| 20807 | head = sfnt_read_head_table (fd, font); | 20801 | head = sfnt_read_head_table (fd, font); |
diff --git a/src/sfnt.h b/src/sfnt.h index 5b01270e8ce..444b1dfe427 100644 --- a/src/sfnt.h +++ b/src/sfnt.h | |||
| @@ -248,7 +248,7 @@ enum sfnt_macintosh_platform_specific_id | |||
| 248 | SFNT_MACINTOSH_GREEK = 6, | 248 | SFNT_MACINTOSH_GREEK = 6, |
| 249 | SFNT_MACINTOSH_RUSSIAN = 7, | 249 | SFNT_MACINTOSH_RUSSIAN = 7, |
| 250 | SFNT_MACINTOSH_RSYMBOL = 8, | 250 | SFNT_MACINTOSH_RSYMBOL = 8, |
| 251 | SFNT_MACINTOSH_DEVANGARI = 9, | 251 | SFNT_MACINTOSH_DEVANAGARI = 9, |
| 252 | SFNT_MACINTOSH_GURMUKHI = 10, | 252 | SFNT_MACINTOSH_GURMUKHI = 10, |
| 253 | SFNT_MACINTOSH_GUJARATI = 11, | 253 | SFNT_MACINTOSH_GUJARATI = 11, |
| 254 | SFNT_MACINTOSH_ORIYA = 12, | 254 | SFNT_MACINTOSH_ORIYA = 12, |
diff --git a/src/sfntfont.c b/src/sfntfont.c index 860fc446184..3be770f650e 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c | |||
| @@ -3308,7 +3308,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, | |||
| 3308 | ASET (font_object, FONT_TYPE_INDEX, sfnt_vendor_name); | 3308 | ASET (font_object, FONT_TYPE_INDEX, sfnt_vendor_name); |
| 3309 | ASET (font_object, FONT_FOUNDRY_INDEX, desc->designer); | 3309 | ASET (font_object, FONT_FOUNDRY_INDEX, desc->designer); |
| 3310 | ASET (font_object, FONT_FAMILY_INDEX, Fintern (desc->family, Qnil)); | 3310 | ASET (font_object, FONT_FAMILY_INDEX, Fintern (desc->family, Qnil)); |
| 3311 | ASET (font_object, FONT_ADSTYLE_INDEX, Qnil); | 3311 | ASET (font_object, FONT_ADSTYLE_INDEX, desc->adstyle); |
| 3312 | ASET (font_object, FONT_REGISTRY_INDEX, | 3312 | ASET (font_object, FONT_REGISTRY_INDEX, |
| 3313 | sfntfont_registry_for_desc (desc)); | 3313 | sfntfont_registry_for_desc (desc)); |
| 3314 | 3314 | ||
| @@ -3326,8 +3326,6 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, | |||
| 3326 | FONT_SET_STYLE (font_object, FONT_SLANT_INDEX, | 3326 | FONT_SET_STYLE (font_object, FONT_SLANT_INDEX, |
| 3327 | make_fixnum (desc->slant)); | 3327 | make_fixnum (desc->slant)); |
| 3328 | 3328 | ||
| 3329 | ASET (font_object, FONT_ADSTYLE_INDEX, Qnil); | ||
| 3330 | |||
| 3331 | /* Clear various offsets. */ | 3329 | /* Clear various offsets. */ |
| 3332 | font_info->font.baseline_offset = 0; | 3330 | font_info->font.baseline_offset = 0; |
| 3333 | font_info->font.relative_compose = 0; | 3331 | font_info->font.relative_compose = 0; |
| @@ -3412,7 +3410,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, | |||
| 3412 | AREF (tem, 3)); | 3410 | AREF (tem, 3)); |
| 3413 | FONT_SET_STYLE (font_object, FONT_SLANT_INDEX, | 3411 | FONT_SET_STYLE (font_object, FONT_SLANT_INDEX, |
| 3414 | AREF (tem, 4)); | 3412 | AREF (tem, 4)); |
| 3415 | ASET (font_object, FONT_ADSTYLE_INDEX, Qnil); | 3413 | ASET (font_object, FONT_ADSTYLE_INDEX, AREF (tem, 1)); |
| 3416 | } | 3414 | } |
| 3417 | } | 3415 | } |
| 3418 | 3416 | ||
diff --git a/src/term.c b/src/term.c index 447876d288a..3fa244be824 100644 --- a/src/term.c +++ b/src/term.c | |||
| @@ -1631,8 +1631,19 @@ produce_glyphs (struct it *it) | |||
| 1631 | it->pixel_width = it->nglyphs = 0; | 1631 | it->pixel_width = it->nglyphs = 0; |
| 1632 | else if (it->char_to_display == '\t') | 1632 | else if (it->char_to_display == '\t') |
| 1633 | { | 1633 | { |
| 1634 | /* wrap-prefix strings are prepended to continuation lines, so | ||
| 1635 | the width of tab characters inside should be computed from | ||
| 1636 | the start of this screen line rather than as a product of the | ||
| 1637 | total width of the physical line being wrapped. */ | ||
| 1634 | int absolute_x = (it->current_x | 1638 | int absolute_x = (it->current_x |
| 1635 | + it->continuation_lines_width); | 1639 | + (it->string_from_prefix_prop_p |
| 1640 | /* Subtract the width of the | ||
| 1641 | prefix from it->current_x if | ||
| 1642 | it exists. */ | ||
| 1643 | ? 0 : (it->continuation_lines_width | ||
| 1644 | ? (it->continuation_lines_width | ||
| 1645 | - it->wrap_prefix_width) | ||
| 1646 | : 0))); | ||
| 1636 | int x0 = absolute_x; | 1647 | int x0 = absolute_x; |
| 1637 | /* Adjust for line numbers. */ | 1648 | /* Adjust for line numbers. */ |
| 1638 | if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p) | 1649 | if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p) |
| @@ -1704,7 +1715,13 @@ produce_glyphs (struct it *it) | |||
| 1704 | /* Advance current_x by the pixel width as a convenience for | 1715 | /* Advance current_x by the pixel width as a convenience for |
| 1705 | the caller. */ | 1716 | the caller. */ |
| 1706 | if (it->area == TEXT_AREA) | 1717 | if (it->area == TEXT_AREA) |
| 1707 | it->current_x += it->pixel_width; | 1718 | { |
| 1719 | it->current_x += it->pixel_width; | ||
| 1720 | |||
| 1721 | if (it->continuation_lines_width | ||
| 1722 | && it->string_from_prefix_prop_p) | ||
| 1723 | it->wrap_prefix_width = it->current_x; | ||
| 1724 | } | ||
| 1708 | it->ascent = it->max_ascent = it->phys_ascent = it->max_phys_ascent = 0; | 1725 | it->ascent = it->max_ascent = it->phys_ascent = it->max_phys_ascent = 0; |
| 1709 | it->descent = it->max_descent = it->phys_descent = it->max_phys_descent = 1; | 1726 | it->descent = it->max_descent = it->phys_descent = it->max_phys_descent = 1; |
| 1710 | #endif | 1727 | #endif |
diff --git a/src/textconv.c b/src/textconv.c index 0d35ec19c55..0941848dd09 100644 --- a/src/textconv.c +++ b/src/textconv.c | |||
| @@ -1705,11 +1705,8 @@ set_composing_region (struct frame *f, ptrdiff_t start, | |||
| 1705 | { | 1705 | { |
| 1706 | struct text_conversion_action *action, **last; | 1706 | struct text_conversion_action *action, **last; |
| 1707 | 1707 | ||
| 1708 | if (start > MOST_POSITIVE_FIXNUM) | 1708 | start = min (start, MOST_POSITIVE_FIXNUM); |
| 1709 | start = MOST_POSITIVE_FIXNUM; | 1709 | end = min (end, MOST_POSITIVE_FIXNUM); |
| 1710 | |||
| 1711 | if (end > MOST_POSITIVE_FIXNUM) | ||
| 1712 | end = MOST_POSITIVE_FIXNUM; | ||
| 1713 | 1710 | ||
| 1714 | action = xmalloc (sizeof *action); | 1711 | action = xmalloc (sizeof *action); |
| 1715 | action->operation = TEXTCONV_SET_COMPOSING_REGION; | 1712 | action->operation = TEXTCONV_SET_COMPOSING_REGION; |
| @@ -1734,8 +1731,7 @@ textconv_set_point_and_mark (struct frame *f, ptrdiff_t point, | |||
| 1734 | { | 1731 | { |
| 1735 | struct text_conversion_action *action, **last; | 1732 | struct text_conversion_action *action, **last; |
| 1736 | 1733 | ||
| 1737 | if (point > MOST_POSITIVE_FIXNUM) | 1734 | point = min (point, MOST_POSITIVE_FIXNUM); |
| 1738 | point = MOST_POSITIVE_FIXNUM; | ||
| 1739 | 1735 | ||
| 1740 | action = xmalloc (sizeof *action); | 1736 | action = xmalloc (sizeof *action); |
| 1741 | action->operation = TEXTCONV_SET_POINT_AND_MARK; | 1737 | action->operation = TEXTCONV_SET_POINT_AND_MARK; |
diff --git a/src/thread.c b/src/thread.c index 040ca39511e..2f5d7a08838 100644 --- a/src/thread.c +++ b/src/thread.c | |||
| @@ -106,6 +106,12 @@ post_acquire_global_lock (struct thread_state *self) | |||
| 106 | { | 106 | { |
| 107 | struct thread_state *prev_thread = current_thread; | 107 | struct thread_state *prev_thread = current_thread; |
| 108 | 108 | ||
| 109 | /* Switch the JNI interface pointer to the environment assigned to the | ||
| 110 | current thread. */ | ||
| 111 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY | ||
| 112 | android_java_env = self->java_env; | ||
| 113 | #endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ | ||
| 114 | |||
| 109 | /* Do this early on, so that code below could signal errors (e.g., | 115 | /* Do this early on, so that code below could signal errors (e.g., |
| 110 | unbind_for_thread_switch might) correctly, because we are already | 116 | unbind_for_thread_switch might) correctly, because we are already |
| 111 | running in the context of the thread pointed by SELF. */ | 117 | running in the context of the thread pointed by SELF. */ |
| @@ -126,6 +132,12 @@ post_acquire_global_lock (struct thread_state *self) | |||
| 126 | set_buffer_internal_2 (current_buffer); | 132 | set_buffer_internal_2 (current_buffer); |
| 127 | } | 133 | } |
| 128 | 134 | ||
| 135 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY | ||
| 136 | /* This step is performed in android_select when built without | ||
| 137 | threads. */ | ||
| 138 | android_check_query (); | ||
| 139 | #endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ | ||
| 140 | |||
| 129 | /* We could have been signaled while waiting to grab the global lock | 141 | /* We could have been signaled while waiting to grab the global lock |
| 130 | for the first time since this thread was created, in which case | 142 | for the first time since this thread was created, in which case |
| 131 | we didn't yet have the opportunity to set up the handlers. Delay | 143 | we didn't yet have the opportunity to set up the handlers. Delay |
| @@ -756,6 +768,11 @@ run_thread (void *state) | |||
| 756 | 768 | ||
| 757 | struct thread_state *self = state; | 769 | struct thread_state *self = state; |
| 758 | struct thread_state **iter; | 770 | struct thread_state **iter; |
| 771 | #ifdef THREADS_ENABLED | ||
| 772 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY | ||
| 773 | jint rc; | ||
| 774 | #endif /* #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ | ||
| 775 | #endif /* THREADS_ENABLED */ | ||
| 759 | 776 | ||
| 760 | #ifdef HAVE_NS | 777 | #ifdef HAVE_NS |
| 761 | /* Allocate an autorelease pool in case this thread calls any | 778 | /* Allocate an autorelease pool in case this thread calls any |
| @@ -766,6 +783,16 @@ run_thread (void *state) | |||
| 766 | void *pool = ns_alloc_autorelease_pool (); | 783 | void *pool = ns_alloc_autorelease_pool (); |
| 767 | #endif | 784 | #endif |
| 768 | 785 | ||
| 786 | #ifdef THREADS_ENABLED | ||
| 787 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY | ||
| 788 | rc | ||
| 789 | = (*android_jvm)->AttachCurrentThread (android_jvm, &self->java_env, | ||
| 790 | NULL); | ||
| 791 | if (rc != JNI_OK) | ||
| 792 | emacs_abort (); | ||
| 793 | #endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ | ||
| 794 | #endif /* THREADS_ENABLED */ | ||
| 795 | |||
| 769 | self->m_stack_bottom = self->stack_top = &stack_pos.c; | 796 | self->m_stack_bottom = self->stack_top = &stack_pos.c; |
| 770 | self->thread_id = sys_thread_self (); | 797 | self->thread_id = sys_thread_self (); |
| 771 | 798 | ||
| @@ -812,6 +839,14 @@ run_thread (void *state) | |||
| 812 | ns_release_autorelease_pool (pool); | 839 | ns_release_autorelease_pool (pool); |
| 813 | #endif | 840 | #endif |
| 814 | 841 | ||
| 842 | #ifdef THREADS_ENABLED | ||
| 843 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY | ||
| 844 | rc = (*android_jvm)->DetachCurrentThread (android_jvm); | ||
| 845 | if (rc != JNI_OK) | ||
| 846 | emacs_abort (); | ||
| 847 | #endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ | ||
| 848 | #endif /* THREADS_ENABLED */ | ||
| 849 | |||
| 815 | /* Unlink this thread from the list of all threads. Note that we | 850 | /* Unlink this thread from the list of all threads. Note that we |
| 816 | have to do this very late, after broadcasting our death. | 851 | have to do this very late, after broadcasting our death. |
| 817 | Otherwise the GC may decide to reap the thread_state object, | 852 | Otherwise the GC may decide to reap the thread_state object, |
| @@ -1131,6 +1166,10 @@ init_threads (void) | |||
| 1131 | sys_mutex_init (&global_lock); | 1166 | sys_mutex_init (&global_lock); |
| 1132 | sys_mutex_lock (&global_lock); | 1167 | sys_mutex_lock (&global_lock); |
| 1133 | current_thread = &main_thread.s; | 1168 | current_thread = &main_thread.s; |
| 1169 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY | ||
| 1170 | current_thread->java_env = android_java_env; | ||
| 1171 | #endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ | ||
| 1172 | |||
| 1134 | main_thread.s.thread_id = sys_thread_self (); | 1173 | main_thread.s.thread_id = sys_thread_self (); |
| 1135 | init_bc_thread (&main_thread.s.bc); | 1174 | init_bc_thread (&main_thread.s.bc); |
| 1136 | } | 1175 | } |
diff --git a/src/thread.h b/src/thread.h index 6ce2b7f30df..1844cf03967 100644 --- a/src/thread.h +++ b/src/thread.h | |||
| @@ -30,6 +30,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 30 | #include <signal.h> /* sigset_t */ | 30 | #include <signal.h> /* sigset_t */ |
| 31 | #endif | 31 | #endif |
| 32 | 32 | ||
| 33 | #ifdef HAVE_ANDROID | ||
| 34 | #ifndef ANDROID_STUBIFY | ||
| 35 | #include "android.h" | ||
| 36 | #endif /* ANDROID_STUBIFY */ | ||
| 37 | #endif /* HAVE_ANDROID */ | ||
| 38 | |||
| 33 | #include "sysselect.h" /* FIXME */ | 39 | #include "sysselect.h" /* FIXME */ |
| 34 | #include "systhread.h" | 40 | #include "systhread.h" |
| 35 | 41 | ||
| @@ -84,6 +90,11 @@ struct thread_state | |||
| 84 | Lisp_Object event_object; | 90 | Lisp_Object event_object; |
| 85 | /* event_object must be the last Lisp field. */ | 91 | /* event_object must be the last Lisp field. */ |
| 86 | 92 | ||
| 93 | #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY | ||
| 94 | /* Pointer to an object to call Java functions through. */ | ||
| 95 | JNIEnv *java_env; | ||
| 96 | #endif /* HAVE_ANDROID && !ANDROID_STUBIFY */ | ||
| 97 | |||
| 87 | /* An address near the bottom of the stack. | 98 | /* An address near the bottom of the stack. |
| 88 | Tells GC how to save a copy of the stack. */ | 99 | Tells GC how to save a copy of the stack. */ |
| 89 | char const *m_stack_bottom; | 100 | char const *m_stack_bottom; |
diff --git a/src/timefns.c b/src/timefns.c index 1541583b485..0ecbb6e6793 100644 --- a/src/timefns.c +++ b/src/timefns.c | |||
| @@ -225,7 +225,7 @@ tzlookup (Lisp_Object zone, bool settz) | |||
| 225 | 225 | ||
| 226 | if (NILP (zone)) | 226 | if (NILP (zone)) |
| 227 | return local_tz; | 227 | return local_tz; |
| 228 | else if (BASE_EQ (zone, make_fixnum (0)) || BASE2_EQ (zone, Qt)) | 228 | else if (BASE_EQ (zone, make_fixnum (0)) || EQ (zone, Qt)) |
| 229 | { | 229 | { |
| 230 | zone_string = "UTC0"; | 230 | zone_string = "UTC0"; |
| 231 | new_tz = utc_tz; | 231 | new_tz = utc_tz; |
| @@ -234,7 +234,7 @@ tzlookup (Lisp_Object zone, bool settz) | |||
| 234 | { | 234 | { |
| 235 | bool plain_integer = FIXNUMP (zone); | 235 | bool plain_integer = FIXNUMP (zone); |
| 236 | 236 | ||
| 237 | if (BASE2_EQ (zone, Qwall)) | 237 | if (EQ (zone, Qwall)) |
| 238 | zone_string = 0; | 238 | zone_string = 0; |
| 239 | else if (STRINGP (zone)) | 239 | else if (STRINGP (zone)) |
| 240 | zone_string = SSDATA (ENCODE_SYSTEM (zone)); | 240 | zone_string = SSDATA (ENCODE_SYSTEM (zone)); |
| @@ -1548,7 +1548,7 @@ usage: (decode-time &optional TIME ZONE FORM) */) | |||
| 1548 | 1548 | ||
| 1549 | /* Compute SEC from LOCAL_TM.tm_sec and HZ. */ | 1549 | /* Compute SEC from LOCAL_TM.tm_sec and HZ. */ |
| 1550 | Lisp_Object hz = lt.hz, sec; | 1550 | Lisp_Object hz = lt.hz, sec; |
| 1551 | if (BASE_EQ (hz, make_fixnum (1)) || !BASE2_EQ (form, Qt)) | 1551 | if (BASE_EQ (hz, make_fixnum (1)) || !EQ (form, Qt)) |
| 1552 | sec = make_fixnum (local_tm.tm_sec); | 1552 | sec = make_fixnum (local_tm.tm_sec); |
| 1553 | else | 1553 | else |
| 1554 | { | 1554 | { |
| @@ -1765,10 +1765,8 @@ but new code should not rely on it. */) | |||
| 1765 | well, since we accept it as input? */ | 1765 | well, since we accept it as input? */ |
| 1766 | struct lisp_time t; | 1766 | struct lisp_time t; |
| 1767 | enum timeform input_form = decode_lisp_time (time, false, &t, 0); | 1767 | enum timeform input_form = decode_lisp_time (time, false, &t, 0); |
| 1768 | if (NILP (form)) | 1768 | form = (!NILP (form) ? maybe_remove_pos_from_symbol (form) |
| 1769 | form = current_time_list ? Qlist : Qt; | 1769 | : current_time_list ? Qlist : Qt); |
| 1770 | if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (form)) | ||
| 1771 | form = SYMBOL_WITH_POS_SYM (form); | ||
| 1772 | if (BASE_EQ (form, Qlist)) | 1770 | if (BASE_EQ (form, Qlist)) |
| 1773 | return ticks_hz_list4 (t.ticks, t.hz); | 1771 | return ticks_hz_list4 (t.ticks, t.hz); |
| 1774 | if (BASE_EQ (form, Qinteger)) | 1772 | if (BASE_EQ (form, Qinteger)) |
diff --git a/src/treesit.c b/src/treesit.c index 12915ea9a10..d86ab501187 100644 --- a/src/treesit.c +++ b/src/treesit.c | |||
| @@ -3275,11 +3275,11 @@ treesit_traverse_child_helper (TSTreeCursor *cursor, | |||
| 3275 | static Lisp_Object | 3275 | static Lisp_Object |
| 3276 | treesit_traverse_get_predicate (Lisp_Object thing, Lisp_Object language) | 3276 | treesit_traverse_get_predicate (Lisp_Object thing, Lisp_Object language) |
| 3277 | { | 3277 | { |
| 3278 | Lisp_Object cons = assq_no_quit (language, Vtreesit_thing_settings); | 3278 | Lisp_Object cons = assq_no_signal (language, Vtreesit_thing_settings); |
| 3279 | if (NILP (cons)) | 3279 | if (NILP (cons)) |
| 3280 | return Qnil; | 3280 | return Qnil; |
| 3281 | Lisp_Object definitions = XCDR (cons); | 3281 | Lisp_Object definitions = XCDR (cons); |
| 3282 | Lisp_Object entry = assq_no_quit (thing, definitions); | 3282 | Lisp_Object entry = assq_no_signal (thing, definitions); |
| 3283 | if (NILP (entry)) | 3283 | if (NILP (entry)) |
| 3284 | return Qnil; | 3284 | return Qnil; |
| 3285 | /* ENTRY looks like (THING PRED). */ | 3285 | /* ENTRY looks like (THING PRED). */ |
diff --git a/src/verbose.mk.in b/src/verbose.mk.in index e72c182f276..6efb6b9416b 100644 --- a/src/verbose.mk.in +++ b/src/verbose.mk.in | |||
| @@ -53,38 +53,39 @@ have_working_info = $(filter notintermediate,$(value .FEATURES)) | |||
| 53 | # The workaround is done only for AM_V_ELC and AM_V_ELN, | 53 | # The workaround is done only for AM_V_ELC and AM_V_ELN, |
| 54 | # since the bug is not annoying elsewhere. | 54 | # since the bug is not annoying elsewhere. |
| 55 | 55 | ||
| 56 | AM_V_AR = @$(info $ AR $@) | 56 | . := |
| 57 | AM_V_AR = @$(info $. AR $@) | ||
| 57 | AM_V_at = @ | 58 | AM_V_at = @ |
| 58 | AM_V_CC = @$(info $ CC $@) | 59 | AM_V_CC = @$(info $. CC $@) |
| 59 | AM_V_CXX = @$(info $ CXX $@) | 60 | AM_V_CXX = @$(info $. CXX $@) |
| 60 | AM_V_CCLD = @$(info $ CCLD $@) | 61 | AM_V_CCLD = @$(info $. CCLD $@) |
| 61 | AM_V_CXXLD = @$(info $ CXXLD $@) | 62 | AM_V_CXXLD = @$(info $. CXXLD $@) |
| 62 | 63 | ||
| 63 | ifeq ($(HAVE_NATIVE_COMP)-$(NATIVE_DISABLED)-$(ANCIENT),yes--) | 64 | ifeq ($(HAVE_NATIVE_COMP)-$(NATIVE_DISABLED)-$(ANCIENT),yes--) |
| 64 | ifneq (,$(have_working_info)) | 65 | ifneq (,$(have_working_info)) |
| 65 | AM_V_ELC = @$(info $ ELC+ELN $@) | 66 | AM_V_ELC = @$(info $. ELC+ELN $@) |
| 66 | AM_V_ELN = @$(info $ ELN $@) | 67 | AM_V_ELN = @$(info $. ELN $@) |
| 67 | else | 68 | else |
| 68 | AM_V_ELC = @echo " ELC+ELN " $@; | 69 | AM_V_ELC = @echo " ELC+ELN " $@; |
| 69 | AM_V_ELN = @echo " ELN " $@; | 70 | AM_V_ELN = @echo " ELN " $@; |
| 70 | endif | 71 | endif |
| 71 | else | 72 | else |
| 72 | ifneq (,$(have_working_info)) | 73 | ifneq (,$(have_working_info)) |
| 73 | AM_V_ELC = @$(info $ ELC $@) | 74 | AM_V_ELC = @$(info $. ELC $@) |
| 74 | else | 75 | else |
| 75 | AM_V_ELC = @echo " ELC " $@; | 76 | AM_V_ELC = @echo " ELC " $@; |
| 76 | endif | 77 | endif |
| 77 | AM_V_ELN = | 78 | AM_V_ELN = |
| 78 | endif | 79 | endif |
| 79 | 80 | ||
| 80 | AM_V_GEN = @$(info $ GEN $@) | 81 | AM_V_GEN = @$(info $. GEN $@) |
| 81 | AM_V_GLOBALS = @$(info $ GEN globals.h) | 82 | AM_V_GLOBALS = @$(info $. GEN globals.h) |
| 82 | AM_V_NO_PD = --no-print-directory | 83 | AM_V_NO_PD = --no-print-directory |
| 83 | AM_V_RC = @$(info $ RC $@) | 84 | AM_V_RC = @$(info $. RC $@) |
| 84 | 85 | ||
| 85 | # These are used for the Android port. | 86 | # These are used for the Android port. |
| 86 | AM_V_JAVAC = @$(info $ JAVAC $@) | 87 | AM_V_JAVAC = @$(info $. JAVAC $@) |
| 87 | AM_V_D8 = @$(info $ D8 $@) | 88 | AM_V_D8 = @$(info $. D8 $@) |
| 88 | AM_V_AAPT = @$(info $ AAPT $@) | 89 | AM_V_AAPT = @$(info $. AAPT $@) |
| 89 | AM_V_SILENT = @ | 90 | AM_V_SILENT = @ |
| 90 | endif | 91 | endif |
diff --git a/src/window.c b/src/window.c index 915f591221d..0c84b4f4bf3 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -4151,6 +4151,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, | |||
| 4151 | buffer); | 4151 | buffer); |
| 4152 | w->start_at_line_beg = false; | 4152 | w->start_at_line_beg = false; |
| 4153 | w->force_start = false; | 4153 | w->force_start = false; |
| 4154 | /* Flush the base_line cache since it applied to another buffer. */ | ||
| 4155 | w->base_line_number = 0; | ||
| 4154 | } | 4156 | } |
| 4155 | 4157 | ||
| 4156 | wset_redisplay (w); | 4158 | wset_redisplay (w); |
| @@ -5378,7 +5380,14 @@ grow_mini_window (struct window *w, int delta) | |||
| 5378 | grow = call3 (Qwindow__resize_root_window_vertically, | 5380 | grow = call3 (Qwindow__resize_root_window_vertically, |
| 5379 | root, make_fixnum (- delta), Qt); | 5381 | root, make_fixnum (- delta), Qt); |
| 5380 | 5382 | ||
| 5381 | if (FIXNUMP (grow) && window_resize_check (r, false)) | 5383 | if (FIXNUMP (grow) |
| 5384 | /* It might be impossible to resize the window, in which case | ||
| 5385 | calling resize_mini_window_apply will set off an infinite | ||
| 5386 | loop where the redisplay cycle so forced returns to | ||
| 5387 | resize_mini_window, making endless attempts to expand the | ||
| 5388 | minibuffer window to this impossible size. (bug#69140) */ | ||
| 5389 | && XFIXNUM (grow) != 0 | ||
| 5390 | && window_resize_check (r, false)) | ||
| 5382 | resize_mini_window_apply (w, -XFIXNUM (grow)); | 5391 | resize_mini_window_apply (w, -XFIXNUM (grow)); |
| 5383 | } | 5392 | } |
| 5384 | } | 5393 | } |
diff --git a/src/xdisp.c b/src/xdisp.c index 19f176459c7..d03769e2a31 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -2508,7 +2508,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int | |||
| 2508 | r.x = s->clip_head->x; | 2508 | r.x = s->clip_head->x; |
| 2509 | } | 2509 | } |
| 2510 | if (s->clip_tail) | 2510 | if (s->clip_tail) |
| 2511 | if (r.x + r.width > s->clip_tail->x + s->clip_tail->background_width) | 2511 | if (r.x + (int) r.width > s->clip_tail->x + s->clip_tail->background_width) |
| 2512 | { | 2512 | { |
| 2513 | if (s->clip_tail->x + s->clip_tail->background_width >= r.x) | 2513 | if (s->clip_tail->x + s->clip_tail->background_width >= r.x) |
| 2514 | r.width = s->clip_tail->x + s->clip_tail->background_width - r.x; | 2514 | r.width = s->clip_tail->x + s->clip_tail->background_width - r.x; |
| @@ -2588,7 +2588,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int | |||
| 2588 | height = max (FRAME_LINE_HEIGHT (s->f), glyph->ascent + glyph->descent); | 2588 | height = max (FRAME_LINE_HEIGHT (s->f), glyph->ascent + glyph->descent); |
| 2589 | if (height < r.height) | 2589 | if (height < r.height) |
| 2590 | { | 2590 | { |
| 2591 | max_y = r.y + r.height; | 2591 | max_y = r.y + (int) r.height; |
| 2592 | r.y = min (max_y, max (r.y, s->ybase + glyph->descent - height)); | 2592 | r.y = min (max_y, max (r.y, s->ybase + glyph->descent - height)); |
| 2593 | r.height = min (max_y - r.y, height); | 2593 | r.height = min (max_y - r.y, height); |
| 2594 | } | 2594 | } |
| @@ -2629,7 +2629,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int | |||
| 2629 | if (s->for_overlaps & OVERLAPS_PRED) | 2629 | if (s->for_overlaps & OVERLAPS_PRED) |
| 2630 | { | 2630 | { |
| 2631 | rs[i] = r; | 2631 | rs[i] = r; |
| 2632 | if (r.y + r.height > row_y) | 2632 | if (r.y + (int) r.height > row_y) |
| 2633 | { | 2633 | { |
| 2634 | if (r.y < row_y) | 2634 | if (r.y < row_y) |
| 2635 | rs[i].height = row_y - r.y; | 2635 | rs[i].height = row_y - r.y; |
| @@ -2643,10 +2643,10 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int | |||
| 2643 | rs[i] = r; | 2643 | rs[i] = r; |
| 2644 | if (r.y < row_y + s->row->visible_height) | 2644 | if (r.y < row_y + s->row->visible_height) |
| 2645 | { | 2645 | { |
| 2646 | if (r.y + r.height > row_y + s->row->visible_height) | 2646 | if (r.y + (int) r.height > row_y + s->row->visible_height) |
| 2647 | { | 2647 | { |
| 2648 | rs[i].y = row_y + s->row->visible_height; | 2648 | rs[i].y = row_y + s->row->visible_height; |
| 2649 | rs[i].height = r.y + r.height - rs[i].y; | 2649 | rs[i].height = r.y + (int) r.height - rs[i].y; |
| 2650 | } | 2650 | } |
| 2651 | else | 2651 | else |
| 2652 | rs[i].height = 0; | 2652 | rs[i].height = 0; |
| @@ -2831,7 +2831,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) | |||
| 2831 | text_glyph: | 2831 | text_glyph: |
| 2832 | gr = 0; gy = 0; | 2832 | gr = 0; gy = 0; |
| 2833 | for (; r <= end_row && r->enabled_p; ++r) | 2833 | for (; r <= end_row && r->enabled_p; ++r) |
| 2834 | if (r->y + r->height > y) | 2834 | if (r->y + (int) r->height > y) |
| 2835 | { | 2835 | { |
| 2836 | gr = r; gy = r->y; | 2836 | gr = r; gy = r->y; |
| 2837 | break; | 2837 | break; |
| @@ -2931,7 +2931,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) | |||
| 2931 | row_glyph: | 2931 | row_glyph: |
| 2932 | gr = 0, gy = 0; | 2932 | gr = 0, gy = 0; |
| 2933 | for (; r <= end_row && r->enabled_p; ++r) | 2933 | for (; r <= end_row && r->enabled_p; ++r) |
| 2934 | if (r->y + r->height > y) | 2934 | if (r->y + (int) r->height > y) |
| 2935 | { | 2935 | { |
| 2936 | gr = r; gy = r->y; | 2936 | gr = r; gy = r->y; |
| 2937 | break; | 2937 | break; |
| @@ -3821,7 +3821,7 @@ start_display (struct it *it, struct window *w, struct text_pos pos) | |||
| 3821 | 3821 | ||
| 3822 | it->current_y = first_y; | 3822 | it->current_y = first_y; |
| 3823 | it->vpos = 0; | 3823 | it->vpos = 0; |
| 3824 | it->current_x = it->hpos = 0; | 3824 | it->current_x = it->hpos = it->wrap_prefix_width = 0; |
| 3825 | } | 3825 | } |
| 3826 | } | 3826 | } |
| 3827 | } | 3827 | } |
| @@ -4345,10 +4345,7 @@ compute_stop_pos (struct it *it) | |||
| 4345 | } | 4345 | } |
| 4346 | } | 4346 | } |
| 4347 | 4347 | ||
| 4348 | if (it->cmp_it.id < 0 | 4348 | if (it->cmp_it.id < 0) |
| 4349 | && (STRINGP (it->string) | ||
| 4350 | || ((!it->bidi_p || it->bidi_it.scan_dir >= 0) | ||
| 4351 | && it->cmp_it.stop_pos <= IT_CHARPOS (*it)))) | ||
| 4352 | { | 4349 | { |
| 4353 | ptrdiff_t stoppos = it->end_charpos; | 4350 | ptrdiff_t stoppos = it->end_charpos; |
| 4354 | 4351 | ||
| @@ -4357,7 +4354,9 @@ compute_stop_pos (struct it *it) | |||
| 4357 | characters to that position. */ | 4354 | characters to that position. */ |
| 4358 | if (it->bidi_p && it->bidi_it.scan_dir < 0) | 4355 | if (it->bidi_p && it->bidi_it.scan_dir < 0) |
| 4359 | stoppos = -1; | 4356 | stoppos = -1; |
| 4360 | else if (cmp_limit_pos > 0) | 4357 | else if (!STRINGP (it->string) |
| 4358 | && it->cmp_it.stop_pos <= IT_CHARPOS (*it) | ||
| 4359 | && cmp_limit_pos > 0) | ||
| 4361 | stoppos = cmp_limit_pos; | 4360 | stoppos = cmp_limit_pos; |
| 4362 | /* Force composition_compute_stop_pos avoid the costly search | 4361 | /* Force composition_compute_stop_pos avoid the costly search |
| 4363 | for static compositions, since those were already found by | 4362 | for static compositions, since those were already found by |
| @@ -5062,31 +5061,169 @@ handle_invisible_prop (struct it *it) | |||
| 5062 | { | 5061 | { |
| 5063 | enum prop_handled handled = HANDLED_NORMALLY; | 5062 | enum prop_handled handled = HANDLED_NORMALLY; |
| 5064 | int invis; | 5063 | int invis; |
| 5065 | Lisp_Object prop; | 5064 | ptrdiff_t curpos, endpos; |
| 5065 | Lisp_Object prop, pos, overlay; | ||
| 5066 | 5066 | ||
| 5067 | /* Get the value of the invisible text property at the current | ||
| 5068 | position. Value will be nil if there is no such property. */ | ||
| 5067 | if (STRINGP (it->string)) | 5069 | if (STRINGP (it->string)) |
| 5068 | { | 5070 | { |
| 5069 | Lisp_Object end_charpos, limit; | 5071 | curpos = IT_STRING_CHARPOS (*it); |
| 5072 | endpos = SCHARS (it->string); | ||
| 5073 | pos = make_fixnum (curpos); | ||
| 5074 | prop = Fget_text_property (pos, Qinvisible, it->string); | ||
| 5075 | } | ||
| 5076 | else /* buffer */ | ||
| 5077 | { | ||
| 5078 | curpos = IT_CHARPOS (*it); | ||
| 5079 | endpos = ZV; | ||
| 5080 | pos = make_fixnum (curpos); | ||
| 5081 | prop = get_char_property_and_overlay (pos, Qinvisible, it->window, | ||
| 5082 | &overlay); | ||
| 5083 | } | ||
| 5070 | 5084 | ||
| 5071 | /* Get the value of the invisible text property at the | 5085 | /* Do we have anything to do here? */ |
| 5072 | current position. Value will be nil if there is no such | 5086 | invis = TEXT_PROP_MEANS_INVISIBLE (prop); |
| 5073 | property. */ | 5087 | if (invis == 0 || curpos >= it->end_charpos) |
| 5074 | end_charpos = make_fixnum (IT_STRING_CHARPOS (*it)); | 5088 | return handled; |
| 5075 | prop = Fget_text_property (end_charpos, Qinvisible, it->string); | ||
| 5076 | invis = TEXT_PROP_MEANS_INVISIBLE (prop); | ||
| 5077 | 5089 | ||
| 5078 | if (invis != 0 && IT_STRING_CHARPOS (*it) < it->end_charpos) | 5090 | /* If not bidi, or the bidi iteration is at base paragraph level, we |
| 5091 | can use a faster method; otherwise we need to check invisibility | ||
| 5092 | of every character while bidi-iterating out of invisible text. */ | ||
| 5093 | bool slow = it->bidi_p && !BIDI_AT_BASE_LEVEL (it->bidi_it); | ||
| 5094 | /* Record whether we have to display an ellipsis for the | ||
| 5095 | invisible text. */ | ||
| 5096 | bool display_ellipsis_p = (invis == 2); | ||
| 5097 | |||
| 5098 | handled = HANDLED_RECOMPUTE_PROPS; | ||
| 5099 | |||
| 5100 | if (slow) | ||
| 5101 | { | ||
| 5102 | if (it->bidi_it.first_elt && it->bidi_it.charpos < endpos) | ||
| 5103 | bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true); | ||
| 5104 | |||
| 5105 | if (STRINGP (it->string)) | ||
| 5106 | { | ||
| 5107 | bool done = false; | ||
| 5108 | /* Bidi-iterate out of the invisible part of the string. */ | ||
| 5109 | do | ||
| 5110 | { | ||
| 5111 | bidi_move_to_visually_next (&it->bidi_it); | ||
| 5112 | if (it->bidi_it.charpos < 0 || it->bidi_it.charpos >= endpos) | ||
| 5113 | done = true; | ||
| 5114 | else | ||
| 5115 | { | ||
| 5116 | pos = make_fixnum (it->bidi_it.charpos); | ||
| 5117 | prop = Fget_text_property (pos, Qinvisible, it->string); | ||
| 5118 | invis = TEXT_PROP_MEANS_INVISIBLE (prop); | ||
| 5119 | /* If there are adjacent invisible texts, don't lose | ||
| 5120 | the second one's ellipsis. */ | ||
| 5121 | if (invis == 2) | ||
| 5122 | display_ellipsis_p = true; | ||
| 5123 | } | ||
| 5124 | } | ||
| 5125 | while (!done && invis != 0); | ||
| 5126 | |||
| 5127 | if (display_ellipsis_p) | ||
| 5128 | it->ellipsis_p = true; | ||
| 5129 | IT_STRING_CHARPOS (*it) = it->bidi_it.charpos; | ||
| 5130 | IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos; | ||
| 5131 | if (IT_STRING_BYTEPOS (*it) >= endpos) | ||
| 5132 | { | ||
| 5133 | /* The rest of the string is invisible. If this is an | ||
| 5134 | overlay string, proceed with the next overlay string | ||
| 5135 | or whatever comes and return a character from there. */ | ||
| 5136 | if (it->current.overlay_string_index >= 0 | ||
| 5137 | && !display_ellipsis_p) | ||
| 5138 | { | ||
| 5139 | next_overlay_string (it); | ||
| 5140 | /* Don't check for overlay strings when we just | ||
| 5141 | finished processing them. */ | ||
| 5142 | handled = HANDLED_OVERLAY_STRING_CONSUMED; | ||
| 5143 | } | ||
| 5144 | } | ||
| 5145 | } | ||
| 5146 | else | ||
| 5079 | { | 5147 | { |
| 5080 | /* Record whether we have to display an ellipsis for the | 5148 | bool done = false; |
| 5081 | invisible text. */ | 5149 | /* Bidi-iterate out of the invisible text. */ |
| 5082 | bool display_ellipsis_p = (invis == 2); | 5150 | do |
| 5083 | ptrdiff_t len, endpos; | 5151 | { |
| 5152 | bidi_move_to_visually_next (&it->bidi_it); | ||
| 5153 | if (it->bidi_it.charpos < BEGV || it->bidi_it.charpos >= endpos) | ||
| 5154 | done = true; | ||
| 5155 | else | ||
| 5156 | { | ||
| 5157 | pos = make_fixnum (it->bidi_it.charpos); | ||
| 5158 | prop = Fget_char_property (pos, Qinvisible, it->window); | ||
| 5159 | invis = TEXT_PROP_MEANS_INVISIBLE (prop); | ||
| 5160 | /* If there are adjacent invisible texts, don't lose | ||
| 5161 | the second one's ellipsis. */ | ||
| 5162 | if (invis == 2) | ||
| 5163 | display_ellipsis_p = true; | ||
| 5164 | } | ||
| 5165 | } | ||
| 5166 | while (!done && invis != 0); | ||
| 5167 | |||
| 5168 | IT_CHARPOS (*it) = it->bidi_it.charpos; | ||
| 5169 | IT_BYTEPOS (*it) = it->bidi_it.bytepos; | ||
| 5170 | if (display_ellipsis_p) | ||
| 5171 | { | ||
| 5172 | /* Make sure that the glyphs of the ellipsis will get | ||
| 5173 | correct `charpos' values. See below for detailed | ||
| 5174 | explanation why this is needed. */ | ||
| 5175 | it->position.charpos = IT_CHARPOS (*it) - 1; | ||
| 5176 | it->position.bytepos = CHAR_TO_BYTE (it->position.charpos); | ||
| 5177 | } | ||
| 5178 | /* If there are before-strings at the start of invisible | ||
| 5179 | text, and the text is invisible because of a text | ||
| 5180 | property, arrange to show before-strings because 20.x did | ||
| 5181 | it that way. (If the text is invisible because of an | ||
| 5182 | overlay property instead of a text property, this is | ||
| 5183 | already handled in the overlay code.) */ | ||
| 5184 | if (NILP (overlay) | ||
| 5185 | && get_overlay_strings (it, it->stop_charpos)) | ||
| 5186 | { | ||
| 5187 | handled = HANDLED_RECOMPUTE_PROPS; | ||
| 5188 | if (it->sp > 0) | ||
| 5189 | { | ||
| 5190 | it->stack[it->sp - 1].display_ellipsis_p = display_ellipsis_p; | ||
| 5191 | /* The call to get_overlay_strings above recomputes | ||
| 5192 | it->stop_charpos, but it only considers changes | ||
| 5193 | in properties and overlays beyond iterator's | ||
| 5194 | current position. This causes us to miss changes | ||
| 5195 | that happen exactly where the invisible property | ||
| 5196 | ended. So we play it safe here and force the | ||
| 5197 | iterator to check for potential stop positions | ||
| 5198 | immediately after the invisible text. Note that | ||
| 5199 | if get_overlay_strings returns true, it | ||
| 5200 | normally also pushed the iterator stack, so we | ||
| 5201 | need to update the stop position in the slot | ||
| 5202 | below the current one. */ | ||
| 5203 | it->stack[it->sp - 1].stop_charpos | ||
| 5204 | = CHARPOS (it->stack[it->sp - 1].current.pos); | ||
| 5205 | } | ||
| 5206 | } | ||
| 5207 | else if (display_ellipsis_p) | ||
| 5208 | { | ||
| 5209 | it->ellipsis_p = true; | ||
| 5210 | /* Let the ellipsis display before | ||
| 5211 | considering any properties of the following char. | ||
| 5212 | Fixes jasonr@gnu.org 01 Oct 07 bug. */ | ||
| 5213 | handled = HANDLED_RETURN; | ||
| 5214 | } | ||
| 5215 | } | ||
| 5216 | } | ||
| 5217 | else if (STRINGP (it->string)) | ||
| 5218 | { | ||
| 5219 | Lisp_Object end_charpos = pos, limit; | ||
| 5084 | 5220 | ||
| 5085 | handled = HANDLED_RECOMPUTE_PROPS; | 5221 | if (invis != 0 && IT_STRING_CHARPOS (*it) < it->end_charpos) |
| 5222 | { | ||
| 5223 | ptrdiff_t len = endpos; | ||
| 5086 | 5224 | ||
| 5087 | /* Get the position at which the next visible text can be | 5225 | /* Get the position at which the next visible text can be |
| 5088 | found in IT->string, if any. */ | 5226 | found in IT->string, if any. */ |
| 5089 | endpos = len = SCHARS (it->string); | ||
| 5090 | XSETINT (limit, len); | 5227 | XSETINT (limit, len); |
| 5091 | do | 5228 | do |
| 5092 | { | 5229 | { |
| @@ -5137,7 +5274,7 @@ handle_invisible_prop (struct it *it) | |||
| 5137 | 5274 | ||
| 5138 | IT_STRING_CHARPOS (*it) = it->bidi_it.charpos; | 5275 | IT_STRING_CHARPOS (*it) = it->bidi_it.charpos; |
| 5139 | IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos; | 5276 | IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos; |
| 5140 | if (IT_CHARPOS (*it) >= endpos) | 5277 | if (IT_STRING_CHARPOS (*it) >= endpos) |
| 5141 | it->prev_stop = endpos; | 5278 | it->prev_stop = endpos; |
| 5142 | } | 5279 | } |
| 5143 | else | 5280 | else |
| @@ -5167,27 +5304,14 @@ handle_invisible_prop (struct it *it) | |||
| 5167 | } | 5304 | } |
| 5168 | } | 5305 | } |
| 5169 | } | 5306 | } |
| 5170 | else | 5307 | else /* we are iterating over buffer text at base paragraph level */ |
| 5171 | { | 5308 | { |
| 5172 | ptrdiff_t newpos, next_stop, start_charpos, tem; | 5309 | ptrdiff_t newpos, next_stop, tem = curpos; |
| 5173 | Lisp_Object pos, overlay; | 5310 | Lisp_Object pos; |
| 5174 | |||
| 5175 | /* First of all, is there invisible text at this position? */ | ||
| 5176 | tem = start_charpos = IT_CHARPOS (*it); | ||
| 5177 | pos = make_fixnum (tem); | ||
| 5178 | prop = get_char_property_and_overlay (pos, Qinvisible, it->window, | ||
| 5179 | &overlay); | ||
| 5180 | invis = TEXT_PROP_MEANS_INVISIBLE (prop); | ||
| 5181 | 5311 | ||
| 5182 | /* If we are on invisible text, skip over it. */ | 5312 | /* If we are on invisible text, skip over it. */ |
| 5183 | if (invis != 0 && start_charpos < it->end_charpos) | 5313 | if (invis != 0 && curpos < it->end_charpos) |
| 5184 | { | 5314 | { |
| 5185 | /* Record whether we have to display an ellipsis for the | ||
| 5186 | invisible text. */ | ||
| 5187 | bool display_ellipsis_p = invis == 2; | ||
| 5188 | |||
| 5189 | handled = HANDLED_RECOMPUTE_PROPS; | ||
| 5190 | |||
| 5191 | /* Loop skipping over invisible text. The loop is left at | 5315 | /* Loop skipping over invisible text. The loop is left at |
| 5192 | ZV or with IT on the first char being visible again. */ | 5316 | ZV or with IT on the first char being visible again. */ |
| 5193 | do | 5317 | do |
| @@ -5487,9 +5611,6 @@ display_min_width (struct it *it, ptrdiff_t bufpos, | |||
| 5487 | if (!NILP (it->min_width_property) | 5611 | if (!NILP (it->min_width_property) |
| 5488 | && !EQ (width_spec, it->min_width_property)) | 5612 | && !EQ (width_spec, it->min_width_property)) |
| 5489 | { | 5613 | { |
| 5490 | if (!it->glyph_row) | ||
| 5491 | return; | ||
| 5492 | |||
| 5493 | /* When called from display_string (i.e., the mode line), | 5614 | /* When called from display_string (i.e., the mode line), |
| 5494 | we're being called with a string as the object, and we | 5615 | we're being called with a string as the object, and we |
| 5495 | may be called with many sub-strings belonging to the same | 5616 | may be called with many sub-strings belonging to the same |
| @@ -5532,7 +5653,13 @@ display_min_width (struct it *it, ptrdiff_t bufpos, | |||
| 5532 | it->object = list3 (Qspace, QCwidth, w); | 5653 | it->object = list3 (Qspace, QCwidth, w); |
| 5533 | produce_stretch_glyph (it); | 5654 | produce_stretch_glyph (it); |
| 5534 | if (it->area == TEXT_AREA) | 5655 | if (it->area == TEXT_AREA) |
| 5535 | it->current_x += it->pixel_width; | 5656 | { |
| 5657 | it->current_x += it->pixel_width; | ||
| 5658 | |||
| 5659 | if (it->continuation_lines_width | ||
| 5660 | && it->string_from_prefix_prop_p) | ||
| 5661 | it->wrap_prefix_width = it->current_x; | ||
| 5662 | } | ||
| 5536 | it->min_width_property = Qnil; | 5663 | it->min_width_property = Qnil; |
| 5537 | } | 5664 | } |
| 5538 | } | 5665 | } |
| @@ -9733,6 +9860,13 @@ move_it_in_display_line_to (struct it *it, | |||
| 9733 | ptrdiff_t prev_pos = IT_CHARPOS (*it); | 9860 | ptrdiff_t prev_pos = IT_CHARPOS (*it); |
| 9734 | bool saw_smaller_pos = prev_pos < to_charpos; | 9861 | bool saw_smaller_pos = prev_pos < to_charpos; |
| 9735 | bool line_number_pending = false; | 9862 | bool line_number_pending = false; |
| 9863 | int this_line_subject_to_line_prefix = 0; | ||
| 9864 | |||
| 9865 | #ifdef GLYPH_DEBUG | ||
| 9866 | /* atx_flag, atpos_flag and wrap_flag are assigned but never used; | ||
| 9867 | these hold information useful while debugging. */ | ||
| 9868 | int atx_flag, atpos_flag, wrap_flag; | ||
| 9869 | #endif /* GLYPH_DEBUG */ | ||
| 9736 | 9870 | ||
| 9737 | /* Don't produce glyphs in produce_glyphs. */ | 9871 | /* Don't produce glyphs in produce_glyphs. */ |
| 9738 | saved_glyph_row = it->glyph_row; | 9872 | saved_glyph_row = it->glyph_row; |
| @@ -9798,6 +9932,11 @@ move_it_in_display_line_to (struct it *it, | |||
| 9798 | /* If there's a line-/wrap-prefix, handle it, if we didn't already. */ | 9932 | /* If there's a line-/wrap-prefix, handle it, if we didn't already. */ |
| 9799 | if (it->area == TEXT_AREA && !it->string_from_prefix_prop_p) | 9933 | if (it->area == TEXT_AREA && !it->string_from_prefix_prop_p) |
| 9800 | handle_line_prefix (it); | 9934 | handle_line_prefix (it); |
| 9935 | |||
| 9936 | /* Save whether this line has received a wrap prefix, as this | ||
| 9937 | affects whether Emacs attempts to move glyphs into | ||
| 9938 | continuation lines. */ | ||
| 9939 | this_line_subject_to_line_prefix = it->string_from_prefix_prop_p; | ||
| 9801 | } | 9940 | } |
| 9802 | 9941 | ||
| 9803 | if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) | 9942 | if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) |
| @@ -9841,10 +9980,15 @@ move_it_in_display_line_to (struct it *it, | |||
| 9841 | break; | 9980 | break; |
| 9842 | } | 9981 | } |
| 9843 | else if (it->line_wrap == WORD_WRAP && atpos_it.sp < 0) | 9982 | else if (it->line_wrap == WORD_WRAP && atpos_it.sp < 0) |
| 9844 | /* If wrap_it is valid, the current position might be in a | 9983 | { |
| 9845 | word that is wrapped. So, save the iterator in | 9984 | /* If wrap_it is valid, the current position might be in |
| 9846 | atpos_it and continue to see if wrapping happens. */ | 9985 | a word that is wrapped. So, save the iterator in |
| 9847 | SAVE_IT (atpos_it, *it, atpos_data); | 9986 | atpos_it and continue to see if wrapping happens. */ |
| 9987 | SAVE_IT (atpos_it, *it, atpos_data); | ||
| 9988 | #ifdef GLYPH_DEBUG | ||
| 9989 | atpos_flag = this_line_subject_to_line_prefix; | ||
| 9990 | #endif /* GLYPH_DEBUG */ | ||
| 9991 | } | ||
| 9848 | } | 9992 | } |
| 9849 | 9993 | ||
| 9850 | /* Stop when ZV reached. | 9994 | /* Stop when ZV reached. |
| @@ -9906,6 +10050,9 @@ move_it_in_display_line_to (struct it *it, | |||
| 9906 | } | 10050 | } |
| 9907 | /* Otherwise, we can wrap here. */ | 10051 | /* Otherwise, we can wrap here. */ |
| 9908 | SAVE_IT (wrap_it, *it, wrap_data); | 10052 | SAVE_IT (wrap_it, *it, wrap_data); |
| 10053 | #ifdef GLYPH_DEBUG | ||
| 10054 | wrap_flag = this_line_subject_to_line_prefix; | ||
| 10055 | #endif /* GLYPH_DEBUG */ | ||
| 9909 | } | 10056 | } |
| 9910 | /* Update may_wrap for the next iteration. */ | 10057 | /* Update may_wrap for the next iteration. */ |
| 9911 | may_wrap = next_may_wrap; | 10058 | may_wrap = next_may_wrap; |
| @@ -9984,6 +10131,9 @@ move_it_in_display_line_to (struct it *it, | |||
| 9984 | { | 10131 | { |
| 9985 | SAVE_IT (atpos_it, *it, atpos_data); | 10132 | SAVE_IT (atpos_it, *it, atpos_data); |
| 9986 | IT_RESET_X_ASCENT_DESCENT (&atpos_it); | 10133 | IT_RESET_X_ASCENT_DESCENT (&atpos_it); |
| 10134 | #ifdef GLYPH_DEBUG | ||
| 10135 | atpos_flag = this_line_subject_to_line_prefix; | ||
| 10136 | #endif /* GLYPH_DEBUG */ | ||
| 9987 | } | 10137 | } |
| 9988 | } | 10138 | } |
| 9989 | else | 10139 | else |
| @@ -9998,6 +10148,9 @@ move_it_in_display_line_to (struct it *it, | |||
| 9998 | { | 10148 | { |
| 9999 | SAVE_IT (atx_it, *it, atx_data); | 10149 | SAVE_IT (atx_it, *it, atx_data); |
| 10000 | IT_RESET_X_ASCENT_DESCENT (&atx_it); | 10150 | IT_RESET_X_ASCENT_DESCENT (&atx_it); |
| 10151 | #ifdef GLYPH_DEBUG | ||
| 10152 | atx_flag = this_line_subject_to_line_prefix; | ||
| 10153 | #endif /* GLYPH_DEBUG */ | ||
| 10001 | } | 10154 | } |
| 10002 | } | 10155 | } |
| 10003 | } | 10156 | } |
| @@ -10012,12 +10165,27 @@ move_it_in_display_line_to (struct it *it, | |||
| 10012 | && FRAME_WINDOW_P (it->f) | 10165 | && FRAME_WINDOW_P (it->f) |
| 10013 | && ((it->bidi_p && it->bidi_it.paragraph_dir == R2L) | 10166 | && ((it->bidi_p && it->bidi_it.paragraph_dir == R2L) |
| 10014 | ? WINDOW_LEFT_FRINGE_WIDTH (it->w) | 10167 | ? WINDOW_LEFT_FRINGE_WIDTH (it->w) |
| 10015 | : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))) | 10168 | : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))) |
| 10169 | /* There is no line prefix, next to which the | ||
| 10170 | iterator _must_ produce a minimum of one actual | ||
| 10171 | glyph. */ | ||
| 10172 | && (!this_line_subject_to_line_prefix | ||
| 10173 | /* Or this is the second glyph to be produced | ||
| 10174 | beyond the confines of the line. */ | ||
| 10175 | || (i != 0 | ||
| 10176 | && (x > it->last_visible_x | ||
| 10177 | || (x == it->last_visible_x | ||
| 10178 | && FRAME_WINDOW_P (it->f) | ||
| 10179 | && ((it->bidi_p | ||
| 10180 | && it->bidi_it.paragraph_dir == R2L) | ||
| 10181 | ? WINDOW_LEFT_FRINGE_WIDTH (it->w) | ||
| 10182 | : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))))) | ||
| 10016 | { | 10183 | { |
| 10017 | bool moved_forward = false; | 10184 | bool moved_forward = false; |
| 10018 | 10185 | ||
| 10019 | if (/* IT->hpos == 0 means the very first glyph | 10186 | if (/* IT->hpos == 0 means the very first glyph |
| 10020 | doesn't fit on the line, e.g. a wide image. */ | 10187 | doesn't fit on the line, e.g. a wide |
| 10188 | image. */ | ||
| 10021 | it->hpos == 0 | 10189 | it->hpos == 0 |
| 10022 | || (new_x == it->last_visible_x | 10190 | || (new_x == it->last_visible_x |
| 10023 | && FRAME_WINDOW_P (it->f))) | 10191 | && FRAME_WINDOW_P (it->f))) |
| @@ -10078,6 +10246,9 @@ move_it_in_display_line_to (struct it *it, | |||
| 10078 | SAVE_IT (atpos_it, *it, atpos_data); | 10246 | SAVE_IT (atpos_it, *it, atpos_data); |
| 10079 | atpos_it.current_x = x_before_this_char; | 10247 | atpos_it.current_x = x_before_this_char; |
| 10080 | atpos_it.hpos = hpos_before_this_char; | 10248 | atpos_it.hpos = hpos_before_this_char; |
| 10249 | #ifdef GLYPH_DEBUG | ||
| 10250 | atpos_flag = this_line_subject_to_line_prefix; | ||
| 10251 | #endif /* GLYPH_DEBUG */ | ||
| 10081 | } | 10252 | } |
| 10082 | } | 10253 | } |
| 10083 | 10254 | ||
| @@ -10175,6 +10346,9 @@ move_it_in_display_line_to (struct it *it, | |||
| 10175 | if (it->line_wrap == WORD_WRAP && atpos_it.sp < 0) | 10346 | if (it->line_wrap == WORD_WRAP && atpos_it.sp < 0) |
| 10176 | { | 10347 | { |
| 10177 | SAVE_IT (atpos_it, *it, atpos_data); | 10348 | SAVE_IT (atpos_it, *it, atpos_data); |
| 10349 | #ifdef GLYPH_DEBUG | ||
| 10350 | atpos_flag = this_line_subject_to_line_prefix; | ||
| 10351 | #endif /* GLYPH_DEBUG */ | ||
| 10178 | IT_RESET_X_ASCENT_DESCENT (&atpos_it); | 10352 | IT_RESET_X_ASCENT_DESCENT (&atpos_it); |
| 10179 | } | 10353 | } |
| 10180 | } | 10354 | } |
| @@ -10273,24 +10447,24 @@ move_it_in_display_line_to (struct it *it, | |||
| 10273 | if (it->method == GET_FROM_BUFFER) | 10447 | if (it->method == GET_FROM_BUFFER) |
| 10274 | prev_pos = IT_CHARPOS (*it); | 10448 | prev_pos = IT_CHARPOS (*it); |
| 10275 | 10449 | ||
| 10276 | /* Detect overly-wide wrap-prefixes made of (space ...) display | 10450 | /* The current display element has been consumed. Advance to |
| 10277 | properties. When such a wrap prefix reaches past the right | 10451 | the next. */ |
| 10278 | margin of the window, we need to avoid the call to | 10452 | set_iterator_to_next (it, true); |
| 10279 | set_iterator_to_next below, so that it->line_wrap is left at | 10453 | |
| 10280 | its TRUNCATE value wisely set by handle_line_prefix. | 10454 | /* If IT has just finished producing glyphs for the wrap prefix |
| 10281 | Otherwise, set_iterator_to_next will pop the iterator stack, | 10455 | and is proceeding to the next method, there might not be |
| 10282 | restore it->line_wrap, and we might miss the opportunity to | 10456 | sufficient space remaining in this line to accommodate its |
| 10283 | exit the loop and return. */ | 10457 | glyphs, and one real glyph must be produced to prevent an |
| 10284 | bool overwide_wrap_prefix = | 10458 | infinite loop. Next, clear this flag if such a glyph has |
| 10285 | CONSP (it->object) && EQ (XCAR (it->object), Qspace) | 10459 | already been produced. */ |
| 10286 | && it->sp > 0 && it->method == GET_FROM_STRETCH | 10460 | |
| 10287 | && it->current_x >= it->last_visible_x | 10461 | if (this_line_subject_to_line_prefix == 1 |
| 10288 | && it->continuation_lines_width > 0 | 10462 | && !it->string_from_prefix_prop_p) |
| 10289 | && it->line_wrap == TRUNCATE && it->stack[0].line_wrap != TRUNCATE; | 10463 | this_line_subject_to_line_prefix = 2; |
| 10290 | /* The current display element has been consumed. Advance | 10464 | else if (this_line_subject_to_line_prefix == 2 |
| 10291 | to the next. */ | 10465 | && !it->string_from_prefix_prop_p) |
| 10292 | if (!overwide_wrap_prefix) | 10466 | this_line_subject_to_line_prefix = 0; |
| 10293 | set_iterator_to_next (it, true); | 10467 | |
| 10294 | if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) | 10468 | if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) |
| 10295 | SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it)); | 10469 | SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it)); |
| 10296 | if (IT_CHARPOS (*it) < to_charpos) | 10470 | if (IT_CHARPOS (*it) < to_charpos) |
| @@ -10374,11 +10548,26 @@ move_it_in_display_line_to (struct it *it, | |||
| 10374 | && wrap_it.sp >= 0 | 10548 | && wrap_it.sp >= 0 |
| 10375 | && ((atpos_it.sp >= 0 && wrap_it.current_x < atpos_it.current_x) | 10549 | && ((atpos_it.sp >= 0 && wrap_it.current_x < atpos_it.current_x) |
| 10376 | || (atx_it.sp >= 0 && wrap_it.current_x < atx_it.current_x))) | 10550 | || (atx_it.sp >= 0 && wrap_it.current_x < atx_it.current_x))) |
| 10377 | RESTORE_IT (it, &wrap_it, wrap_data); | 10551 | { |
| 10552 | #ifdef GLYPH_DEBUG | ||
| 10553 | this_line_subject_to_line_prefix = wrap_flag; | ||
| 10554 | #endif /* GLYPH_DEBUG */ | ||
| 10555 | RESTORE_IT (it, &wrap_it, wrap_data); | ||
| 10556 | } | ||
| 10378 | else if (atpos_it.sp >= 0) | 10557 | else if (atpos_it.sp >= 0) |
| 10379 | RESTORE_IT (it, &atpos_it, atpos_data); | 10558 | { |
| 10559 | #ifdef GLYPH_DEBUG | ||
| 10560 | this_line_subject_to_line_prefix = atpos_flag; | ||
| 10561 | #endif /* GLYPH_DEBUG */ | ||
| 10562 | RESTORE_IT (it, &atpos_it, atpos_data); | ||
| 10563 | } | ||
| 10380 | else if (atx_it.sp >= 0) | 10564 | else if (atx_it.sp >= 0) |
| 10381 | RESTORE_IT (it, &atx_it, atx_data); | 10565 | { |
| 10566 | #ifdef GLYPH_DEBUG | ||
| 10567 | this_line_subject_to_line_prefix = atx_flag; | ||
| 10568 | #endif /* GLYPH_DEBUG */ | ||
| 10569 | RESTORE_IT (it, &atx_it, atx_data); | ||
| 10570 | } | ||
| 10382 | 10571 | ||
| 10383 | done: | 10572 | done: |
| 10384 | 10573 | ||
| @@ -10452,13 +10641,9 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos | |||
| 10452 | int line_height, line_start_x = 0, reached = 0; | 10641 | int line_height, line_start_x = 0, reached = 0; |
| 10453 | int max_current_x = 0; | 10642 | int max_current_x = 0; |
| 10454 | void *backup_data = NULL; | 10643 | void *backup_data = NULL; |
| 10455 | ptrdiff_t orig_charpos = -1; | ||
| 10456 | enum it_method orig_method = NUM_IT_METHODS; | ||
| 10457 | 10644 | ||
| 10458 | for (;;) | 10645 | for (;;) |
| 10459 | { | 10646 | { |
| 10460 | orig_charpos = IT_CHARPOS (*it); | ||
| 10461 | orig_method = it->method; | ||
| 10462 | if (op & MOVE_TO_VPOS) | 10647 | if (op & MOVE_TO_VPOS) |
| 10463 | { | 10648 | { |
| 10464 | /* If no TO_CHARPOS and no TO_X specified, stop at the | 10649 | /* If no TO_CHARPOS and no TO_X specified, stop at the |
| @@ -10730,21 +10915,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos | |||
| 10730 | } | 10915 | } |
| 10731 | } | 10916 | } |
| 10732 | else | 10917 | else |
| 10733 | { | 10918 | it->continuation_lines_width += it->current_x; |
| 10734 | /* Make sure we do advance, otherwise we might infloop. | ||
| 10735 | This could happen when the first display element is | ||
| 10736 | wider than the window, or if we have a wrap-prefix | ||
| 10737 | that doesn't leave enough space after it to display | ||
| 10738 | even a single character. We only do this for moving | ||
| 10739 | through buffer text, as with display/overlay strings | ||
| 10740 | we'd need to also compare it->object's, and this is | ||
| 10741 | unlikely to happen in that case anyway. */ | ||
| 10742 | if (IT_CHARPOS (*it) == orig_charpos | ||
| 10743 | && it->method == orig_method | ||
| 10744 | && orig_method == GET_FROM_BUFFER) | ||
| 10745 | set_iterator_to_next (it, false); | ||
| 10746 | it->continuation_lines_width += it->current_x; | ||
| 10747 | } | ||
| 10748 | break; | 10919 | break; |
| 10749 | 10920 | ||
| 10750 | default: | 10921 | default: |
| @@ -10753,6 +10924,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos | |||
| 10753 | 10924 | ||
| 10754 | /* Reset/increment for the next run. */ | 10925 | /* Reset/increment for the next run. */ |
| 10755 | it->current_x = line_start_x; | 10926 | it->current_x = line_start_x; |
| 10927 | it->wrap_prefix_width = 0; | ||
| 10756 | line_start_x = 0; | 10928 | line_start_x = 0; |
| 10757 | it->hpos = 0; | 10929 | it->hpos = 0; |
| 10758 | it->line_number_produced_p = false; | 10930 | it->line_number_produced_p = false; |
| @@ -10783,6 +10955,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos | |||
| 10783 | { | 10955 | { |
| 10784 | it->continuation_lines_width += it->current_x; | 10956 | it->continuation_lines_width += it->current_x; |
| 10785 | it->current_x = it->hpos = it->max_ascent = it->max_descent = 0; | 10957 | it->current_x = it->hpos = it->max_ascent = it->max_descent = 0; |
| 10958 | it->wrap_prefix_width = 0; | ||
| 10786 | it->current_y += it->max_ascent + it->max_descent; | 10959 | it->current_y += it->max_ascent + it->max_descent; |
| 10787 | ++it->vpos; | 10960 | ++it->vpos; |
| 10788 | last_height = it->max_ascent + it->max_descent; | 10961 | last_height = it->max_ascent + it->max_descent; |
| @@ -10842,6 +11015,7 @@ move_it_vertically_backward (struct it *it, int dy) | |||
| 10842 | reseat_1 (it, it->current.pos, true); | 11015 | reseat_1 (it, it->current.pos, true); |
| 10843 | 11016 | ||
| 10844 | /* We are now surely at a line start. */ | 11017 | /* We are now surely at a line start. */ |
| 11018 | it->wrap_prefix_width = 0; | ||
| 10845 | it->current_x = it->hpos = 0; /* FIXME: this is incorrect when bidi | 11019 | it->current_x = it->hpos = 0; /* FIXME: this is incorrect when bidi |
| 10846 | reordering is in effect. */ | 11020 | reordering is in effect. */ |
| 10847 | it->continuation_lines_width = 0; | 11021 | it->continuation_lines_width = 0; |
| @@ -11120,7 +11294,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos) | |||
| 11120 | dvpos--; | 11294 | dvpos--; |
| 11121 | } | 11295 | } |
| 11122 | 11296 | ||
| 11123 | it->current_x = it->hpos = 0; | 11297 | it->current_x = it->hpos = it->wrap_prefix_width = 0; |
| 11124 | 11298 | ||
| 11125 | /* Above call may have moved too far if continuation lines | 11299 | /* Above call may have moved too far if continuation lines |
| 11126 | are involved. Scan forward and see if it did. */ | 11300 | are involved. Scan forward and see if it did. */ |
| @@ -11129,7 +11303,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos) | |||
| 11129 | move_it_to (&it2, start_charpos, -1, -1, -1, MOVE_TO_POS); | 11303 | move_it_to (&it2, start_charpos, -1, -1, -1, MOVE_TO_POS); |
| 11130 | it->vpos -= it2.vpos; | 11304 | it->vpos -= it2.vpos; |
| 11131 | it->current_y -= it2.current_y; | 11305 | it->current_y -= it2.current_y; |
| 11132 | it->current_x = it->hpos = 0; | 11306 | it->current_x = it->hpos = it->wrap_prefix_width = 0; |
| 11133 | 11307 | ||
| 11134 | /* If we moved too far back, move IT some lines forward. */ | 11308 | /* If we moved too far back, move IT some lines forward. */ |
| 11135 | if (it2.vpos > -dvpos) | 11309 | if (it2.vpos > -dvpos) |
| @@ -11408,7 +11582,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, | |||
| 11408 | IT.current_x will be incorrectly set to zero at some arbitrary | 11582 | IT.current_x will be incorrectly set to zero at some arbitrary |
| 11409 | non-zero X coordinate. */ | 11583 | non-zero X coordinate. */ |
| 11410 | move_it_by_lines (&it, 0); | 11584 | move_it_by_lines (&it, 0); |
| 11411 | it.current_x = it.hpos = 0; | 11585 | it.current_x = it.hpos = it.wrap_prefix_width = 0; |
| 11412 | if (IT_CHARPOS (it) != start) | 11586 | if (IT_CHARPOS (it) != start) |
| 11413 | { | 11587 | { |
| 11414 | void *it1data = NULL; | 11588 | void *it1data = NULL; |
| @@ -11461,7 +11635,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, | |||
| 11461 | /* If FROM is on a newline, pretend that we start at the beginning | 11635 | /* If FROM is on a newline, pretend that we start at the beginning |
| 11462 | of the next line, because the newline takes no place on display. */ | 11636 | of the next line, because the newline takes no place on display. */ |
| 11463 | if (FETCH_BYTE (start) == '\n') | 11637 | if (FETCH_BYTE (start) == '\n') |
| 11464 | it.current_x = 0; | 11638 | it.current_x = 0, it.wrap_prefix_width = 0; |
| 11465 | if (!NILP (x_limit)) | 11639 | if (!NILP (x_limit)) |
| 11466 | { | 11640 | { |
| 11467 | it.last_visible_x = max_x; | 11641 | it.last_visible_x = max_x; |
| @@ -14373,7 +14547,7 @@ display_tab_bar_line (struct it *it, int height) | |||
| 14373 | row->truncated_on_left_p = false; | 14547 | row->truncated_on_left_p = false; |
| 14374 | row->truncated_on_right_p = false; | 14548 | row->truncated_on_right_p = false; |
| 14375 | 14549 | ||
| 14376 | it->current_x = it->hpos = 0; | 14550 | it->current_x = it->hpos = it->wrap_prefix_width = 0; |
| 14377 | it->current_y += row->height; | 14551 | it->current_y += row->height; |
| 14378 | ++it->vpos; | 14552 | ++it->vpos; |
| 14379 | ++it->glyph_row; | 14553 | ++it->glyph_row; |
| @@ -15397,7 +15571,7 @@ display_tool_bar_line (struct it *it, int height) | |||
| 15397 | row->truncated_on_left_p = false; | 15571 | row->truncated_on_left_p = false; |
| 15398 | row->truncated_on_right_p = false; | 15572 | row->truncated_on_right_p = false; |
| 15399 | 15573 | ||
| 15400 | it->current_x = it->hpos = 0; | 15574 | it->current_x = it->hpos = it->wrap_prefix_width = 0; |
| 15401 | it->current_y += row->height; | 15575 | it->current_y += row->height; |
| 15402 | ++it->vpos; | 15576 | ++it->vpos; |
| 15403 | ++it->glyph_row; | 15577 | ++it->glyph_row; |
| @@ -17097,6 +17271,7 @@ redisplay_internal (void) | |||
| 17097 | NULL, DEFAULT_FACE_ID); | 17271 | NULL, DEFAULT_FACE_ID); |
| 17098 | it.current_x = this_line_start_x; | 17272 | it.current_x = this_line_start_x; |
| 17099 | it.current_y = this_line_y; | 17273 | it.current_y = this_line_y; |
| 17274 | it.wrap_prefix_width = 0; | ||
| 17100 | it.vpos = this_line_vpos; | 17275 | it.vpos = this_line_vpos; |
| 17101 | 17276 | ||
| 17102 | if (current_buffer->long_line_optimizations_p | 17277 | if (current_buffer->long_line_optimizations_p |
| @@ -18682,6 +18857,14 @@ enum | |||
| 18682 | `scroll-conservatively' and the Emacs manual. */ | 18857 | `scroll-conservatively' and the Emacs manual. */ |
| 18683 | #define SCROLL_LIMIT 100 | 18858 | #define SCROLL_LIMIT 100 |
| 18684 | 18859 | ||
| 18860 | /* The freshness of the w->base_line_number cache is only ensured at every | ||
| 18861 | redisplay cycle, so the cache can be used only if there's been | ||
| 18862 | no relevant changes to the buffer since the last redisplay. */ | ||
| 18863 | #define BASE_LINE_NUMBER_VALID_P(w) \ | ||
| 18864 | (eassert (current_buffer == XBUFFER ((w)->contents)), \ | ||
| 18865 | !current_buffer->clip_changed \ | ||
| 18866 | && BEG_UNCHANGED >= (w)->base_line_pos) | ||
| 18867 | |||
| 18685 | static int | 18868 | static int |
| 18686 | try_scrolling (Lisp_Object window, bool just_this_one_p, | 18869 | try_scrolling (Lisp_Object window, bool just_this_one_p, |
| 18687 | intmax_t arg_scroll_conservatively, intmax_t scroll_step, | 18870 | intmax_t arg_scroll_conservatively, intmax_t scroll_step, |
| @@ -18982,9 +19165,10 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, | |||
| 18982 | else | 19165 | else |
| 18983 | { | 19166 | { |
| 18984 | /* Maybe forget recorded base line for line number display. */ | 19167 | /* Maybe forget recorded base line for line number display. */ |
| 18985 | if (!just_this_one_p | 19168 | /* FIXME: Why do we need this? `try_scrolling` can only be called from |
| 18986 | || current_buffer->clip_changed | 19169 | `redisplay_window` which should have flushed this cache already when |
| 18987 | || BEG_UNCHANGED < CHARPOS (startp)) | 19170 | eeded. */ |
| 19171 | if (!BASE_LINE_NUMBER_VALID_P (w)) | ||
| 18988 | w->base_line_number = 0; | 19172 | w->base_line_number = 0; |
| 18989 | 19173 | ||
| 18990 | /* If cursor ends up on a partially visible line, | 19174 | /* If cursor ends up on a partially visible line, |
| @@ -19754,9 +19938,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 19754 | /* Record it now because it's overwritten. */ | 19938 | /* Record it now because it's overwritten. */ |
| 19755 | bool current_matrix_up_to_date_p = false; | 19939 | bool current_matrix_up_to_date_p = false; |
| 19756 | bool used_current_matrix_p = false; | 19940 | bool used_current_matrix_p = false; |
| 19757 | /* This is less strict than current_matrix_up_to_date_p. | ||
| 19758 | It indicates that the buffer contents and narrowing are unchanged. */ | ||
| 19759 | bool buffer_unchanged_p = false; | ||
| 19760 | bool temp_scroll_step = false; | 19941 | bool temp_scroll_step = false; |
| 19761 | specpdl_ref count = SPECPDL_INDEX (); | 19942 | specpdl_ref count = SPECPDL_INDEX (); |
| 19762 | int rc; | 19943 | int rc; |
| @@ -19862,11 +20043,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 19862 | 20043 | ||
| 19863 | specbind (Qinhibit_point_motion_hooks, Qt); | 20044 | specbind (Qinhibit_point_motion_hooks, Qt); |
| 19864 | 20045 | ||
| 19865 | buffer_unchanged_p | ||
| 19866 | = (w->window_end_valid | ||
| 19867 | && !current_buffer->clip_changed | ||
| 19868 | && !window_outdated (w)); | ||
| 19869 | |||
| 19870 | /* When windows_or_buffers_changed is non-zero, we can't rely | 20046 | /* When windows_or_buffers_changed is non-zero, we can't rely |
| 19871 | on the window end being valid, so set it to zero there. */ | 20047 | on the window end being valid, so set it to zero there. */ |
| 19872 | if (windows_or_buffers_changed) | 20048 | if (windows_or_buffers_changed) |
| @@ -20006,6 +20182,10 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 20006 | } | 20182 | } |
| 20007 | } | 20183 | } |
| 20008 | 20184 | ||
| 20185 | if (!BASE_LINE_NUMBER_VALID_P (w)) | ||
| 20186 | /* Forget any recorded base line for line number display. */ | ||
| 20187 | w->base_line_number = 0; | ||
| 20188 | |||
| 20009 | force_start: | 20189 | force_start: |
| 20010 | 20190 | ||
| 20011 | /* Handle case where place to start displaying has been specified, | 20191 | /* Handle case where place to start displaying has been specified, |
| @@ -20026,10 +20206,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 20026 | w->preserve_vscroll_p = false; | 20206 | w->preserve_vscroll_p = false; |
| 20027 | w->window_end_valid = false; | 20207 | w->window_end_valid = false; |
| 20028 | 20208 | ||
| 20029 | /* Forget any recorded base line for line number display. */ | ||
| 20030 | if (!buffer_unchanged_p) | ||
| 20031 | w->base_line_number = 0; | ||
| 20032 | |||
| 20033 | /* Redisplay the mode line. Select the buffer properly for that. | 20209 | /* Redisplay the mode line. Select the buffer properly for that. |
| 20034 | Also, run the hook window-scroll-functions | 20210 | Also, run the hook window-scroll-functions |
| 20035 | because we have scrolled. */ | 20211 | because we have scrolled. */ |
| @@ -20358,12 +20534,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 20358 | 20534 | ||
| 20359 | if (w->cursor.vpos >= 0) | 20535 | if (w->cursor.vpos >= 0) |
| 20360 | { | 20536 | { |
| 20361 | if (!just_this_one_p | ||
| 20362 | || current_buffer->clip_changed | ||
| 20363 | || BEG_UNCHANGED < CHARPOS (startp)) | ||
| 20364 | /* Forget any recorded base line for line number display. */ | ||
| 20365 | w->base_line_number = 0; | ||
| 20366 | |||
| 20367 | if (!cursor_row_fully_visible_p (w, true, false, false)) | 20537 | if (!cursor_row_fully_visible_p (w, true, false, false)) |
| 20368 | { | 20538 | { |
| 20369 | clear_glyph_matrix (w->desired_matrix); | 20539 | clear_glyph_matrix (w->desired_matrix); |
| @@ -20434,10 +20604,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 20434 | debug_method_add (w, "recenter"); | 20604 | debug_method_add (w, "recenter"); |
| 20435 | #endif | 20605 | #endif |
| 20436 | 20606 | ||
| 20437 | /* Forget any previously recorded base line for line number display. */ | ||
| 20438 | if (!buffer_unchanged_p) | ||
| 20439 | w->base_line_number = 0; | ||
| 20440 | |||
| 20441 | /* Determine the window start relative to point. */ | 20607 | /* Determine the window start relative to point. */ |
| 20442 | init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID); | 20608 | init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID); |
| 20443 | it.current_y = it.last_visible_y; | 20609 | it.current_y = it.last_visible_y; |
| @@ -20543,7 +20709,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 20543 | it.current_y = 0; | 20709 | it.current_y = 0; |
| 20544 | } | 20710 | } |
| 20545 | 20711 | ||
| 20546 | it.current_x = it.hpos = 0; | 20712 | it.current_x = it.wrap_prefix_width = it.hpos = 0; |
| 20547 | 20713 | ||
| 20548 | /* Set the window start position here explicitly, to avoid an | 20714 | /* Set the window start position here explicitly, to avoid an |
| 20549 | infinite loop in case the functions in window-scroll-functions | 20715 | infinite loop in case the functions in window-scroll-functions |
| @@ -22511,7 +22677,7 @@ try_window_id (struct window *w) | |||
| 22511 | /* We may start in a continuation line. If so, we have to | 22677 | /* We may start in a continuation line. If so, we have to |
| 22512 | get the right continuation_lines_width and current_x. */ | 22678 | get the right continuation_lines_width and current_x. */ |
| 22513 | it.continuation_lines_width = last_row->continuation_lines_width; | 22679 | it.continuation_lines_width = last_row->continuation_lines_width; |
| 22514 | it.hpos = it.current_x = 0; | 22680 | it.hpos = it.current_x = it.wrap_prefix_width = 0; |
| 22515 | 22681 | ||
| 22516 | /* Display the rest of the lines at the window end. */ | 22682 | /* Display the rest of the lines at the window end. */ |
| 22517 | it.glyph_row = MATRIX_ROW (desired_matrix, it.vpos); | 22683 | it.glyph_row = MATRIX_ROW (desired_matrix, it.vpos); |
| @@ -23116,6 +23282,7 @@ insert_left_trunc_glyphs (struct it *it) | |||
| 23116 | /* Get the truncation glyphs. */ | 23282 | /* Get the truncation glyphs. */ |
| 23117 | truncate_it = *it; | 23283 | truncate_it = *it; |
| 23118 | truncate_it.current_x = 0; | 23284 | truncate_it.current_x = 0; |
| 23285 | truncate_it.wrap_prefix_width = 0; | ||
| 23119 | truncate_it.face_id = DEFAULT_FACE_ID; | 23286 | truncate_it.face_id = DEFAULT_FACE_ID; |
| 23120 | truncate_it.glyph_row = &scratch_glyph_row; | 23287 | truncate_it.glyph_row = &scratch_glyph_row; |
| 23121 | truncate_it.area = TEXT_AREA; | 23288 | truncate_it.area = TEXT_AREA; |
| @@ -23878,6 +24045,10 @@ extend_face_to_end_of_line (struct it *it) | |||
| 23878 | for (it->current_x = 0; g < e; g++) | 24045 | for (it->current_x = 0; g < e; g++) |
| 23879 | it->current_x += g->pixel_width; | 24046 | it->current_x += g->pixel_width; |
| 23880 | 24047 | ||
| 24048 | if (it->continuation_lines_width | ||
| 24049 | && it->string_from_prefix_prop_p) | ||
| 24050 | it->wrap_prefix_width = it->current_x; | ||
| 24051 | |||
| 23881 | it->area = LEFT_MARGIN_AREA; | 24052 | it->area = LEFT_MARGIN_AREA; |
| 23882 | it->face_id = default_face->id; | 24053 | it->face_id = default_face->id; |
| 23883 | while (it->glyph_row->used[LEFT_MARGIN_AREA] | 24054 | while (it->glyph_row->used[LEFT_MARGIN_AREA] |
| @@ -24599,6 +24770,13 @@ maybe_produce_line_number (struct it *it) | |||
| 24599 | if (!last_line) | 24770 | if (!last_line) |
| 24600 | { | 24771 | { |
| 24601 | /* If possible, reuse data cached by line-number-mode. */ | 24772 | /* If possible, reuse data cached by line-number-mode. */ |
| 24773 | /* NOTE: We use `base_line_number` without checking | ||
| 24774 | BASE_LINE_NUMBER_VALID_P because we assume that `redisplay_window` | ||
| 24775 | has already flushed this cache for us when needed. | ||
| 24776 | NOTE2: Checking BASE_LINE_NUMBER_VALID_P here would be | ||
| 24777 | overly pessimistic because it might say that the cache | ||
| 24778 | was invalid before entering `redisplay_window` yet the | ||
| 24779 | value has just been refreshed. */ | ||
| 24602 | if (it->w->base_line_number > 0 | 24780 | if (it->w->base_line_number > 0 |
| 24603 | && it->w->base_line_pos > 0 | 24781 | && it->w->base_line_pos > 0 |
| 24604 | && it->w->base_line_pos <= IT_CHARPOS (*it) | 24782 | && it->w->base_line_pos <= IT_CHARPOS (*it) |
| @@ -24878,7 +25056,7 @@ should_produce_line_number (struct it *it) | |||
| 24878 | because get-char-property always returns nil for ZV, except if | 25056 | because get-char-property always returns nil for ZV, except if |
| 24879 | the property is in 'default-text-properties'. */ | 25057 | the property is in 'default-text-properties'. */ |
| 24880 | if (NILP (val) && IT_CHARPOS (*it) >= ZV) | 25058 | if (NILP (val) && IT_CHARPOS (*it) >= ZV) |
| 24881 | val = disable_line_numbers_overlay_at_eob (); | 25059 | return !disable_line_numbers_overlay_at_eob (); |
| 24882 | return NILP (val) ? true : false; | 25060 | return NILP (val) ? true : false; |
| 24883 | } | 25061 | } |
| 24884 | 25062 | ||
| @@ -24943,6 +25121,7 @@ display_line (struct it *it, int cursor_vpos) | |||
| 24943 | int first_visible_x = it->first_visible_x; | 25121 | int first_visible_x = it->first_visible_x; |
| 24944 | int last_visible_x = it->last_visible_x; | 25122 | int last_visible_x = it->last_visible_x; |
| 24945 | int x_incr = 0; | 25123 | int x_incr = 0; |
| 25124 | int this_line_subject_to_line_prefix = 0; | ||
| 24946 | 25125 | ||
| 24947 | /* We always start displaying at hpos zero even if hscrolled. */ | 25126 | /* We always start displaying at hpos zero even if hscrolled. */ |
| 24948 | eassert (it->hpos == 0 && it->current_x == 0); | 25127 | eassert (it->hpos == 0 && it->current_x == 0); |
| @@ -25019,7 +25198,10 @@ display_line (struct it *it, int cursor_vpos) | |||
| 25019 | if (it->current_x < it->first_visible_x | 25198 | if (it->current_x < it->first_visible_x |
| 25020 | && (move_result == MOVE_NEWLINE_OR_CR | 25199 | && (move_result == MOVE_NEWLINE_OR_CR |
| 25021 | || move_result == MOVE_POS_MATCH_OR_ZV)) | 25200 | || move_result == MOVE_POS_MATCH_OR_ZV)) |
| 25022 | it->current_x = it->first_visible_x; | 25201 | { |
| 25202 | it->current_x = it->first_visible_x; | ||
| 25203 | it->wrap_prefix_width = 0; | ||
| 25204 | } | ||
| 25023 | 25205 | ||
| 25024 | /* In case move_it_in_display_line_to above "produced" the line | 25206 | /* In case move_it_in_display_line_to above "produced" the line |
| 25025 | number. */ | 25207 | number. */ |
| @@ -25048,6 +25230,7 @@ display_line (struct it *it, int cursor_vpos) | |||
| 25048 | /* We only do this when not calling move_it_in_display_line_to | 25230 | /* We only do this when not calling move_it_in_display_line_to |
| 25049 | above, because that function calls itself handle_line_prefix. */ | 25231 | above, because that function calls itself handle_line_prefix. */ |
| 25050 | handle_line_prefix (it); | 25232 | handle_line_prefix (it); |
| 25233 | this_line_subject_to_line_prefix = it->string_from_prefix_prop_p; | ||
| 25051 | } | 25234 | } |
| 25052 | else | 25235 | else |
| 25053 | { | 25236 | { |
| @@ -25214,12 +25397,15 @@ display_line (struct it *it, int cursor_vpos) | |||
| 25214 | process the prefix now. */ | 25397 | process the prefix now. */ |
| 25215 | if (it->area == TEXT_AREA && pending_handle_line_prefix) | 25398 | if (it->area == TEXT_AREA && pending_handle_line_prefix) |
| 25216 | { | 25399 | { |
| 25217 | /* Line numbers should precede the line-prefix or wrap-prefix. */ | 25400 | /* Line numbers should precede the line-prefix or |
| 25401 | wrap-prefix. */ | ||
| 25218 | if (line_number_needed) | 25402 | if (line_number_needed) |
| 25219 | maybe_produce_line_number (it); | 25403 | maybe_produce_line_number (it); |
| 25220 | 25404 | ||
| 25221 | pending_handle_line_prefix = false; | 25405 | pending_handle_line_prefix = false; |
| 25222 | handle_line_prefix (it); | 25406 | handle_line_prefix (it); |
| 25407 | this_line_subject_to_line_prefix | ||
| 25408 | = it->string_from_prefix_prop_p; | ||
| 25223 | } | 25409 | } |
| 25224 | continue; | 25410 | continue; |
| 25225 | } | 25411 | } |
| @@ -25240,7 +25426,16 @@ display_line (struct it *it, int cursor_vpos) | |||
| 25240 | if (/* Not a newline. */ | 25426 | if (/* Not a newline. */ |
| 25241 | nglyphs > 0 | 25427 | nglyphs > 0 |
| 25242 | /* Glyphs produced fit entirely in the line. */ | 25428 | /* Glyphs produced fit entirely in the line. */ |
| 25243 | && it->current_x < it->last_visible_x) | 25429 | && (it->current_x < it->last_visible_x |
| 25430 | /* Or a line or wrap prefix is in effect, and not | ||
| 25431 | truncating the glyph produced immediately after it | ||
| 25432 | would cause an infinite cycle. */ | ||
| 25433 | || (it->line_wrap != TRUNCATE | ||
| 25434 | /* This code is not valid if multiple glyphs were | ||
| 25435 | produced, as some of these glyphs might remain | ||
| 25436 | within this line. */ | ||
| 25437 | && nglyphs == 1 | ||
| 25438 | && this_line_subject_to_line_prefix))) | ||
| 25244 | { | 25439 | { |
| 25245 | it->hpos += nglyphs; | 25440 | it->hpos += nglyphs; |
| 25246 | row->ascent = max (row->ascent, it->max_ascent); | 25441 | row->ascent = max (row->ascent, it->max_ascent); |
| @@ -25291,7 +25486,20 @@ display_line (struct it *it, int cursor_vpos) | |||
| 25291 | && FRAME_WINDOW_P (it->f) | 25486 | && FRAME_WINDOW_P (it->f) |
| 25292 | && (row->reversed_p | 25487 | && (row->reversed_p |
| 25293 | ? WINDOW_LEFT_FRINGE_WIDTH (it->w) | 25488 | ? WINDOW_LEFT_FRINGE_WIDTH (it->w) |
| 25294 | : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))) | 25489 | : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))) |
| 25490 | /* There is no line prefix, next to which the | ||
| 25491 | iterator _must_ produce a minimum of one actual | ||
| 25492 | glyph. */ | ||
| 25493 | && (!this_line_subject_to_line_prefix | ||
| 25494 | /* Or this is the second glyph to be produced | ||
| 25495 | beyond the confines of the line. */ | ||
| 25496 | || (i != 0 | ||
| 25497 | && (x > it->last_visible_x | ||
| 25498 | || (x == it->last_visible_x | ||
| 25499 | && FRAME_WINDOW_P (it->f) | ||
| 25500 | && (row->reversed_p | ||
| 25501 | ? WINDOW_LEFT_FRINGE_WIDTH (it->w) | ||
| 25502 | : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))))) | ||
| 25295 | { | 25503 | { |
| 25296 | /* End of a continued line. */ | 25504 | /* End of a continued line. */ |
| 25297 | 25505 | ||
| @@ -25588,24 +25796,23 @@ display_line (struct it *it, int cursor_vpos) | |||
| 25588 | break; | 25796 | break; |
| 25589 | } | 25797 | } |
| 25590 | 25798 | ||
| 25591 | /* Detect overly-wide wrap-prefixes made of (space ...) display | ||
| 25592 | properties. When such a wrap prefix reaches past the right | ||
| 25593 | margin of the window, we need to avoid the call to | ||
| 25594 | set_iterator_to_next below, so that it->line_wrap is left at | ||
| 25595 | its TRUNCATE value wisely set by handle_line_prefix. | ||
| 25596 | Otherwise, set_iterator_to_next will pop the iterator stack, | ||
| 25597 | restore it->line_wrap, and redisplay might infloop. */ | ||
| 25598 | bool overwide_wrap_prefix = | ||
| 25599 | CONSP (it->object) && EQ (XCAR (it->object), Qspace) | ||
| 25600 | && it->sp > 0 && it->method == GET_FROM_STRETCH | ||
| 25601 | && it->current_x >= it->last_visible_x | ||
| 25602 | && it->continuation_lines_width > 0 | ||
| 25603 | && it->line_wrap == TRUNCATE && it->stack[0].line_wrap != TRUNCATE; | ||
| 25604 | |||
| 25605 | /* Proceed with next display element. Note that this skips | 25799 | /* Proceed with next display element. Note that this skips |
| 25606 | over lines invisible because of selective display. */ | 25800 | over lines invisible because of selective display. */ |
| 25607 | if (!overwide_wrap_prefix) | 25801 | set_iterator_to_next (it, true); |
| 25608 | set_iterator_to_next (it, true); | 25802 | |
| 25803 | /* If IT has just finished producing glyphs for the wrap prefix | ||
| 25804 | and is proceeding to the next method, there might not be | ||
| 25805 | sufficient space remaining in this line to accommodate its | ||
| 25806 | glyphs, and one real glyph must be produced to prevent an | ||
| 25807 | infinite loop. Next, clear this flag if such a glyph has | ||
| 25808 | already been produced. */ | ||
| 25809 | |||
| 25810 | if (this_line_subject_to_line_prefix == 1 | ||
| 25811 | && !it->string_from_prefix_prop_p) | ||
| 25812 | this_line_subject_to_line_prefix = 2; | ||
| 25813 | else if (this_line_subject_to_line_prefix == 2 | ||
| 25814 | && !it->string_from_prefix_prop_p) | ||
| 25815 | this_line_subject_to_line_prefix = 0; | ||
| 25609 | 25816 | ||
| 25610 | /* If we truncate lines, we are done when the last displayed | 25817 | /* If we truncate lines, we are done when the last displayed |
| 25611 | glyphs reach past the right margin of the window. */ | 25818 | glyphs reach past the right margin of the window. */ |
| @@ -25851,7 +26058,7 @@ display_line (struct it *it, int cursor_vpos) | |||
| 25851 | HPOS) = (0 0). Vertical positions are incremented. As a | 26058 | HPOS) = (0 0). Vertical positions are incremented. As a |
| 25852 | convenience for the caller, IT->glyph_row is set to the next | 26059 | convenience for the caller, IT->glyph_row is set to the next |
| 25853 | row to be used. */ | 26060 | row to be used. */ |
| 25854 | it->current_x = it->hpos = 0; | 26061 | it->wrap_prefix_width = it->current_x = it->hpos = 0; |
| 25855 | it->current_y += row->height; | 26062 | it->current_y += row->height; |
| 25856 | /* Restore the first and last visible X if we adjusted them for | 26063 | /* Restore the first and last visible X if we adjusted them for |
| 25857 | current-line hscrolling. */ | 26064 | current-line hscrolling. */ |
| @@ -26330,7 +26537,7 @@ Value is the new character position of point. */) | |||
| 26330 | { | 26537 | { |
| 26331 | struct text_pos pt; | 26538 | struct text_pos pt; |
| 26332 | struct it it; | 26539 | struct it it; |
| 26333 | int pt_x, target_x, pixel_width, pt_vpos; | 26540 | int pt_x, pt_wrap_prefix_x, target_x, pixel_width, pt_vpos; |
| 26334 | bool at_eol_p; | 26541 | bool at_eol_p; |
| 26335 | bool overshoot_expected = false; | 26542 | bool overshoot_expected = false; |
| 26336 | bool target_is_eol_p = false; | 26543 | bool target_is_eol_p = false; |
| @@ -26362,6 +26569,7 @@ Value is the new character position of point. */) | |||
| 26362 | reseat: | 26569 | reseat: |
| 26363 | reseat_at_previous_visible_line_start (&it); | 26570 | reseat_at_previous_visible_line_start (&it); |
| 26364 | it.current_x = it.hpos = it.current_y = it.vpos = 0; | 26571 | it.current_x = it.hpos = it.current_y = it.vpos = 0; |
| 26572 | it.wrap_prefix_width = 0; | ||
| 26365 | if (IT_CHARPOS (it) != PT) | 26573 | if (IT_CHARPOS (it) != PT) |
| 26366 | { | 26574 | { |
| 26367 | move_it_to (&it, overshoot_expected ? PT - 1 : PT, | 26575 | move_it_to (&it, overshoot_expected ? PT - 1 : PT, |
| @@ -26380,6 +26588,7 @@ Value is the new character position of point. */) | |||
| 26380 | move_it_in_display_line (&it, PT, -1, MOVE_TO_POS); | 26588 | move_it_in_display_line (&it, PT, -1, MOVE_TO_POS); |
| 26381 | } | 26589 | } |
| 26382 | pt_x = it.current_x; | 26590 | pt_x = it.current_x; |
| 26591 | pt_wrap_prefix_x = it.wrap_prefix_width; | ||
| 26383 | pt_vpos = it.vpos; | 26592 | pt_vpos = it.vpos; |
| 26384 | if (dir > 0 || overshoot_expected) | 26593 | if (dir > 0 || overshoot_expected) |
| 26385 | { | 26594 | { |
| @@ -26394,10 +26603,11 @@ Value is the new character position of point. */) | |||
| 26394 | it.glyph_row = NULL; | 26603 | it.glyph_row = NULL; |
| 26395 | PRODUCE_GLYPHS (&it); /* compute it.pixel_width */ | 26604 | PRODUCE_GLYPHS (&it); /* compute it.pixel_width */ |
| 26396 | it.glyph_row = row; | 26605 | it.glyph_row = row; |
| 26397 | /* PRODUCE_GLYPHS advances it.current_x, so we must restore | 26606 | /* PRODUCE_GLYPHS advances it.current_x, so it must be |
| 26398 | it, lest it will become out of sync with it's buffer | 26607 | restored, lest it become out of sync with its buffer |
| 26399 | position. */ | 26608 | position. */ |
| 26400 | it.current_x = pt_x; | 26609 | it.current_x = pt_x; |
| 26610 | it.wrap_prefix_width = pt_wrap_prefix_x; | ||
| 26401 | } | 26611 | } |
| 26402 | else | 26612 | else |
| 26403 | at_eol_p = ITERATOR_AT_END_OF_LINE_P (&it); | 26613 | at_eol_p = ITERATOR_AT_END_OF_LINE_P (&it); |
| @@ -26442,6 +26652,7 @@ Value is the new character position of point. */) | |||
| 26442 | it.last_visible_x = DISP_INFINITY; | 26652 | it.last_visible_x = DISP_INFINITY; |
| 26443 | reseat_at_previous_visible_line_start (&it); | 26653 | reseat_at_previous_visible_line_start (&it); |
| 26444 | it.current_x = it.current_y = it.hpos = 0; | 26654 | it.current_x = it.current_y = it.hpos = 0; |
| 26655 | it.wrap_prefix_width = 0; | ||
| 26445 | if (pt_vpos != 0) | 26656 | if (pt_vpos != 0) |
| 26446 | move_it_by_lines (&it, pt_vpos); | 26657 | move_it_by_lines (&it, pt_vpos); |
| 26447 | } | 26658 | } |
| @@ -27958,6 +28169,11 @@ are the selected window and the WINDOW's buffer). */) | |||
| 27958 | 28169 | ||
| 27959 | init_iterator (&it, w, -1, -1, NULL, face_id); | 28170 | init_iterator (&it, w, -1, -1, NULL, face_id); |
| 27960 | 28171 | ||
| 28172 | /* Make sure `base_line_number` is fresh in case we encounter a `%l`. */ | ||
| 28173 | if (current_buffer == XBUFFER ((w)->contents) | ||
| 28174 | && !BASE_LINE_NUMBER_VALID_P (w)) | ||
| 28175 | w->base_line_number = 0; | ||
| 28176 | |||
| 27961 | if (no_props) | 28177 | if (no_props) |
| 27962 | { | 28178 | { |
| 27963 | mode_line_target = MODE_LINE_NOPROP; | 28179 | mode_line_target = MODE_LINE_NOPROP; |
| @@ -28410,30 +28626,29 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 28410 | when the buffer's restriction was changed, but the window | 28626 | when the buffer's restriction was changed, but the window |
| 28411 | wasn't yet redisplayed after that. If that happens, we | 28627 | wasn't yet redisplayed after that. If that happens, we |
| 28412 | need to determine a new base line. */ | 28628 | need to determine a new base line. */ |
| 28413 | if (!(BUF_BEGV_BYTE (b) <= startpos_byte | 28629 | if (current_buffer != XBUFFER (w->contents) |
| 28630 | || !(BUF_BEGV_BYTE (b) <= startpos_byte | ||
| 28414 | && startpos_byte <= BUF_ZV_BYTE (b))) | 28631 | && startpos_byte <= BUF_ZV_BYTE (b))) |
| 28415 | { | 28632 | { |
| 28416 | startpos = BUF_BEGV (b); | 28633 | startpos = BUF_BEGV (b); |
| 28417 | startpos_byte = BUF_BEGV_BYTE (b); | 28634 | startpos_byte = BUF_BEGV_BYTE (b); |
| 28418 | w->base_line_pos = 0; | ||
| 28419 | w->base_line_number = 0; | ||
| 28420 | } | 28635 | } |
| 28421 | 28636 | ||
| 28422 | /* If we decided that this buffer isn't suitable for line numbers, | 28637 | /* If we decided that this buffer isn't suitable for line numbers, |
| 28423 | don't forget that too fast. */ | 28638 | don't forget that too fast. |
| 28639 | FIXME: What if `current_buffer != w->contents`? */ | ||
| 28424 | if (w->base_line_pos == -1) | 28640 | if (w->base_line_pos == -1) |
| 28425 | goto no_value; | 28641 | goto no_value; |
| 28426 | 28642 | ||
| 28427 | /* If the buffer is very big, don't waste time. */ | 28643 | /* If the buffer is very big, don't waste time. */ |
| 28428 | if (FIXNUMP (Vline_number_display_limit) | 28644 | if (FIXNUMP (Vline_number_display_limit) |
| 28429 | && BUF_ZV (b) - BUF_BEGV (b) > XFIXNUM (Vline_number_display_limit)) | 28645 | && BUF_ZV (b) - BUF_BEGV (b) > XFIXNUM (Vline_number_display_limit)) |
| 28430 | { | 28646 | goto no_value; |
| 28431 | w->base_line_pos = 0; | ||
| 28432 | w->base_line_number = 0; | ||
| 28433 | goto no_value; | ||
| 28434 | } | ||
| 28435 | 28647 | ||
| 28436 | if (w->base_line_number > 0 | 28648 | /* Callers of `display_mode_element` are in charge of flushing |
| 28649 | any stale `base_line_number` cache. */ | ||
| 28650 | if (current_buffer == XBUFFER ((w)->contents) | ||
| 28651 | && w->base_line_number > 0 | ||
| 28437 | && w->base_line_pos > 0 | 28652 | && w->base_line_pos > 0 |
| 28438 | && w->base_line_pos <= startpos) | 28653 | && w->base_line_pos <= startpos) |
| 28439 | { | 28654 | { |
| @@ -28459,7 +28674,9 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 28459 | or too far away, or if we did not have one. | 28674 | or too far away, or if we did not have one. |
| 28460 | "Too close" means it's plausible a scroll-down would | 28675 | "Too close" means it's plausible a scroll-down would |
| 28461 | go back past it. */ | 28676 | go back past it. */ |
| 28462 | if (startpos == BUF_BEGV (b)) | 28677 | if (current_buffer != XBUFFER (w->contents)) |
| 28678 | ; /* The base line is for another buffer, don't touch it! */ | ||
| 28679 | else if (startpos == BUF_BEGV (b)) | ||
| 28463 | { | 28680 | { |
| 28464 | w->base_line_number = topline; | 28681 | w->base_line_number = topline; |
| 28465 | w->base_line_pos = BUF_BEGV (b); | 28682 | w->base_line_pos = BUF_BEGV (b); |
| @@ -28496,6 +28713,12 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 28496 | goto no_value; | 28713 | goto no_value; |
| 28497 | } | 28714 | } |
| 28498 | 28715 | ||
| 28716 | /* NOTE: if `clip_changed` is set or if `BEG_UNCHANGED` is | ||
| 28717 | before `position`, this new cached value may get flushed | ||
| 28718 | soon needlessly, because we can't reset `BEG_UNCHANGED` or | ||
| 28719 | `clip_changed` from here (since they reflect the changes | ||
| 28720 | since the last redisplay so they can only be reset from | ||
| 28721 | `mark_window_display_accurate_1`). :-( */ | ||
| 28499 | w->base_line_number = topline - nlines; | 28722 | w->base_line_number = topline - nlines; |
| 28500 | w->base_line_pos = BYTE_TO_CHAR (position); | 28723 | w->base_line_pos = BYTE_TO_CHAR (position); |
| 28501 | } | 28724 | } |
| @@ -32589,7 +32812,19 @@ gui_produce_glyphs (struct it *it) | |||
| 32589 | if (font->space_width > 0) | 32812 | if (font->space_width > 0) |
| 32590 | { | 32813 | { |
| 32591 | int tab_width = it->tab_width * font->space_width; | 32814 | int tab_width = it->tab_width * font->space_width; |
| 32592 | int x = it->current_x + it->continuation_lines_width; | 32815 | /* wrap-prefix strings are prepended to continuation |
| 32816 | lines, so the width of tab characters inside should | ||
| 32817 | be computed from the start of this screen line rather | ||
| 32818 | than as a product of the total width of the physical | ||
| 32819 | line being wrapped. */ | ||
| 32820 | int x = it->current_x + (it->string_from_prefix_prop_p | ||
| 32821 | /* Subtract the width of the | ||
| 32822 | prefix from it->current_x if | ||
| 32823 | it exists. */ | ||
| 32824 | ? 0 : (it->continuation_lines_width | ||
| 32825 | ? (it->continuation_lines_width | ||
| 32826 | - it->wrap_prefix_width) | ||
| 32827 | : 0)); | ||
| 32593 | int x0 = x; | 32828 | int x0 = x; |
| 32594 | /* Adjust for line numbers, if needed. */ | 32829 | /* Adjust for line numbers, if needed. */ |
| 32595 | if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p) | 32830 | if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p) |
| @@ -33060,7 +33295,13 @@ gui_produce_glyphs (struct it *it) | |||
| 33060 | because this isn't true for images with `:ascent 100'. */ | 33295 | because this isn't true for images with `:ascent 100'. */ |
| 33061 | eassert (it->ascent >= 0 && it->descent >= 0); | 33296 | eassert (it->ascent >= 0 && it->descent >= 0); |
| 33062 | if (it->area == TEXT_AREA) | 33297 | if (it->area == TEXT_AREA) |
| 33063 | it->current_x += it->pixel_width; | 33298 | { |
| 33299 | it->current_x += it->pixel_width; | ||
| 33300 | |||
| 33301 | if (it->continuation_lines_width | ||
| 33302 | && it->string_from_prefix_prop_p) | ||
| 33303 | it->wrap_prefix_width = it->current_x; | ||
| 33304 | } | ||
| 33064 | 33305 | ||
| 33065 | if (extra_line_spacing > 0) | 33306 | if (extra_line_spacing > 0) |
| 33066 | { | 33307 | { |
| @@ -36219,7 +36460,7 @@ expose_area (struct window *w, struct glyph_row *row, const Emacs_Rectangle *r, | |||
| 36219 | /* Use a signed int intermediate value to avoid catastrophic | 36460 | /* Use a signed int intermediate value to avoid catastrophic |
| 36220 | failures due to comparison between signed and unsigned, when | 36461 | failures due to comparison between signed and unsigned, when |
| 36221 | x is negative (can happen for wide images that are hscrolled). */ | 36462 | x is negative (can happen for wide images that are hscrolled). */ |
| 36222 | int r_end = r->x + r->width; | 36463 | int r_end = r->x + (int) r->width; |
| 36223 | while (last < end && x < r_end) | 36464 | while (last < end && x < r_end) |
| 36224 | { | 36465 | { |
| 36225 | x += last->pixel_width; | 36466 | x += last->pixel_width; |
| @@ -36518,7 +36759,7 @@ expose_window (struct window *w, const Emacs_Rectangle *fr) | |||
| 36518 | /* Use a signed int intermediate value to avoid catastrophic | 36759 | /* Use a signed int intermediate value to avoid catastrophic |
| 36519 | failures due to comparison between signed and unsigned, when | 36760 | failures due to comparison between signed and unsigned, when |
| 36520 | y0 or y1 is negative (can happen for tall images). */ | 36761 | y0 or y1 is negative (can happen for tall images). */ |
| 36521 | int r_bottom = r.y + r.height; | 36762 | int r_bottom = r.y + (int) r.height; |
| 36522 | 36763 | ||
| 36523 | /* We must temporarily switch to the window's buffer, in case | 36764 | /* We must temporarily switch to the window's buffer, in case |
| 36524 | the fringe face has been remapped in that buffer's | 36765 | the fringe face has been remapped in that buffer's |
| @@ -36565,7 +36806,7 @@ expose_window (struct window *w, const Emacs_Rectangle *fr) | |||
| 36565 | /* We must redraw a row overlapping the exposed area. */ | 36806 | /* We must redraw a row overlapping the exposed area. */ |
| 36566 | if (y0 < r.y | 36807 | if (y0 < r.y |
| 36567 | ? y0 + row->phys_height > r.y | 36808 | ? y0 + row->phys_height > r.y |
| 36568 | : y0 + row->ascent - row->phys_ascent < r.y +r.height) | 36809 | : y0 + row->ascent - row->phys_ascent < r.y + (int) r.height) |
| 36569 | { | 36810 | { |
| 36570 | if (first_overlapping_row == NULL) | 36811 | if (first_overlapping_row == NULL) |
| 36571 | first_overlapping_row = row; | 36812 | first_overlapping_row = row; |
| @@ -36744,7 +36985,7 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2, | |||
| 36744 | const Emacs_Rectangle *upper, *lower; | 36985 | const Emacs_Rectangle *upper, *lower; |
| 36745 | bool intersection_p = false; | 36986 | bool intersection_p = false; |
| 36746 | 36987 | ||
| 36747 | /* Rearrange so that R1 is the left-most rectangle. */ | 36988 | /* Rearrange so that left is the left-most rectangle. */ |
| 36748 | if (r1->x < r2->x) | 36989 | if (r1->x < r2->x) |
| 36749 | left = r1, right = r2; | 36990 | left = r1, right = r2; |
| 36750 | else | 36991 | else |
| @@ -36752,13 +36993,14 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2, | |||
| 36752 | 36993 | ||
| 36753 | /* X0 of the intersection is right.x0, if this is inside R1, | 36994 | /* X0 of the intersection is right.x0, if this is inside R1, |
| 36754 | otherwise there is no intersection. */ | 36995 | otherwise there is no intersection. */ |
| 36755 | if (right->x <= left->x + left->width) | 36996 | if (right->x <= left->x + (int) left->width) |
| 36756 | { | 36997 | { |
| 36757 | result->x = right->x; | 36998 | result->x = right->x; |
| 36758 | 36999 | ||
| 36759 | /* The right end of the intersection is the minimum of | 37000 | /* The right end of the intersection is the minimum of |
| 36760 | the right ends of left and right. */ | 37001 | the right ends of left and right. */ |
| 36761 | result->width = (min (left->x + left->width, right->x + right->width) | 37002 | result->width = (min (left->x + (int) left->width, |
| 37003 | right->x + (int) right->width) | ||
| 36762 | - result->x); | 37004 | - result->x); |
| 36763 | 37005 | ||
| 36764 | /* Same game for Y. */ | 37006 | /* Same game for Y. */ |
| @@ -36769,14 +37011,14 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2, | |||
| 36769 | 37011 | ||
| 36770 | /* The upper end of the intersection is lower.y0, if this is inside | 37012 | /* The upper end of the intersection is lower.y0, if this is inside |
| 36771 | of upper. Otherwise, there is no intersection. */ | 37013 | of upper. Otherwise, there is no intersection. */ |
| 36772 | if (lower->y <= upper->y + upper->height) | 37014 | if (lower->y <= upper->y + (int) upper->height) |
| 36773 | { | 37015 | { |
| 36774 | result->y = lower->y; | 37016 | result->y = lower->y; |
| 36775 | 37017 | ||
| 36776 | /* The lower end of the intersection is the minimum of the lower | 37018 | /* The lower end of the intersection is the minimum of the lower |
| 36777 | ends of upper and lower. */ | 37019 | ends of upper and lower. */ |
| 36778 | result->height = (min (lower->y + lower->height, | 37020 | result->height = (min (lower->y + (int) lower->height, |
| 36779 | upper->y + upper->height) | 37021 | upper->y + (int) upper->height) |
| 36780 | - result->y); | 37022 | - result->y); |
| 36781 | intersection_p = true; | 37023 | intersection_p = true; |
| 36782 | } | 37024 | } |
diff --git a/src/xfaces.c b/src/xfaces.c index b9a78328661..a558e7328c0 100644 --- a/src/xfaces.c +++ b/src/xfaces.c | |||
| @@ -2245,20 +2245,20 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid) | |||
| 2245 | 2245 | ||
| 2246 | /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and | 2246 | /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and |
| 2247 | store the resulting attributes in TO, which must be already be | 2247 | store the resulting attributes in TO, which must be already be |
| 2248 | completely specified and contain only absolute attributes. | 2248 | completely specified and contain only absolute attributes. Every |
| 2249 | Every specified attribute of FROM overrides the corresponding | 2249 | specified attribute of FROM overrides the corresponding attribute of |
| 2250 | attribute of TO; relative attributes in FROM are merged with the | 2250 | TO; merge relative attributes in FROM with the absolute value in TO, |
| 2251 | absolute value in TO and replace it. NAMED_MERGE_POINTS is used | 2251 | which attributes also replace it. Use NAMED_MERGE_POINTS internally |
| 2252 | internally to detect loops in face inheritance/remapping; it should | 2252 | to detect loops in face inheritance/remapping; it should be 0 when |
| 2253 | be 0 when called from other places. If window W is non-NULL, use W | 2253 | called from other places. If window W is non-NULL, use W to |
| 2254 | to interpret face specifications. */ | 2254 | interpret face specifications. */ |
| 2255 | static void | 2255 | static void |
| 2256 | merge_face_vectors (struct window *w, | 2256 | merge_face_vectors (struct window *w, |
| 2257 | struct frame *f, const Lisp_Object *from, Lisp_Object *to, | 2257 | struct frame *f, const Lisp_Object *from, Lisp_Object *to, |
| 2258 | struct named_merge_point *named_merge_points) | 2258 | struct named_merge_point *named_merge_points) |
| 2259 | { | 2259 | { |
| 2260 | int i; | 2260 | int i; |
| 2261 | Lisp_Object font = Qnil; | 2261 | Lisp_Object font = Qnil, tospec, adstyle; |
| 2262 | 2262 | ||
| 2263 | /* If FROM inherits from some other faces, merge their attributes into | 2263 | /* If FROM inherits from some other faces, merge their attributes into |
| 2264 | TO before merging FROM's direct attributes. Note that an :inherit | 2264 | TO before merging FROM's direct attributes. Note that an :inherit |
| @@ -2318,6 +2318,25 @@ merge_face_vectors (struct window *w, | |||
| 2318 | to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (font); | 2318 | to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (font); |
| 2319 | if (! NILP (AREF (font, FONT_WIDTH_INDEX))) | 2319 | if (! NILP (AREF (font, FONT_WIDTH_INDEX))) |
| 2320 | to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (font); | 2320 | to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (font); |
| 2321 | |||
| 2322 | if (!NILP (AREF (font, FONT_ADSTYLE_INDEX))) | ||
| 2323 | { | ||
| 2324 | /* If an adstyle is specified in FROM's font spec, create a | ||
| 2325 | font spec for TO if none exists, and transfer the adstyle | ||
| 2326 | there. */ | ||
| 2327 | |||
| 2328 | tospec = to[LFACE_FONT_INDEX]; | ||
| 2329 | adstyle = AREF (font, FONT_ADSTYLE_INDEX); | ||
| 2330 | |||
| 2331 | if (!NILP (tospec)) | ||
| 2332 | tospec = copy_font_spec (tospec); | ||
| 2333 | else | ||
| 2334 | tospec = Ffont_spec (0, NULL); | ||
| 2335 | |||
| 2336 | to[LFACE_FONT_INDEX] = tospec; | ||
| 2337 | ASET (tospec, FONT_ADSTYLE_INDEX, adstyle); | ||
| 2338 | } | ||
| 2339 | |||
| 2321 | ASET (font, FONT_SIZE_INDEX, Qnil); | 2340 | ASET (font, FONT_SIZE_INDEX, Qnil); |
| 2322 | } | 2341 | } |
| 2323 | 2342 | ||
diff --git a/test/Makefile.in b/test/Makefile.in index 720f5c7ff8c..3cbdbec4414 100644 --- a/test/Makefile.in +++ b/test/Makefile.in | |||
| @@ -92,6 +92,10 @@ export TEST_LOAD_EL ?= \ | |||
| 92 | # Additional settings for ert. | 92 | # Additional settings for ert. |
| 93 | ert_opts = | 93 | ert_opts = |
| 94 | 94 | ||
| 95 | # Supply a path to local tree-sitter installations, as we run tests | ||
| 96 | # without a valid HOME. | ||
| 97 | ert_opts += --eval "(setq treesit-extra-load-path '(\"$(HOME)/.emacs.d/tree-sitter\"))" | ||
| 98 | |||
| 95 | # Maximum length of lines in ert backtraces; nil for no limit. | 99 | # Maximum length of lines in ert backtraces; nil for no limit. |
| 96 | # (if empty, use the default ert-batch-backtrace-right-margin). | 100 | # (if empty, use the default ert-batch-backtrace-right-margin). |
| 97 | TEST_BACKTRACE_LINE_LENGTH = | 101 | TEST_BACKTRACE_LINE_LENGTH = |
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index 8e583fade9f..d79072b06b5 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba | |||
| @@ -126,7 +126,7 @@ RUN src/emacs -Q --batch \ | |||
| 126 | (java "https://github.com/tree-sitter/tree-sitter-java") \ | 126 | (java "https://github.com/tree-sitter/tree-sitter-java") \ |
| 127 | (javascript "https://github.com/tree-sitter/tree-sitter-javascript") \ | 127 | (javascript "https://github.com/tree-sitter/tree-sitter-javascript") \ |
| 128 | (json "https://github.com/tree-sitter/tree-sitter-json") \ | 128 | (json "https://github.com/tree-sitter/tree-sitter-json") \ |
| 129 | (lua "https://github.com/MunifTanjim/tree-sitter-lua") \ | 129 | (lua "https://github.com/tree-sitter-grammars/tree-sitter-lua") \ |
| 130 | (python "https://github.com/tree-sitter/tree-sitter-python") \ | 130 | (python "https://github.com/tree-sitter/tree-sitter-python") \ |
| 131 | (ruby "https://github.com/tree-sitter/tree-sitter-ruby") \ | 131 | (ruby "https://github.com/tree-sitter/tree-sitter-ruby") \ |
| 132 | (tsx "https://github.com/tree-sitter/tree-sitter-typescript" "master" "tsx/src") \ | 132 | (tsx "https://github.com/tree-sitter/tree-sitter-typescript" "master" "tsx/src") \ |
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index bfdfac8be1b..cdd1a7832d3 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el | |||
| @@ -57,12 +57,10 @@ | |||
| 57 | (ert-deftest abbrev-make-abbrev-table-test () | 57 | (ert-deftest abbrev-make-abbrev-table-test () |
| 58 | ;; Table without properties: | 58 | ;; Table without properties: |
| 59 | (let ((table (make-abbrev-table))) | 59 | (let ((table (make-abbrev-table))) |
| 60 | (should (abbrev-table-p table)) | 60 | (should (abbrev-table-p table))) |
| 61 | (should (= (length table) obarray-default-size))) | ||
| 62 | ;; Table with one property 'foo with value 'bar: | 61 | ;; Table with one property 'foo with value 'bar: |
| 63 | (let ((table (make-abbrev-table '(foo bar)))) | 62 | (let ((table (make-abbrev-table '(foo bar)))) |
| 64 | (should (abbrev-table-p table)) | 63 | (should (abbrev-table-p table)) |
| 65 | (should (= (length table) obarray-default-size)) | ||
| 66 | (should (eq (abbrev-table-get table 'foo) 'bar)))) | 64 | (should (eq (abbrev-table-get table 'foo) 'bar)))) |
| 67 | 65 | ||
| 68 | (ert-deftest abbrev--table-symbols-test () | 66 | (ert-deftest abbrev--table-symbols-test () |
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 0a3c1cce590..c091a7dd060 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el | |||
| @@ -33,8 +33,8 @@ | |||
| 33 | (require 'secrets) | 33 | (require 'secrets) |
| 34 | 34 | ||
| 35 | (defun auth-source-ensure-ignored-backend (source) | 35 | (defun auth-source-ensure-ignored-backend (source) |
| 36 | (auth-source-validate-backend source '((:source . "") | 36 | (auth-source-validate-backend source '((source . "") |
| 37 | (:type . ignore)))) | 37 | (type . ignore)))) |
| 38 | 38 | ||
| 39 | (defun auth-source-validate-backend (source validation-alist) | 39 | (defun auth-source-validate-backend (source validation-alist) |
| 40 | (let ((backend (auth-source-backend-parse source))) | 40 | (let ((backend (auth-source-backend-parse source))) |
| @@ -44,84 +44,101 @@ | |||
| 44 | 44 | ||
| 45 | (ert-deftest auth-source-backend-parse-macos-keychain () | 45 | (ert-deftest auth-source-backend-parse-macos-keychain () |
| 46 | (auth-source-validate-backend '(:source (:macos-keychain-generic foobar)) | 46 | (auth-source-validate-backend '(:source (:macos-keychain-generic foobar)) |
| 47 | '((:source . "foobar") | 47 | '((source . "foobar") |
| 48 | (:type . macos-keychain-generic) | 48 | (type . macos-keychain-generic) |
| 49 | (:search-function . auth-source-macos-keychain-search) | 49 | (search-function . auth-source-macos-keychain-search) |
| 50 | (:create-function . auth-source-macos-keychain-create)))) | 50 | (create-function . auth-source-macos-keychain-create)))) |
| 51 | 51 | ||
| 52 | (ert-deftest auth-source-backend-parse-macos-keychain-generic-string () | 52 | (ert-deftest auth-source-backend-parse-macos-keychain-generic-string () |
| 53 | (auth-source-validate-backend "macos-keychain-generic:foobar" | 53 | (auth-source-validate-backend "macos-keychain-generic:foobar" |
| 54 | '((:source . "foobar") | 54 | '((source . "foobar") |
| 55 | (:type . macos-keychain-generic) | 55 | (type . macos-keychain-generic) |
| 56 | (:search-function . auth-source-macos-keychain-search) | 56 | (search-function |
| 57 | (:create-function . auth-source-macos-keychain-create)))) | 57 | . auth-source-macos-keychain-search) |
| 58 | (create-function | ||
| 59 | . auth-source-macos-keychain-create)))) | ||
| 58 | 60 | ||
| 59 | (ert-deftest auth-source-backend-parse-macos-keychain-internet-string () | 61 | (ert-deftest auth-source-backend-parse-macos-keychain-internet-string () |
| 60 | (auth-source-validate-backend "macos-keychain-internet:foobar" | 62 | (auth-source-validate-backend "macos-keychain-internet:foobar" |
| 61 | '((:source . "foobar") | 63 | '((source . "foobar") |
| 62 | (:type . macos-keychain-internet) | 64 | (type . macos-keychain-internet) |
| 63 | (:search-function . auth-source-macos-keychain-search) | 65 | (search-function |
| 64 | (:create-function . auth-source-macos-keychain-create)))) | 66 | . auth-source-macos-keychain-search) |
| 67 | (create-function | ||
| 68 | . auth-source-macos-keychain-create)))) | ||
| 65 | 69 | ||
| 66 | (ert-deftest auth-source-backend-parse-macos-keychain-internet-symbol () | 70 | (ert-deftest auth-source-backend-parse-macos-keychain-internet-symbol () |
| 67 | (auth-source-validate-backend 'macos-keychain-internet | 71 | (auth-source-validate-backend 'macos-keychain-internet |
| 68 | '((:source . "default") | 72 | '((source . "default") |
| 69 | (:type . macos-keychain-internet) | 73 | (type . macos-keychain-internet) |
| 70 | (:search-function . auth-source-macos-keychain-search) | 74 | (search-function |
| 71 | (:create-function . auth-source-macos-keychain-create)))) | 75 | . auth-source-macos-keychain-search) |
| 76 | (create-function | ||
| 77 | . auth-source-macos-keychain-create)))) | ||
| 72 | 78 | ||
| 73 | (ert-deftest auth-source-backend-parse-macos-keychain-generic-symbol () | 79 | (ert-deftest auth-source-backend-parse-macos-keychain-generic-symbol () |
| 74 | (auth-source-validate-backend 'macos-keychain-generic | 80 | (auth-source-validate-backend 'macos-keychain-generic |
| 75 | '((:source . "default") | 81 | '((source . "default") |
| 76 | (:type . macos-keychain-generic) | 82 | (type . macos-keychain-generic) |
| 77 | (:search-function . auth-source-macos-keychain-search) | 83 | (search-function |
| 78 | (:create-function . auth-source-macos-keychain-create)))) | 84 | . auth-source-macos-keychain-search) |
| 85 | (create-function | ||
| 86 | . auth-source-macos-keychain-create)))) | ||
| 79 | 87 | ||
| 80 | (ert-deftest auth-source-backend-parse-macos-keychain-internet-default-string () | 88 | (ert-deftest auth-source-backend-parse-macos-keychain-internet-default-string () |
| 81 | (auth-source-validate-backend 'macos-keychain-internet | 89 | (auth-source-validate-backend 'macos-keychain-internet |
| 82 | '((:source . "default") | 90 | '((source . "default") |
| 83 | (:type . macos-keychain-internet) | 91 | (type . macos-keychain-internet) |
| 84 | (:search-function . auth-source-macos-keychain-search) | 92 | (search-function |
| 85 | (:create-function . auth-source-macos-keychain-create)))) | 93 | . auth-source-macos-keychain-search) |
| 94 | (create-function | ||
| 95 | . auth-source-macos-keychain-create)))) | ||
| 86 | 96 | ||
| 87 | (ert-deftest auth-source-backend-parse-plstore () | 97 | (ert-deftest auth-source-backend-parse-plstore () |
| 88 | (auth-source-validate-backend '(:source "foo.plist") | 98 | (auth-source-validate-backend '(:source "foo.plist") |
| 89 | '((:source . "foo.plist") | 99 | '((source . "foo.plist") |
| 90 | (:type . plstore) | 100 | (type . plstore) |
| 91 | (:search-function . auth-source-plstore-search) | 101 | (search-function . auth-source-plstore-search) |
| 92 | (:create-function . auth-source-plstore-create)))) | 102 | (create-function |
| 103 | . auth-source-plstore-create)))) | ||
| 93 | 104 | ||
| 94 | (ert-deftest auth-source-backend-parse-netrc () | 105 | (ert-deftest auth-source-backend-parse-netrc () |
| 95 | (auth-source-validate-backend '(:source "foo") | 106 | (auth-source-validate-backend '(:source "foo") |
| 96 | '((:source . "foo") | 107 | '((source . "foo") |
| 97 | (:type . netrc) | 108 | (type . netrc) |
| 98 | (:search-function . auth-source-netrc-search) | 109 | (search-function . auth-source-netrc-search) |
| 99 | (:create-function . auth-source-netrc-create)))) | 110 | (create-function |
| 111 | . auth-source-netrc-create)))) | ||
| 100 | 112 | ||
| 101 | (ert-deftest auth-source-backend-parse-netrc-string () | 113 | (ert-deftest auth-source-backend-parse-netrc-string () |
| 102 | (auth-source-validate-backend "foo" | 114 | (auth-source-validate-backend "foo" |
| 103 | '((:source . "foo") | 115 | '((source . "foo") |
| 104 | (:type . netrc) | 116 | (type . netrc) |
| 105 | (:search-function . auth-source-netrc-search) | 117 | (search-function . auth-source-netrc-search) |
| 106 | (:create-function . auth-source-netrc-create)))) | 118 | (create-function |
| 119 | . auth-source-netrc-create)))) | ||
| 107 | 120 | ||
| 108 | (ert-deftest auth-source-backend-parse-secrets () | 121 | (ert-deftest auth-source-backend-parse-secrets () |
| 109 | (provide 'secrets) ; simulates the presence of the `secrets' package | 122 | (provide 'secrets) ; simulates the presence of the `secrets' package |
| 110 | (let ((secrets-enabled t)) | 123 | (let ((secrets-enabled t)) |
| 111 | (auth-source-validate-backend '(:source (:secrets "foo")) | 124 | (auth-source-validate-backend '(:source (:secrets "foo")) |
| 112 | '((:source . "foo") | 125 | '((source . "foo") |
| 113 | (:type . secrets) | 126 | (type . secrets) |
| 114 | (:search-function . auth-source-secrets-search) | 127 | (search-function |
| 115 | (:create-function . auth-source-secrets-create))))) | 128 | . auth-source-secrets-search) |
| 129 | (create-function | ||
| 130 | . auth-source-secrets-create))))) | ||
| 116 | 131 | ||
| 117 | (ert-deftest auth-source-backend-parse-secrets-strings () | 132 | (ert-deftest auth-source-backend-parse-secrets-strings () |
| 118 | (provide 'secrets) ; simulates the presence of the `secrets' package | 133 | (provide 'secrets) ; simulates the presence of the `secrets' package |
| 119 | (let ((secrets-enabled t)) | 134 | (let ((secrets-enabled t)) |
| 120 | (auth-source-validate-backend "secrets:foo" | 135 | (auth-source-validate-backend "secrets:foo" |
| 121 | '((:source . "foo") | 136 | '((source . "foo") |
| 122 | (:type . secrets) | 137 | (type . secrets) |
| 123 | (:search-function . auth-source-secrets-search) | 138 | (search-function |
| 124 | (:create-function . auth-source-secrets-create))))) | 139 | . auth-source-secrets-search) |
| 140 | (create-function | ||
| 141 | . auth-source-secrets-create))))) | ||
| 125 | 142 | ||
| 126 | (ert-deftest auth-source-backend-parse-secrets-alias () | 143 | (ert-deftest auth-source-backend-parse-secrets-alias () |
| 127 | (provide 'secrets) ; simulates the presence of the `secrets' package | 144 | (provide 'secrets) ; simulates the presence of the `secrets' package |
| @@ -129,10 +146,12 @@ | |||
| 129 | ;; Redefine `secrets-get-alias' to map 'foo to "foo" | 146 | ;; Redefine `secrets-get-alias' to map 'foo to "foo" |
| 130 | (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo"))) | 147 | (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo"))) |
| 131 | (auth-source-validate-backend '(:source (:secrets foo)) | 148 | (auth-source-validate-backend '(:source (:secrets foo)) |
| 132 | '((:source . "foo") | 149 | '((source . "foo") |
| 133 | (:type . secrets) | 150 | (type . secrets) |
| 134 | (:search-function . auth-source-secrets-search) | 151 | (search-function |
| 135 | (:create-function . auth-source-secrets-create)))))) | 152 | . auth-source-secrets-search) |
| 153 | (create-function | ||
| 154 | . auth-source-secrets-create)))))) | ||
| 136 | 155 | ||
| 137 | (ert-deftest auth-source-backend-parse-secrets-symbol () | 156 | (ert-deftest auth-source-backend-parse-secrets-symbol () |
| 138 | (provide 'secrets) ; simulates the presence of the `secrets' package | 157 | (provide 'secrets) ; simulates the presence of the `secrets' package |
| @@ -140,10 +159,12 @@ | |||
| 140 | ;; Redefine `secrets-get-alias' to map 'default to "foo" | 159 | ;; Redefine `secrets-get-alias' to map 'default to "foo" |
| 141 | (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo"))) | 160 | (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo"))) |
| 142 | (auth-source-validate-backend 'default | 161 | (auth-source-validate-backend 'default |
| 143 | '((:source . "foo") | 162 | '((source . "foo") |
| 144 | (:type . secrets) | 163 | (type . secrets) |
| 145 | (:search-function . auth-source-secrets-search) | 164 | (search-function |
| 146 | (:create-function . auth-source-secrets-create)))))) | 165 | . auth-source-secrets-search) |
| 166 | (create-function | ||
| 167 | . auth-source-secrets-create)))))) | ||
| 147 | 168 | ||
| 148 | (ert-deftest auth-source-backend-parse-secrets-no-alias () | 169 | (ert-deftest auth-source-backend-parse-secrets-no-alias () |
| 149 | (provide 'secrets) ; simulates the presence of the `secrets' package | 170 | (provide 'secrets) ; simulates the presence of the `secrets' package |
| @@ -152,10 +173,12 @@ | |||
| 152 | ;; "Login" is used by default | 173 | ;; "Login" is used by default |
| 153 | (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) nil))) | 174 | (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) nil))) |
| 154 | (auth-source-validate-backend '(:source (:secrets foo)) | 175 | (auth-source-validate-backend '(:source (:secrets foo)) |
| 155 | '((:source . "Login") | 176 | '((source . "Login") |
| 156 | (:type . secrets) | 177 | (type . secrets) |
| 157 | (:search-function . auth-source-secrets-search) | 178 | (search-function |
| 158 | (:create-function . auth-source-secrets-create)))))) | 179 | . auth-source-secrets-search) |
| 180 | (create-function | ||
| 181 | . auth-source-secrets-create)))))) | ||
| 159 | 182 | ||
| 160 | (ert-deftest auth-source-backend-parse-invalid-or-nil-source () | 183 | (ert-deftest auth-source-backend-parse-invalid-or-nil-source () |
| 161 | (provide 'secrets) ; simulates the presence of the `secrets' package | 184 | (provide 'secrets) ; simulates the presence of the `secrets' package |
diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index 190764e9125..5b2c28bd3dd 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el | |||
| @@ -181,4 +181,19 @@ instead." | |||
| 181 | (completion-preview--post-command)) | 181 | (completion-preview--post-command)) |
| 182 | (completion-preview-tests--check-preview "barbaz" 'exact))) | 182 | (completion-preview-tests--check-preview "barbaz" 'exact))) |
| 183 | 183 | ||
| 184 | (ert-deftest completion-preview-mid-symbol-cycle () | ||
| 185 | "Test cycling the completion preview with point at the middle of a symbol." | ||
| 186 | (with-temp-buffer | ||
| 187 | (setq-local completion-at-point-functions | ||
| 188 | (list | ||
| 189 | (completion-preview-tests--capf | ||
| 190 | '("foobar" "foobaz")))) | ||
| 191 | (insert "fooba") | ||
| 192 | (forward-char -2) | ||
| 193 | (let ((this-command 'self-insert-command)) | ||
| 194 | (completion-preview--post-command)) | ||
| 195 | (completion-preview-tests--check-preview "r") | ||
| 196 | (completion-preview-next-candidate 1) | ||
| 197 | (completion-preview-tests--check-preview "z"))) | ||
| 198 | |||
| 184 | ;;; completion-preview-tests.el ends here | 199 | ;;; completion-preview-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index dcb72e4105a..8ccac492141 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el | |||
| @@ -848,6 +848,22 @@ byte-compiled. Run with dynamic binding." | |||
| 848 | (should (equal (bytecomp-tests--eval-interpreted form) | 848 | (should (equal (bytecomp-tests--eval-interpreted form) |
| 849 | (bytecomp-tests--eval-compiled form))))))) | 849 | (bytecomp-tests--eval-compiled form))))))) |
| 850 | 850 | ||
| 851 | (ert-deftest bytecomp--fun-value-as-head () | ||
| 852 | ;; Check that (FUN-VALUE ...) is a valid call, for compatibility (bug#68931). | ||
| 853 | ;; (There is also a warning but this test does not check that.) | ||
| 854 | (dolist (lb '(nil t)) | ||
| 855 | (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ") | ||
| 856 | (let* ((lexical-binding lb) | ||
| 857 | (s-int '(lambda (x) (1+ x))) | ||
| 858 | (s-comp (byte-compile s-int)) | ||
| 859 | (v-int (lambda (x) (1+ x))) | ||
| 860 | (v-comp (byte-compile v-int)) | ||
| 861 | (comp (lambda (f) (funcall (byte-compile `(lambda () (,f 3))))))) | ||
| 862 | (should (equal (funcall comp s-int) 4)) | ||
| 863 | (should (equal (funcall comp s-comp) 4)) | ||
| 864 | (should (equal (funcall comp v-int) 4)) | ||
| 865 | (should (equal (funcall comp v-comp) 4)))))) | ||
| 866 | |||
| 851 | (defmacro bytecomp-tests--with-fresh-warnings (&rest body) | 867 | (defmacro bytecomp-tests--with-fresh-warnings (&rest body) |
| 852 | `(let ((macroexp--warned ; oh dear | 868 | `(let ((macroexp--warned ; oh dear |
| 853 | (make-hash-table :test #'equal :weakness 'key))) | 869 | (make-hash-table :test #'equal :weakness 'key))) |
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 086ac399352..990fa580c54 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el | |||
| @@ -319,5 +319,19 @@ Edebug symbols (Bug#42672)." | |||
| 319 | (and (eq 'error (car err)) | 319 | (and (eq 'error (car err)) |
| 320 | (string-match "Stray.*declare" (cadr err))))))) | 320 | (string-match "Stray.*declare" (cadr err))))))) |
| 321 | 321 | ||
| 322 | (cl-defmethod cl-generic-tests--print-quoted-method ((function (eql '4))) | ||
| 323 | (+ function 1)) | ||
| 324 | |||
| 325 | (ert-deftest cl-generic-tests--print-quoted () | ||
| 326 | (with-temp-buffer | ||
| 327 | (cl--generic-describe 'cl-generic-tests--print-quoted-method) | ||
| 328 | (goto-char (point-min)) | ||
| 329 | ;; Bug#54628: We don't want (function (eql '4)) to turn into #'(eql '4) | ||
| 330 | (should-not (re-search-forward "#'" nil t)) | ||
| 331 | (goto-char (point-min)) | ||
| 332 | ;; But we don't want (eql '4) to turn into (eql (quote 4)) either. | ||
| 333 | (should (re-search-forward "(eql '4)" nil t)))) | ||
| 334 | |||
| 335 | |||
| 322 | (provide 'cl-generic-tests) | 336 | (provide 'cl-generic-tests) |
| 323 | ;;; cl-generic-tests.el ends here | 337 | ;;; cl-generic-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 8c0f729dc39..29adbcff947 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el | |||
| @@ -860,8 +860,7 @@ test and possibly others should be updated." | |||
| 860 | (let ((inhibit-read-only t)) | 860 | (let ((inhibit-read-only t)) |
| 861 | (delete-region (point-min) (point-max)) | 861 | (delete-region (point-min) (point-max)) |
| 862 | (insert "`1")) | 862 | (insert "`1")) |
| 863 | (with-suppressed-warnings ((obsolete edebug-eval-defun)) | 863 | (eval-defun nil) |
| 864 | (edebug-eval-defun nil)) | ||
| 865 | ;; `eval-defun' outputs its message to the echo area in a rather | 864 | ;; `eval-defun' outputs its message to the echo area in a rather |
| 866 | ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed | 865 | ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed |
| 867 | ;; there in separate pieces (via `print' rather than via `message'). | 866 | ;; there in separate pieces (via `print' rather than via `message'). |
| @@ -871,18 +870,21 @@ test and possibly others should be updated." | |||
| 871 | 870 | ||
| 872 | (setq edebug-initial-mode 'go) | 871 | (setq edebug-initial-mode 'go) |
| 873 | ;; In Bug#23651 Edebug would hang reading `1. | 872 | ;; In Bug#23651 Edebug would hang reading `1. |
| 874 | (with-suppressed-warnings ((obsolete edebug-eval-defun)) | 873 | (eval-defun t) |
| 875 | (edebug-eval-defun t)))) | 874 | (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)") |
| 875 | edebug-tests-messages)))) | ||
| 876 | 876 | ||
| 877 | (ert-deftest edebug-tests-trivial-comma () | 877 | (ert-deftest edebug-tests-trivial-comma () |
| 878 | "Edebug can read a trivial comma expression (Bug#23651)." | 878 | "Edebug can read a trivial comma expression (Bug#23651)." |
| 879 | (edebug-tests-with-normal-env | 879 | (edebug-tests-with-normal-env |
| 880 | (read-only-mode -1) | 880 | (let ((inhibit-read-only t)) |
| 881 | (delete-region (point-min) (point-max)) | 881 | (delete-region (point-min) (point-max)) |
| 882 | (insert ",1") | 882 | (insert ",1")) |
| 883 | (read-only-mode) | 883 | ;; FIXME: This currently signals a "Source has changed" error, which is |
| 884 | (with-suppressed-warnings ((obsolete edebug-eval-defun)) | 884 | ;; itself a bug (the source hasn't changed). All we're testing here |
| 885 | (should-error (edebug-eval-defun t))))) | 885 | ;; is that the Edebug gets past the step of reading the sexp. |
| 886 | (should-error (let ((eval-expression-debug-on-error nil)) | ||
| 887 | (eval-defun t))))) | ||
| 886 | 888 | ||
| 887 | (ert-deftest edebug-tests-circular-read-syntax () | 889 | (ert-deftest edebug-tests-circular-read-syntax () |
| 888 | "Edebug can instrument code using circular read object syntax (Bug#23660)." | 890 | "Edebug can instrument code using circular read object syntax (Bug#23660)." |
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 83fc476c911..bc226757ff2 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | |||
| @@ -1011,24 +1011,24 @@ Subclasses to override slot attributes.")) | |||
| 1011 | (B (clone A :b "bb")) | 1011 | (B (clone A :b "bb")) |
| 1012 | (C (clone B :a "aa"))) | 1012 | (C (clone B :a "aa"))) |
| 1013 | 1013 | ||
| 1014 | (should (string= "aa" (oref C :a))) | 1014 | (should (string= "aa" (oref C a))) |
| 1015 | (should (string= "bb" (oref C :b))) | 1015 | (should (string= "bb" (oref C b))) |
| 1016 | 1016 | ||
| 1017 | (should (slot-boundp A :a)) | 1017 | (should (slot-boundp A 'a)) |
| 1018 | (should-not (slot-boundp A :b)) | 1018 | (should-not (slot-boundp A 'b)) |
| 1019 | (should-not (slot-boundp A :c)) | 1019 | (should-not (slot-boundp A 'c)) |
| 1020 | 1020 | ||
| 1021 | (should-not (slot-boundp B :a)) | 1021 | (should-not (slot-boundp B 'a)) |
| 1022 | (should (slot-boundp B :b)) | 1022 | (should (slot-boundp B 'b)) |
| 1023 | (should-not (slot-boundp A :c)) | 1023 | (should-not (slot-boundp A 'c)) |
| 1024 | 1024 | ||
| 1025 | (should (slot-boundp C :a)) | 1025 | (should (slot-boundp C 'a)) |
| 1026 | (should-not (slot-boundp C :b)) | 1026 | (should-not (slot-boundp C 'b)) |
| 1027 | (should-not (slot-boundp C :c)) | 1027 | (should-not (slot-boundp C 'c)) |
| 1028 | 1028 | ||
| 1029 | (should (eieio-instance-inheritor-slot-boundp C :a)) | 1029 | (should (eieio-instance-inheritor-slot-boundp C 'a)) |
| 1030 | (should (eieio-instance-inheritor-slot-boundp C :b)) | 1030 | (should (eieio-instance-inheritor-slot-boundp C 'b)) |
| 1031 | (should-not (eieio-instance-inheritor-slot-boundp C :c)))) | 1031 | (should-not (eieio-instance-inheritor-slot-boundp C 'c)))) |
| 1032 | 1032 | ||
| 1033 | ;;;; Interaction with defstruct | 1033 | ;;;; Interaction with defstruct |
| 1034 | 1034 | ||
diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el index 49c812edb05..3333f4014e6 100644 --- a/test/lisp/emacs-lisp/hierarchy-tests.el +++ b/test/lisp/emacs-lisp/hierarchy-tests.el | |||
| @@ -570,8 +570,9 @@ should fail as this function will crash." | |||
| 570 | 570 | ||
| 571 | (defun hierarchy-examples-delayed--childrenfn (hier-elem) | 571 | (defun hierarchy-examples-delayed--childrenfn (hier-elem) |
| 572 | "Return the children of HIER-ELEM. | 572 | "Return the children of HIER-ELEM. |
| 573 | Basically, feed the number, minus 1, to `hierarchy-examples-delayed--find-number' | 573 | Basically, feed the number, minus 1, to |
| 574 | and then create a list of the number plus 0.0–0.9." | 574 | `hierarchy-examples-delayed--find-number' and then create a list of the |
| 575 | number plus 0.0–0.9." | ||
| 575 | 576 | ||
| 576 | (when (> hier-elem 1) | 577 | (when (> hier-elem 1) |
| 577 | (let ((next (hierarchy-examples-delayed--find-number (1- hier-elem)))) | 578 | (let ((next (hierarchy-examples-delayed--find-number (1- hier-elem)))) |
diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el index 460b7a8e516..5358bcaeb5c 100644 --- a/test/lisp/emacs-lisp/macroexp-resources/vk.el +++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el | |||
| @@ -25,7 +25,7 @@ | |||
| 25 | (if (macroexp--dynamic-variable-p var) ''dyn ''lex)) | 25 | (if (macroexp--dynamic-variable-p var) ''dyn ''lex)) |
| 26 | 26 | ||
| 27 | (defvar vk-a 1) | 27 | (defvar vk-a 1) |
| 28 | (defconst vk-b 2) | 28 | (defvar vk-b 2) |
| 29 | (defvar vk-c) | 29 | (defvar vk-c) |
| 30 | 30 | ||
| 31 | (defun vk-f1 (x) | 31 | (defun vk-f1 (x) |
diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index ba6fe9fd8c1..603b3745a27 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el | |||
| @@ -20,14 +20,13 @@ | |||
| 20 | ;;; Commentary: | 20 | ;;; Commentary: |
| 21 | 21 | ||
| 22 | ;;; Code: | 22 | ;;; Code: |
| 23 | (require 'erc-button) | ||
| 23 | 24 | ||
| 24 | (require 'ert-x) ; cl-lib | 25 | (require 'ert-x) ; cl-lib |
| 25 | (eval-and-compile | 26 | (eval-and-compile |
| 26 | (let ((load-path (cons (ert-resource-directory) load-path))) | 27 | (let ((load-path (cons (ert-resource-directory) load-path))) |
| 27 | (require 'erc-tests-common))) | 28 | (require 'erc-tests-common))) |
| 28 | 29 | ||
| 29 | (require 'erc-button) | ||
| 30 | |||
| 31 | (ert-deftest erc-button-alist--url () | 30 | (ert-deftest erc-button-alist--url () |
| 32 | (erc-tests-common-init-server-proc "sleep" "1") | 31 | (erc-tests-common-init-server-proc "sleep" "1") |
| 33 | (with-current-buffer (erc--open-target "#chan") | 32 | (with-current-buffer (erc--open-target "#chan") |
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 0f19b481f37..3c4ad04abd7 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el | |||
| @@ -23,13 +23,13 @@ | |||
| 23 | ;; scenarios. | 23 | ;; scenarios. |
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | (require 'erc-fill) | ||
| 27 | |||
| 26 | (require 'ert-x) | 28 | (require 'ert-x) |
| 27 | (eval-and-compile | 29 | (eval-and-compile |
| 28 | (let ((load-path (cons (ert-resource-directory) load-path))) | 30 | (let ((load-path (cons (ert-resource-directory) load-path))) |
| 29 | (require 'erc-tests-common))) | 31 | (require 'erc-tests-common))) |
| 30 | 32 | ||
| 31 | (require 'erc-fill) | ||
| 32 | |||
| 33 | (defvar erc-fill-tests--buffers nil) | 33 | (defvar erc-fill-tests--buffers nil) |
| 34 | (defvar erc-fill-tests--current-time-value nil) | 34 | (defvar erc-fill-tests--current-time-value nil) |
| 35 | 35 | ||
| @@ -52,6 +52,7 @@ | |||
| 52 | 52 | ||
| 53 | (defun erc-fill-tests--wrap-populate (test) | 53 | (defun erc-fill-tests--wrap-populate (test) |
| 54 | (let ((original-window-buffer (window-buffer (selected-window))) | 54 | (let ((original-window-buffer (window-buffer (selected-window))) |
| 55 | (erc--fill-wrap-scrolltobottom-exempt-p t) | ||
| 55 | (erc-stamp--tz t) | 56 | (erc-stamp--tz t) |
| 56 | (erc-fill-function 'erc-fill-wrap) | 57 | (erc-fill-function 'erc-fill-wrap) |
| 57 | (pre-command-hook pre-command-hook) | 58 | (pre-command-hook pre-command-hook) |
diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 170e28bda96..7013ce0c8fc 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el | |||
| @@ -19,13 +19,13 @@ | |||
| 19 | 19 | ||
| 20 | ;;; Commentary: | 20 | ;;; Commentary: |
| 21 | ;;; Code: | 21 | ;;; Code: |
| 22 | (require 'erc-goodies) | ||
| 23 | |||
| 22 | (require 'ert-x) | 24 | (require 'ert-x) |
| 23 | (eval-and-compile | 25 | (eval-and-compile |
| 24 | (let ((load-path (cons (ert-resource-directory) load-path))) | 26 | (let ((load-path (cons (ert-resource-directory) load-path))) |
| 25 | (require 'erc-tests-common))) | 27 | (require 'erc-tests-common))) |
| 26 | 28 | ||
| 27 | (require 'erc-goodies) | ||
| 28 | |||
| 29 | (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) | 29 | (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) |
| 30 | (setq beg (+ beg (point-min))) | 30 | (setq beg (+ beg (point-min))) |
| 31 | (let ((end (+ beg (1- (length end-str))))) | 31 | (let ((end (+ beg (1- (length end-str))))) |
diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index d8d8c6fa9cd..90b8aa99741 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el | |||
| @@ -18,6 +18,7 @@ | |||
| 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. |
| 19 | 19 | ||
| 20 | ;;; Code: | 20 | ;;; Code: |
| 21 | (require 'erc-compat) | ||
| 21 | 22 | ||
| 22 | (require 'ert-x) ; cl-lib | 23 | (require 'ert-x) ; cl-lib |
| 23 | (eval-and-compile | 24 | (eval-and-compile |
| @@ -1761,4 +1762,50 @@ | |||
| 1761 | (should (equal (erc-ports-list (nth 4 srv)) | 1762 | (should (equal (erc-ports-list (nth 4 srv)) |
| 1762 | '(6697 9999)))))) | 1763 | '(6697 9999)))))) |
| 1763 | 1764 | ||
| 1765 | (ert-deftest erc-networks--examine-targets () | ||
| 1766 | (with-current-buffer (erc-tests-common-make-server-buf "foonet") | ||
| 1767 | (erc--open-target "#chan") | ||
| 1768 | (erc--open-target "#spam")) | ||
| 1769 | |||
| 1770 | (with-current-buffer (erc-tests-common-make-server-buf "barnet") | ||
| 1771 | (with-current-buffer (erc--open-target "*query") | ||
| 1772 | (setq erc-networks--id nil)) | ||
| 1773 | (with-current-buffer (erc--open-target "#chan") | ||
| 1774 | (let ((calls ()) | ||
| 1775 | (snap (lambda (parameter) | ||
| 1776 | (list parameter | ||
| 1777 | (erc-target) | ||
| 1778 | (erc-networks--id-symbol erc-networks--id))))) | ||
| 1779 | |||
| 1780 | ;; Search for "#chan" dupes among targets of all servers. | ||
| 1781 | (should (equal | ||
| 1782 | (erc-networks--examine-targets erc-networks--id erc--target | ||
| 1783 | (lambda () (push (funcall snap 'ON-DUPE) calls)) | ||
| 1784 | (lambda () (push (funcall snap 'ON-COLL) calls))) | ||
| 1785 | (list (get-buffer "#chan@foonet") | ||
| 1786 | (get-buffer "#chan@barnet")))) | ||
| 1787 | |||
| 1788 | (should (equal (pop calls) '(ON-DUPE "#chan" barnet))) | ||
| 1789 | (should (equal (pop calls) '(ON-COLL "#chan" foonet))) | ||
| 1790 | (should-not calls) | ||
| 1791 | (should-not (get-buffer "#chan")) | ||
| 1792 | (should (get-buffer "#chan@barnet")) | ||
| 1793 | (should (get-buffer "#chan@foonet")) | ||
| 1794 | |||
| 1795 | ;; Search for "*query" dupes among targets of all servers. | ||
| 1796 | (should (equal (erc-networks--examine-targets erc-networks--id | ||
| 1797 | (buffer-local-value 'erc--target | ||
| 1798 | (get-buffer "*query")) | ||
| 1799 | (lambda () (push (funcall snap 'ON-DUPE) calls)) | ||
| 1800 | (lambda () (push (funcall snap 'ON-COLL) calls))) | ||
| 1801 | (list (get-buffer "*query")))) | ||
| 1802 | |||
| 1803 | (should (equal (pop calls) '(ON-DUPE "*query" barnet))) | ||
| 1804 | (should-not calls))) | ||
| 1805 | |||
| 1806 | (goto-char (point-min)) | ||
| 1807 | (should (search-forward "Missing network session" nil t))) | ||
| 1808 | |||
| 1809 | (erc-tests-common-kill-buffers)) | ||
| 1810 | |||
| 1764 | ;;; erc-networks-tests.el ends here | 1811 | ;;; erc-networks-tests.el ends here |
diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el index ca22728b152..e0fcb8b9366 100644 --- a/test/lisp/erc/erc-scenarios-base-renick.el +++ b/test/lisp/erc/erc-scenarios-base-renick.el | |||
| @@ -281,12 +281,12 @@ | |||
| 281 | (should-not (get-buffer "rando@barnet")) | 281 | (should-not (get-buffer "rando@barnet")) |
| 282 | 282 | ||
| 283 | (with-current-buffer "frenemy@foonet" | 283 | (with-current-buffer "frenemy@foonet" |
| 284 | (funcall expect 1 "now known as") | 284 | (funcall expect 10 "now known as") |
| 285 | (funcall expect 1 "doubly so")) | 285 | (funcall expect 10 "doubly so")) |
| 286 | 286 | ||
| 287 | (with-current-buffer "frenemy@barnet" | 287 | (with-current-buffer "frenemy@barnet" |
| 288 | (funcall expect 1 "now known as") | 288 | (funcall expect 10 "now known as") |
| 289 | (funcall expect 1 "reality picture")) | 289 | (funcall expect 10 "reality picture")) |
| 290 | 290 | ||
| 291 | (when noninteractive | 291 | (when noninteractive |
| 292 | (with-current-buffer "frenemy@barnet" (kill-buffer)) | 292 | (with-current-buffer "frenemy@barnet" (kill-buffer)) |
diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el index bbd9c79f593..f3905974a11 100644 --- a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el +++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el | |||
| @@ -42,4 +42,50 @@ | |||
| 42 | 'znc-foonet | 42 | 'znc-foonet |
| 43 | 'znc-barnet)) | 43 | 'znc-barnet)) |
| 44 | 44 | ||
| 45 | ;; Here, the upstream connection is already severed when first | ||
| 46 | ;; connecting. The bouncer therefore sends query messages from an | ||
| 47 | ;; administrative bot before the first numerics burst, which results | ||
| 48 | ;; in a target buffer not being associated with an `erc-networks--id'. | ||
| 49 | ;; The problem only manifests later, when the buffer-association | ||
| 50 | ;; machinery checks the names of all target buffers and assumes a | ||
| 51 | ;; non-nil `erc-networks--id'. | ||
| 52 | (ert-deftest erc-scenarios-upstream-recon--znc/severed () | ||
| 53 | (erc-scenarios-common-with-cleanup | ||
| 54 | ((erc-scenarios-common-dialog "base/upstream-reconnect") | ||
| 55 | (erc-d-t-cleanup-sleep-secs 1) | ||
| 56 | (erc-server-flood-penalty 0.1) | ||
| 57 | (dumb-server (erc-d-run "localhost" t 'znc-severed)) | ||
| 58 | (port (process-contact dumb-server :service)) | ||
| 59 | (expect (erc-d-t-make-expecter))) | ||
| 60 | |||
| 61 | (ert-info ("Connect to foonet") | ||
| 62 | (with-current-buffer (erc :server "127.0.0.1" | ||
| 63 | :port port | ||
| 64 | :nick "tester" | ||
| 65 | :user "tester@vanilla/foonet" | ||
| 66 | :password "changeme" | ||
| 67 | :full-name "tester") | ||
| 68 | (erc-scenarios-common-assert-initial-buf-name nil port) | ||
| 69 | (erc-d-t-wait-for 6 (eq (erc-network) 'foonet)))) | ||
| 70 | |||
| 71 | (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "*status")) | ||
| 72 | (funcall expect 10 "Connection Refused. Reconnecting...") | ||
| 73 | (funcall expect 10 "Connected!")) | ||
| 74 | |||
| 75 | (ert-info ("Join #chan") | ||
| 76 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) | ||
| 77 | (funcall expect 10 "<alice> tester, welcome!") | ||
| 78 | (funcall expect 10 "<bob> alice: And see a fearful sight") | ||
| 79 | (funcall expect 10 "<eve> hola") | ||
| 80 | (funcall expect 10 "<Evel> hell o") | ||
| 81 | ;; | ||
| 82 | (funcall expect 10 "<alice> bob: Or to drown my clothes"))) | ||
| 83 | |||
| 84 | (ert-info ("Buffer not renamed with net id") | ||
| 85 | (should (get-buffer "*status"))) | ||
| 86 | |||
| 87 | (ert-info ("No error") | ||
| 88 | (with-current-buffer (messages-buffer) | ||
| 89 | (funcall expect -0.1 "error in process filter"))))) | ||
| 90 | |||
| 45 | ;;; erc-scenarios-base-upstream-recon-znc.el ends here | 91 | ;;; erc-scenarios-base-upstream-recon-znc.el ends here |
diff --git a/test/lisp/erc/erc-scenarios-misc-commands.el b/test/lisp/erc/erc-scenarios-misc-commands.el index d6ed53b5358..da6855caf57 100644 --- a/test/lisp/erc/erc-scenarios-misc-commands.el +++ b/test/lisp/erc/erc-scenarios-misc-commands.el | |||
| @@ -123,4 +123,94 @@ | |||
| 123 | (should (string= (erc-server-user-host (erc-get-server-user "tester")) | 123 | (should (string= (erc-server-user-host (erc-get-server-user "tester")) |
| 124 | "some.host.test.cc")))))) | 124 | "some.host.test.cc")))))) |
| 125 | 125 | ||
| 126 | ;; This tests four related slash commands, /AMSG, /GMSG, /AME, /GME, | ||
| 127 | ;; the latter three introduced by bug#68401. It mainly asserts | ||
| 128 | ;; correct routing behavior, especially not sending or inserting | ||
| 129 | ;; messages in buffers belonging to disconnected sessions. Left | ||
| 130 | ;; unaddressed are interactions with the `command-indicator' module | ||
| 131 | ;; (`erc-noncommands-list') and whatever future `echo-message' | ||
| 132 | ;; implementation manifests out of bug#49860. | ||
| 133 | (ert-deftest erc-scenarios-misc-commands--AMSG-GMSG-AME-GME () | ||
| 134 | (erc-scenarios-common-with-cleanup | ||
| 135 | ((erc-scenarios-common-dialog "commands") | ||
| 136 | (erc-server-flood-penalty 0.1) | ||
| 137 | (dumb-server-foonet (erc-d-run "localhost" t "srv-foonet" 'amsg-foonet)) | ||
| 138 | (dumb-server-barnet (erc-d-run "localhost" t "srv-barnet" 'amsg-barnet)) | ||
| 139 | (expect (erc-d-t-make-expecter))) | ||
| 140 | |||
| 141 | (ert-info ("Connect to foonet and join #foo") | ||
| 142 | (with-current-buffer | ||
| 143 | (erc :server "127.0.0.1" | ||
| 144 | :port (process-contact dumb-server-foonet :service) | ||
| 145 | :nick "tester") | ||
| 146 | (funcall expect 10 "debug mode") | ||
| 147 | (erc-cmd-JOIN "#foo"))) | ||
| 148 | |||
| 149 | (ert-info ("Connect to barnet and join #bar") | ||
| 150 | (with-current-buffer | ||
| 151 | (erc :server "127.0.0.1" | ||
| 152 | :port (process-contact dumb-server-barnet :service) | ||
| 153 | :nick "tester") | ||
| 154 | (funcall expect 10 "debug mode") | ||
| 155 | (erc-cmd-JOIN "#bar"))) | ||
| 156 | |||
| 157 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) | ||
| 158 | (funcall expect 10 "welcome")) | ||
| 159 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#bar")) | ||
| 160 | (funcall expect 10 "welcome")) | ||
| 161 | |||
| 162 | (ert-info ("/AMSG only sent to issuing context's server") | ||
| 163 | (with-current-buffer "foonet" | ||
| 164 | (erc-scenarios-common-say "/amsg 1 foonet only")) | ||
| 165 | (with-current-buffer "barnet" | ||
| 166 | (erc-scenarios-common-say "/amsg 2 barnet only")) | ||
| 167 | (with-current-buffer "#foo" | ||
| 168 | (funcall expect 10 "<tester> 1 foonet only") | ||
| 169 | (funcall expect 10 "<alice> bob: Our queen and all")) | ||
| 170 | (with-current-buffer "#bar" | ||
| 171 | (funcall expect 10 "<tester> 2 barnet only") | ||
| 172 | (funcall expect 10 "<joe> mike: And secretly to greet"))) | ||
| 173 | |||
| 174 | (ert-info ("/AME only sent to issuing context's server") | ||
| 175 | (with-current-buffer "foonet" | ||
| 176 | (erc-scenarios-common-say "/ame 3 foonet only")) | ||
| 177 | (with-current-buffer "barnet" | ||
| 178 | (erc-scenarios-common-say "/ame 4 barnet only")) | ||
| 179 | (with-current-buffer "#foo" | ||
| 180 | (funcall expect 10 "* tester 3 foonet only") | ||
| 181 | (funcall expect 10 "<alice> bob: You have discharged this")) | ||
| 182 | (with-current-buffer "#bar" | ||
| 183 | (funcall expect 10 "* tester 4 barnet only") | ||
| 184 | (funcall expect 10 "<joe> mike: That same Berowne"))) | ||
| 185 | |||
| 186 | (ert-info ("/GMSG and /GME sent to all servers") | ||
| 187 | (with-current-buffer "foonet" | ||
| 188 | (erc-scenarios-common-say "/gmsg 5 all nets") | ||
| 189 | (erc-scenarios-common-say "/gme 6 all nets")) | ||
| 190 | (with-current-buffer "#bar" | ||
| 191 | (funcall expect 10 "<tester> 5 all nets") | ||
| 192 | (funcall expect 10 "* tester 6 all nets") | ||
| 193 | (funcall expect 10 "<joe> mike: Mehercle! if their sons"))) | ||
| 194 | |||
| 195 | (ert-info ("/GMSG and /GME only sent to connected servers") | ||
| 196 | (with-current-buffer "barnet" | ||
| 197 | (erc-cmd-QUIT "") | ||
| 198 | (funcall expect 10 "ERC finished")) | ||
| 199 | (with-current-buffer "#foo" | ||
| 200 | (funcall expect 10 "<tester> 5 all nets") | ||
| 201 | (funcall expect 10 "* tester 6 all nets") | ||
| 202 | (funcall expect 10 "<alice> bob: Stand you!")) | ||
| 203 | (with-current-buffer "foonet" | ||
| 204 | (erc-scenarios-common-say "/gmsg 7 all live nets") | ||
| 205 | (erc-scenarios-common-say "/gme 8 all live nets")) | ||
| 206 | ;; Message *not* inserted in disconnected buffer. | ||
| 207 | (with-current-buffer "#bar" | ||
| 208 | (funcall expect -0.1 "<tester> 7 all live nets") | ||
| 209 | (funcall expect -0.1 "* tester 8 all live nets"))) | ||
| 210 | |||
| 211 | (with-current-buffer "#foo" | ||
| 212 | (funcall expect 10 "<tester> 7 all live nets") | ||
| 213 | (funcall expect 10 "* tester 8 all live nets") | ||
| 214 | (funcall expect 10 "<bob> alice: Live, and be prosperous;")))) | ||
| 215 | |||
| 126 | ;;; erc-scenarios-misc-commands.el ends here | 216 | ;;; erc-scenarios-misc-commands.el ends here |
diff --git a/test/lisp/erc/erc-scenarios-misc.el b/test/lisp/erc/erc-scenarios-misc.el index 8f6042de5c2..2afa1ce67a4 100644 --- a/test/lisp/erc/erc-scenarios-misc.el +++ b/test/lisp/erc/erc-scenarios-misc.el | |||
| @@ -126,7 +126,7 @@ | |||
| 126 | (erc-d-t-wait-for 10 (get-buffer "foonet")) | 126 | (erc-d-t-wait-for 10 (get-buffer "foonet")) |
| 127 | 127 | ||
| 128 | (ert-info ("Channel buffer #foo playback received") | 128 | (ert-info ("Channel buffer #foo playback received") |
| 129 | (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#foo")) | 129 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) |
| 130 | (funcall expect 10 "Excellent workman"))) | 130 | (funcall expect 10 "Excellent workman"))) |
| 131 | 131 | ||
| 132 | (ert-info ("Global notices routed to server buffer") | 132 | (ert-info ("Global notices routed to server buffer") |
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index ef292ccb618..a49173ffa2f 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el | |||
| @@ -20,14 +20,14 @@ | |||
| 20 | ;;; Commentary: | 20 | ;;; Commentary: |
| 21 | 21 | ||
| 22 | ;;; Code: | 22 | ;;; Code: |
| 23 | (require 'erc-stamp) | ||
| 24 | (require 'erc-goodies) ; for `erc-make-read-only' | ||
| 25 | |||
| 23 | (require 'ert-x) | 26 | (require 'ert-x) |
| 24 | (eval-and-compile | 27 | (eval-and-compile |
| 25 | (let ((load-path (cons (ert-resource-directory) load-path))) | 28 | (let ((load-path (cons (ert-resource-directory) load-path))) |
| 26 | (require 'erc-tests-common))) | 29 | (require 'erc-tests-common))) |
| 27 | 30 | ||
| 28 | (require 'erc-stamp) | ||
| 29 | (require 'erc-goodies) ; for `erc-make-read-only' | ||
| 30 | |||
| 31 | ;; These display-oriented tests are brittle because many factors | 31 | ;; These display-oriented tests are brittle because many factors |
| 32 | ;; influence how text properties are applied. We should just | 32 | ;; influence how text properties are applied. We should just |
| 33 | ;; rework these into full scenarios. | 33 | ;; rework these into full scenarios. |
| @@ -46,7 +46,7 @@ | |||
| 46 | 46 | ||
| 47 | (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*") | 47 | (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*") |
| 48 | (erc-mode) | 48 | (erc-mode) |
| 49 | (erc-munge-invisibility-spec) | 49 | (erc-stamp--manage-local-options-state) |
| 50 | (erc--initialize-markers (point) nil) | 50 | (erc--initialize-markers (point) nil) |
| 51 | (erc-tests-common-init-server-proc "sleep" "1") | 51 | (erc-tests-common-init-server-proc "sleep" "1") |
| 52 | 52 | ||
| @@ -235,7 +235,7 @@ | |||
| 235 | (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") | 235 | (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") |
| 236 | (erc-mode) | 236 | (erc-mode) |
| 237 | (erc--initialize-markers (point) nil) | 237 | (erc--initialize-markers (point) nil) |
| 238 | (erc-munge-invisibility-spec) | 238 | (erc-stamp--manage-local-options-state) |
| 239 | (erc-display-message nil 'notice (current-buffer) "Welcome") | 239 | (erc-display-message nil 'notice (current-buffer) "Welcome") |
| 240 | ;; | 240 | ;; |
| 241 | ;; Pretend `fill' is active and that these lines are | 241 | ;; Pretend `fill' is active and that these lines are |
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b51bd67ae04..085b063bdb2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el | |||
| @@ -20,13 +20,13 @@ | |||
| 20 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | 20 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. |
| 21 | 21 | ||
| 22 | ;;; Code: | 22 | ;;; Code: |
| 23 | (require 'erc-ring) | ||
| 23 | 24 | ||
| 24 | (require 'ert-x) | 25 | (require 'ert-x) |
| 25 | (eval-and-compile | 26 | (eval-and-compile |
| 26 | (let ((load-path (cons (ert-resource-directory) load-path))) | 27 | (let ((load-path (cons (ert-resource-directory) load-path))) |
| 27 | (require 'erc-tests-common))) | 28 | (require 'erc-tests-common))) |
| 28 | 29 | ||
| 29 | (require 'erc-ring) | ||
| 30 | 30 | ||
| 31 | (ert-deftest erc--read-time-period () | 31 | (ert-deftest erc--read-time-period () |
| 32 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) | 32 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) |
| @@ -302,6 +302,7 @@ | |||
| 302 | (cl-incf counter)))) | 302 | (cl-incf counter)))) |
| 303 | erc-accidental-paste-threshold-seconds | 303 | erc-accidental-paste-threshold-seconds |
| 304 | erc-insert-modify-hook | 304 | erc-insert-modify-hook |
| 305 | (erc-last-input-time 0) | ||
| 305 | (erc-modules (remq 'stamp erc-modules)) | 306 | (erc-modules (remq 'stamp erc-modules)) |
| 306 | (erc-send-input-line-function #'ignore) | 307 | (erc-send-input-line-function #'ignore) |
| 307 | (erc--input-review-functions erc--input-review-functions) | 308 | (erc--input-review-functions erc--input-review-functions) |
| @@ -1053,7 +1054,8 @@ | |||
| 1053 | 1054 | ||
| 1054 | (ert-deftest erc--get-isupport-entry () | 1055 | (ert-deftest erc--get-isupport-entry () |
| 1055 | (let ((erc--isupport-params (make-hash-table)) | 1056 | (let ((erc--isupport-params (make-hash-table)) |
| 1056 | (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C"))) | 1057 | (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C") |
| 1058 | ("SPAM" . ""))) | ||
| 1057 | (items (lambda () | 1059 | (items (lambda () |
| 1058 | (cl-loop for k being the hash-keys of erc--isupport-params | 1060 | (cl-loop for k being the hash-keys of erc--isupport-params |
| 1059 | using (hash-values v) collect (cons k v))))) | 1061 | using (hash-values v) collect (cons k v))))) |
| @@ -1074,7 +1076,9 @@ | |||
| 1074 | (should (equal (erc--get-isupport-entry 'FOO) '(FOO "1"))) | 1076 | (should (equal (erc--get-isupport-entry 'FOO) '(FOO "1"))) |
| 1075 | 1077 | ||
| 1076 | (should (equal (funcall items) | 1078 | (should (equal (funcall items) |
| 1077 | '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1")))))) | 1079 | '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1")))) |
| 1080 | (should (equal (erc--get-isupport-entry 'SPAM) '(SPAM))) | ||
| 1081 | (should-not (erc--get-isupport-entry 'SPAM 'single)))) | ||
| 1078 | 1082 | ||
| 1079 | (ert-deftest erc-server-005 () | 1083 | (ert-deftest erc-server-005 () |
| 1080 | (let* ((hooked 0) | 1084 | (let* ((hooked 0) |
| @@ -1092,34 +1096,41 @@ | |||
| 1092 | (lambda (_ _ _ line) (push line calls)))) | 1096 | (lambda (_ _ _ line) (push line calls)))) |
| 1093 | 1097 | ||
| 1094 | (ert-info ("Baseline") | 1098 | (ert-info ("Baseline") |
| 1095 | (setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...") | 1099 | (setq args '("tester" "BOT=B" "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+" |
| 1100 | "are supp...") | ||
| 1096 | parsed (make-erc-response :command-args args :command "005")) | 1101 | parsed (make-erc-response :command-args args :command "005")) |
| 1097 | 1102 | ||
| 1098 | (setq verify | 1103 | (setq verify |
| 1099 | (lambda () | 1104 | (lambda () |
| 1100 | (should (equal erc-server-parameters | 1105 | (should (equal erc-server-parameters |
| 1101 | '(("PREFIX" . "(ov)@+") ("EXCEPTS") | 1106 | '(("PREFIX" . "(ov)@+") ("EXCEPTS") |
| 1107 | ;; Should be ("CHANTYPES") but | ||
| 1108 | ;; retained for compatibility. | ||
| 1109 | ("CHANTYPES" . "") | ||
| 1102 | ("BOT" . "B")))) | 1110 | ("BOT" . "B")))) |
| 1103 | (should (zerop (hash-table-count erc--isupport-params))) | 1111 | (should (zerop (hash-table-count erc--isupport-params))) |
| 1104 | (should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t))) | 1112 | (should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t))) |
| 1105 | (should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS))) | 1113 | (should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS))) |
| 1106 | (should (equal "B" (erc--get-isupport-entry 'BOT t))) | 1114 | (should (equal "B" (erc--get-isupport-entry 'BOT t))) |
| 1107 | (should (string= (pop calls) | 1115 | (should (string= |
| 1108 | "BOT=B EXCEPTS PREFIX=(ov)@+ are supp...")) | 1116 | (pop calls) |
| 1117 | "BOT=B CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp...")) | ||
| 1109 | (should (equal args (erc-response.command-args parsed))))) | 1118 | (should (equal args (erc-response.command-args parsed))))) |
| 1110 | 1119 | ||
| 1111 | (erc-call-hooks nil parsed)) | 1120 | (erc-call-hooks nil parsed)) |
| 1112 | 1121 | ||
| 1113 | (ert-info ("Negated, updated") | 1122 | (ert-info ("Negated, updated") |
| 1114 | (setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...") | 1123 | (setq args '("tester" "-EXCEPTS" "-CHANTYPES" "-FAKE" "PREFIX=(ohv)@%+" |
| 1124 | "are su...") | ||
| 1115 | parsed (make-erc-response :command-args args :command "005")) | 1125 | parsed (make-erc-response :command-args args :command "005")) |
| 1116 | 1126 | ||
| 1117 | (setq verify | 1127 | (setq verify |
| 1118 | (lambda () | 1128 | (lambda () |
| 1119 | (should (equal erc-server-parameters | 1129 | (should (equal erc-server-parameters |
| 1120 | '(("PREFIX" . "(ohv)@%+") ("BOT" . "B")))) | 1130 | '(("PREFIX" . "(ohv)@%+") ("BOT" . "B")))) |
| 1121 | (should (string= (pop calls) | 1131 | (should (string-prefix-p |
| 1122 | "-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su...")) | 1132 | "-EXCEPTS -CHANTYPES -FAKE PREFIX=(ohv)@%+ " |
| 1133 | (pop calls))) | ||
| 1123 | (should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t))) | 1134 | (should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t))) |
| 1124 | (should (equal "B" (erc--get-isupport-entry 'BOT t))) | 1135 | (should (equal "B" (erc--get-isupport-entry 'BOT t))) |
| 1125 | (should-not (erc--get-isupport-entry 'EXCEPTS)) | 1136 | (should-not (erc--get-isupport-entry 'EXCEPTS)) |
| @@ -1156,25 +1167,37 @@ | |||
| 1156 | (should (equal (erc-downcase "\\O/") "|o/" ))))) | 1167 | (should (equal (erc-downcase "\\O/") "|o/" ))))) |
| 1157 | 1168 | ||
| 1158 | (ert-deftest erc-channel-p () | 1169 | (ert-deftest erc-channel-p () |
| 1159 | (let ((erc--isupport-params (make-hash-table)) | 1170 | (erc-tests-common-make-server-buf) |
| 1160 | erc-server-parameters) | ||
| 1161 | |||
| 1162 | (should (erc-channel-p "#chan")) | ||
| 1163 | (should (erc-channel-p "##chan")) | ||
| 1164 | (should (erc-channel-p "&chan")) | ||
| 1165 | (should (erc-channel-p "+chan")) | ||
| 1166 | (should (erc-channel-p "!chan")) | ||
| 1167 | (should-not (erc-channel-p "@chan")) | ||
| 1168 | |||
| 1169 | (push '("CHANTYPES" . "#&@+!") erc-server-parameters) | ||
| 1170 | 1171 | ||
| 1171 | (should (erc-channel-p "!chan")) | 1172 | (should (erc-channel-p "#chan")) |
| 1172 | (should (erc-channel-p "#chan")) | 1173 | (should (erc-channel-p "##chan")) |
| 1174 | (should (erc-channel-p "&chan")) | ||
| 1175 | (should-not (erc-channel-p "+chan")) | ||
| 1176 | (should-not (erc-channel-p "!chan")) | ||
| 1177 | (should-not (erc-channel-p "@chan")) | ||
| 1178 | |||
| 1179 | ;; Server sends "CHANTYPES=#&+!" | ||
| 1180 | (should-not erc-server-parameters) | ||
| 1181 | (setq erc-server-parameters '(("CHANTYPES" . "#&+!"))) | ||
| 1182 | (should (erc-channel-p "#chan")) | ||
| 1183 | (should (erc-channel-p "&chan")) | ||
| 1184 | (should (erc-channel-p "+chan")) | ||
| 1185 | (should (erc-channel-p "!chan")) | ||
| 1186 | |||
| 1187 | (with-current-buffer (erc--open-target "#chan") | ||
| 1188 | (should (erc-channel-p (current-buffer)))) | ||
| 1189 | (with-current-buffer (erc--open-target "+chan") | ||
| 1190 | (should (erc-channel-p (current-buffer)))) | ||
| 1191 | (should (erc-channel-p (get-buffer "#chan"))) | ||
| 1192 | (should (erc-channel-p (get-buffer "+chan"))) | ||
| 1193 | |||
| 1194 | ;; Server sends "CHANTYPES=" because it's query only. | ||
| 1195 | (puthash 'CHANTYPES '("CHANTYPES") erc--isupport-params) | ||
| 1196 | (should-not (erc-channel-p "#spam")) | ||
| 1197 | (should-not (erc-channel-p "&spam")) | ||
| 1198 | (should-not (erc-channel-p (save-excursion (erc--open-target "#spam")))) | ||
| 1173 | 1199 | ||
| 1174 | (with-current-buffer (get-buffer-create "#chan") | 1200 | (erc-tests-common-kill-buffers)) |
| 1175 | (setq erc--target (erc--target-from-string "#chan"))) | ||
| 1176 | (should (erc-channel-p (get-buffer "#chan")))) | ||
| 1177 | (kill-buffer "#chan")) | ||
| 1178 | 1201 | ||
| 1179 | (ert-deftest erc--valid-local-channel-p () | 1202 | (ert-deftest erc--valid-local-channel-p () |
| 1180 | (ert-info ("Local channels not supported") | 1203 | (ert-info ("Local channels not supported") |
| @@ -1189,12 +1212,16 @@ | |||
| 1189 | (should (erc--valid-local-channel-p "&local"))))) | 1212 | (should (erc--valid-local-channel-p "&local"))))) |
| 1190 | 1213 | ||
| 1191 | (ert-deftest erc--restore-initialize-priors () | 1214 | (ert-deftest erc--restore-initialize-priors () |
| 1215 | (unless (>= emacs-major-version 28) | ||
| 1216 | (ert-skip "Lisp nesting exceeds `max-lisp-eval-depth'")) | ||
| 1192 | (should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode | 1217 | (should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode |
| 1193 | foo (ignore 1 2 3) | 1218 | foo (ignore 1 2 3) |
| 1194 | bar #'spam | 1219 | bar #'spam |
| 1195 | baz nil)) | 1220 | baz nil)) |
| 1196 | (`(let* ((,p (or erc--server-reconnecting erc--target-priors)) | 1221 | (`(let* ((,p (or erc--server-reconnecting erc--target-priors)) |
| 1197 | (,q (and ,p (alist-get 'erc-my-mode ,p)))) | 1222 | (,q (and ,p (alist-get 'erc-my-mode ,p)))) |
| 1223 | (unless (local-variable-if-set-p 'erc-my-mode) | ||
| 1224 | (error "Not a local minor mode var: %s" 'erc-my-mode)) | ||
| 1198 | (setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3)) | 1225 | (setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3)) |
| 1199 | bar (if ,q (alist-get 'bar ,p) #'spam) | 1226 | bar (if ,q (alist-get 'bar ,p) #'spam) |
| 1200 | baz (if ,q (alist-get 'baz ,p) nil))) | 1227 | baz (if ,q (alist-get 'baz ,p) nil))) |
| @@ -1273,7 +1300,7 @@ | |||
| 1273 | (setq erc-server-current-nick "tester") | 1300 | (setq erc-server-current-nick "tester") |
| 1274 | (setq-local erc-last-input-time 0) | 1301 | (setq-local erc-last-input-time 0) |
| 1275 | (should-not (local-variable-if-set-p 'erc-send-completed-hook)) | 1302 | (should-not (local-variable-if-set-p 'erc-send-completed-hook)) |
| 1276 | (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals) | 1303 | (setq-local erc-send-completed-hook nil) ; skip t (globals) |
| 1277 | ;; Just in case erc-ring-mode is already on | 1304 | ;; Just in case erc-ring-mode is already on |
| 1278 | (setq-local erc--input-review-functions erc--input-review-functions) | 1305 | (setq-local erc--input-review-functions erc--input-review-functions) |
| 1279 | (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) | 1306 | (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) |
diff --git a/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld new file mode 100644 index 00000000000..32d05cc8a3a --- /dev/null +++ b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld | |||
| @@ -0,0 +1,87 @@ | |||
| 1 | ;; -*- mode: lisp-data; -*- | ||
| 2 | ((pass 10 "PASS :changeme")) | ||
| 3 | ((nick 10 "NICK tester")) | ||
| 4 | ((user 10 "USER tester@vanilla/foonet 0 * :tester") | ||
| 5 | (0.00 ":irc.znc.in 001 tester :Welcome to ZNC") | ||
| 6 | (0.03 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") | ||
| 7 | (0.01 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") | ||
| 8 | (0.00 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") | ||
| 9 | (0.01 ":*status!znc@znc.in PRIVMSG tester :Connected!") | ||
| 10 | (0.02 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") | ||
| 11 | (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") | ||
| 12 | (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC") | ||
| 13 | (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") | ||
| 14 | (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") | ||
| 15 | (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") | ||
| 16 | (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") | ||
| 17 | (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") | ||
| 18 | (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") | ||
| 19 | (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") | ||
| 20 | (0.00 ":irc.foonet.org 254 tester 1 :channels formed") | ||
| 21 | (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") | ||
| 22 | (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") | ||
| 23 | (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") | ||
| 24 | (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") | ||
| 25 | (0.00 ":irc.foonet.org 221 tester +Zi") | ||
| 26 | (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) | ||
| 27 | |||
| 28 | ((mode 10 "MODE tester +i") | ||
| 29 | (0.01 ":irc.foonet.org 352 tester * ~u pfa3tpa5ig5ty.irc irc.foonet.org tester H :0 ZNC - https://znc.in") | ||
| 30 | (0.01 ":irc.foonet.org 315 tester tester :End of WHO list") | ||
| 31 | |||
| 32 | (0.02 ":tester!~u@pfa3tpa5ig5ty.irc JOIN #chan") | ||
| 33 | (0.03 ":irc.foonet.org 353 tester = #chan :bob tester @alice eve")) | ||
| 34 | |||
| 35 | ((mode 10 "MODE #chan") | ||
| 36 | (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list") | ||
| 37 | (0.00 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") | ||
| 38 | (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") | ||
| 39 | (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see how he will take it at your hands.") | ||
| 40 | (0.02 ":irc.foonet.org 221 tester +Zi") | ||
| 41 | (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Fear not, my lord, your servant shall do so.") | ||
| 42 | (0.02 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: If I thrive well, I'll visit thee again.") | ||
| 43 | (0.01 ":irc.foonet.org 324 tester #chan +Cnt") | ||
| 44 | (0.03 ":irc.foonet.org 329 tester #chan 1706698713") | ||
| 45 | (0.05 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Let it be forbid, sir; so should I be a great deal of his act.") | ||
| 46 | (0.04 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see a fearful sight of blood and death.") | ||
| 47 | (0.00 ":eve!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hola") | ||
| 48 | (0.01 ":eve!~u@euegh6mj3y8r2.irc NICK :Evel") | ||
| 49 | (0.01 ":Evel!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hell o") | ||
| 50 | (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: His highness comes post from Marseilles, of as able body as when he numbered thirty: he will be here to-morrow, or I am deceived by him that in such intelligence hath seldom failed.") | ||
| 51 | (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.") | ||
| 52 | (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: With the rich worth of your virginity.") | ||
| 53 | |||
| 54 | (0.02 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC. Reconnecting...") | ||
| 55 | (0.05 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") | ||
| 56 | (0.03 ":*status!znc@znc.in PRIVMSG tester :Connected!") | ||
| 57 | (0.01 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") | ||
| 58 | (0.04 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") | ||
| 59 | (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC") | ||
| 60 | (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") | ||
| 61 | (0.03 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") | ||
| 62 | (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") | ||
| 63 | (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") | ||
| 64 | (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") | ||
| 65 | (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") | ||
| 66 | (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") | ||
| 67 | (0.00 ":irc.foonet.org 254 tester 1 :channels formed") | ||
| 68 | (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") | ||
| 69 | (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") | ||
| 70 | (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") | ||
| 71 | (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") | ||
| 72 | (0.02 ":irc.foonet.org 221 tester +i") | ||
| 73 | (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") | ||
| 74 | (0.02 ":irc.foonet.org 352 tester * ~u hrn2ea3rpeyck.irc irc.foonet.org tester H :0 ZNC - https://znc.in") | ||
| 75 | (0.01 ":irc.foonet.org 315 tester tester :End of WHO list") | ||
| 76 | (0.02 ":tester!~u@hrn2ea3rpeyck.irc JOIN #chan")) | ||
| 77 | |||
| 78 | ((mode 10 "MODE #chan") | ||
| 79 | (0.00 ":irc.foonet.org 353 tester = #chan :tester @alice bob") | ||
| 80 | (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") | ||
| 81 | (0.00 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") | ||
| 82 | (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") | ||
| 83 | (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Nay, I assure you, a peace concluded.") | ||
| 84 | (0.03 ":irc.foonet.org 324 tester #chan +Cnt") | ||
| 85 | (0.01 ":irc.foonet.org 329 tester #chan 1706698713") | ||
| 86 | (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.") | ||
| 87 | (0.04 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Or to drown my clothes, and say I was stripped.")) | ||
diff --git a/test/lisp/erc/resources/commands/amsg-barnet.eld b/test/lisp/erc/resources/commands/amsg-barnet.eld new file mode 100644 index 00000000000..53b3e18651a --- /dev/null +++ b/test/lisp/erc/resources/commands/amsg-barnet.eld | |||
| @@ -0,0 +1,54 @@ | |||
| 1 | ;; -*- mode: lisp-data; -*- | ||
| 2 | ((nick 10 "NICK tester")) | ||
| 3 | ((user 10 "USER user 0 * :unknown") | ||
| 4 | (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester") | ||
| 5 | (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16") | ||
| 6 | (0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC") | ||
| 7 | (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") | ||
| 8 | (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") | ||
| 9 | (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") | ||
| 10 | (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") | ||
| 11 | (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") | ||
| 12 | (0 ":irc.barnet.org 252 tester 0 :IRC Operators online") | ||
| 13 | (0 ":irc.barnet.org 253 tester 0 :unregistered connections") | ||
| 14 | (0 ":irc.barnet.org 254 tester 1 :channels formed") | ||
| 15 | (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers") | ||
| 16 | (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3") | ||
| 17 | (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3") | ||
| 18 | (0 ":irc.barnet.org 422 tester :MOTD File is missing")) | ||
| 19 | |||
| 20 | ((mode-user 10 "MODE tester +i") | ||
| 21 | (0 ":irc.barnet.org 221 tester +i") | ||
| 22 | (0 ":irc.barnet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) | ||
| 23 | |||
| 24 | ((join 10 "JOIN #bar") | ||
| 25 | (0 ":tester!~u@jnu48g2wrycbw.irc JOIN #bar") | ||
| 26 | (0 ":irc.barnet.org 353 tester = #bar :@mike joe tester") | ||
| 27 | (0 ":irc.barnet.org 366 tester #bar :End of NAMES list")) | ||
| 28 | |||
| 29 | ((mode-bar 10 "MODE #bar") | ||
| 30 | (0 ":irc.barnet.org 324 tester #bar +nt") | ||
| 31 | (0 ":irc.barnet.org 329 tester #bar 1620104779") | ||
| 32 | (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!") | ||
| 33 | (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!") | ||
| 34 | (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Whipp'd first, sir, and hang'd after.") | ||
| 35 | (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: We have yet many among us can gripe as hard as Cassibelan; I do not say I am one, but I have a hand. Why tribute ? why should we pay tribute ? If C sar can hide the sun from us with a blanket, or put the moon in his pocket, we will pay him tribute for light; else, sir, no more tribute, pray you now.")) | ||
| 36 | |||
| 37 | ((privmsg-2 10 "PRIVMSG #bar :2 barnet only") | ||
| 38 | (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Double and treble admonition, and still forfeit in the same kind ? This would make mercy swear, and play the tyrant.") | ||
| 39 | (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: And secretly to greet the empress' friends.")) | ||
| 40 | |||
| 41 | ((privmsg-4 10 "PRIVMSG #bar :\1ACTION 4 barnet only\1") | ||
| 42 | (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: You have not been inquired after: I have sat here all day.") | ||
| 43 | (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: That same Berowne I'll torture ere I go.")) | ||
| 44 | |||
| 45 | ((privmsg-5 10 "PRIVMSG #bar :5 all nets")) | ||
| 46 | |||
| 47 | ((privmsg-6 10 "PRIVMSG #bar :\1ACTION 6 all nets\1") | ||
| 48 | (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: For mine own part,no offence to the general, nor any man of quality,I hope to be saved.") | ||
| 49 | (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: Mehercle! if their sons be ingenuous, they shall want no instruction; if their daughters be capable, I will put it to them. But, vir sapit qui pauca loquitur. A soul feminine saluteth us.")) | ||
| 50 | |||
| 51 | ((quit 5 "QUIT :\2ERC\2") | ||
| 52 | (0 ":tester!~u@jnu48g2wrycbw.irc QUIT :Quit")) | ||
| 53 | |||
| 54 | ((drop 0 DROP)) | ||
diff --git a/test/lisp/erc/resources/commands/amsg-foonet.eld b/test/lisp/erc/resources/commands/amsg-foonet.eld new file mode 100644 index 00000000000..eb3d84d646a --- /dev/null +++ b/test/lisp/erc/resources/commands/amsg-foonet.eld | |||
| @@ -0,0 +1,56 @@ | |||
| 1 | ;; -*- mode: lisp-data; -*- | ||
| 2 | ((nick 10 "NICK tester")) | ||
| 3 | ((user 10 "USER user 0 * :unknown") | ||
| 4 | (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") | ||
| 5 | (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16") | ||
| 6 | (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC") | ||
| 7 | (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") | ||
| 8 | (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") | ||
| 9 | (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") | ||
| 10 | (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") | ||
| 11 | (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") | ||
| 12 | (0 ":irc.foonet.org 252 tester 0 :IRC Operators online") | ||
| 13 | (0 ":irc.foonet.org 253 tester 0 :unregistered connections") | ||
| 14 | (0 ":irc.foonet.org 254 tester 1 :channels formed") | ||
| 15 | (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") | ||
| 16 | (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") | ||
| 17 | (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") | ||
| 18 | (0 ":irc.foonet.org 422 tester :MOTD File is missing")) | ||
| 19 | |||
| 20 | ((mode-user 10 "MODE tester +i") | ||
| 21 | (0 ":irc.foonet.org 221 tester +i") | ||
| 22 | (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) | ||
| 23 | |||
| 24 | ((join 10 "JOIN #foo") | ||
| 25 | (0 ":tester!~u@9g6b728983yd2.irc JOIN #foo") | ||
| 26 | (0 ":irc.foonet.org 353 tester = #foo :alice tester @bob") | ||
| 27 | (0 ":irc.foonet.org 366 tester #foo :End of NAMES list")) | ||
| 28 | |||
| 29 | ((mode-foo 10 "MODE #foo") | ||
| 30 | (0 ":irc.foonet.org 324 tester #foo +nt") | ||
| 31 | (0 ":irc.foonet.org 329 tester #foo 1620104779") | ||
| 32 | (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!") | ||
| 33 | (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!") | ||
| 34 | (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: But, as it seems, did violence on herself.") | ||
| 35 | (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Well, this is the forest of Arden.")) | ||
| 36 | |||
| 37 | ((privmsg-1 10 "PRIVMSG #foo :1 foonet only") | ||
| 38 | (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Signior Iachimo will not from it. Pray, let us follow 'em.") | ||
| 39 | (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Our queen and all her elves come here anon.")) | ||
| 40 | |||
| 41 | ((privmsg-3 10 "PRIVMSG #foo :\1ACTION 3 foonet only\1") | ||
| 42 | (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: The ground is bloody; search about the churchyard.") | ||
| 43 | (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: You have discharged this honestly: keep it to yourself. Many likelihoods informed me of this before, which hung so tottering in the balance that I could neither believe nor misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for your honest care. I will speak with you further anon.")) | ||
| 44 | |||
| 45 | ((privmsg-5 10 "PRIVMSG #foo :5 all nets")) | ||
| 46 | |||
| 47 | ((privmsg-6 10 "PRIVMSG #foo :\1ACTION 6 all nets\1") | ||
| 48 | (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Give me that mattock, and the wrenching iron.") | ||
| 49 | (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Stand you! You have land enough of your own; but he added to your having, gave you some ground.")) | ||
| 50 | |||
| 51 | ((privmsg-6 10 "PRIVMSG #foo :7 all live nets") | ||
| 52 | (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")) | ||
| 53 | |||
| 54 | ((privmsg-6 10 "PRIVMSG #foo :\1ACTION 8 all live nets\1") | ||
| 55 | (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.") | ||
| 56 | (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Live, and be prosperous; and farewell, good fellow.")) | ||
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 0ec48d766ef..9ad5ce49429 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el | |||
| @@ -94,7 +94,8 @@ | |||
| 94 | (require 'erc) | 94 | (require 'erc) |
| 95 | 95 | ||
| 96 | (eval-when-compile (require 'erc-join) | 96 | (eval-when-compile (require 'erc-join) |
| 97 | (require 'erc-services)) | 97 | (require 'erc-services) |
| 98 | (require 'erc-fill)) | ||
| 98 | 99 | ||
| 99 | (declare-function erc-network "erc-networks") | 100 | (declare-function erc-network "erc-networks") |
| 100 | (defvar erc-network) | 101 | (defvar erc-network) |
| @@ -148,9 +149,11 @@ | |||
| 148 | (timer-list (copy-sequence timer-list)) | 149 | (timer-list (copy-sequence timer-list)) |
| 149 | (timer-idle-list (copy-sequence timer-idle-list)) | 150 | (timer-idle-list (copy-sequence timer-idle-list)) |
| 150 | (erc-auth-source-parameters-join-function nil) | 151 | (erc-auth-source-parameters-join-function nil) |
| 152 | (erc--fill-wrap-scrolltobottom-exempt-p t) | ||
| 151 | (erc-autojoin-channels-alist nil) | 153 | (erc-autojoin-channels-alist nil) |
| 152 | (erc-server-auto-reconnect nil) | 154 | (erc-server-auto-reconnect nil) |
| 153 | (erc-after-connect nil) | 155 | (erc-after-connect nil) |
| 156 | (erc-last-input-time 0) | ||
| 154 | (erc-d-linger-secs 10) | 157 | (erc-d-linger-secs 10) |
| 155 | ,@bindings))) | 158 | ,@bindings))) |
| 156 | 159 | ||
diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 05dbe1d50d6..99f15b89b03 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el | |||
| @@ -122,7 +122,7 @@ Use NAME for the network and the session server as well." | |||
| 122 | erc--isupport-params (make-hash-table) | 122 | erc--isupport-params (make-hash-table) |
| 123 | erc-session-port 6667 | 123 | erc-session-port 6667 |
| 124 | erc-network (intern name) | 124 | erc-network (intern name) |
| 125 | erc-networks--id (erc-networks--id-create nil)) | 125 | erc-networks--id (erc-networks--id-create name)) |
| 126 | (current-buffer))) | 126 | (current-buffer))) |
| 127 | 127 | ||
| 128 | (defun erc-tests-common-string-to-propertized-parts (string) | 128 | (defun erc-tests-common-string-to-propertized-parts (string) |
diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el index 8d6e0c1e426..4e5373e53cd 100644 --- a/test/lisp/eshell/esh-opt-tests.el +++ b/test/lisp/eshell/esh-opt-tests.el | |||
| @@ -29,13 +29,15 @@ | |||
| 29 | (eshell--process-args | 29 | (eshell--process-args |
| 30 | "sudo" '("-a") | 30 | "sudo" '("-a") |
| 31 | '((?a "all" nil show-all | 31 | '((?a "all" nil show-all |
| 32 | "do not ignore entries starting with ."))))) | 32 | "do not ignore entries starting with .")) |
| 33 | '(show-all)))) | ||
| 33 | (should | 34 | (should |
| 34 | (equal '("root" "world") | 35 | (equal '("root" "world") |
| 35 | (eshell--process-args | 36 | (eshell--process-args |
| 36 | "sudo" '("-u" "root" "world") | 37 | "sudo" '("-u" "root" "world") |
| 37 | '((?u "user" t user | 38 | '((?u "user" t user |
| 38 | "execute a command as another USER")))))) | 39 | "execute a command as another USER")) |
| 40 | '(user))))) | ||
| 39 | 41 | ||
| 40 | (ert-deftest esh-opt-test/process-args-parse-leading-options-only () | 42 | (ert-deftest esh-opt-test/process-args-parse-leading-options-only () |
| 41 | "Test behavior of :parse-leading-options-only in `eshell--process-args'." | 43 | "Test behavior of :parse-leading-options-only in `eshell--process-args'." |
| @@ -45,20 +47,23 @@ | |||
| 45 | "sudo" '("emerge" "-uDN" "world") | 47 | "sudo" '("emerge" "-uDN" "world") |
| 46 | '((?u "user" t user | 48 | '((?u "user" t user |
| 47 | "execute a command as another USER") | 49 | "execute a command as another USER") |
| 48 | :parse-leading-options-only)))) | 50 | :parse-leading-options-only) |
| 51 | '(user)))) | ||
| 49 | (should | 52 | (should |
| 50 | (equal '("root" "emerge" "-uDN" "world") | 53 | (equal '("root" "emerge" "-uDN" "world") |
| 51 | (eshell--process-args | 54 | (eshell--process-args |
| 52 | "sudo" '("-u" "root" "emerge" "-uDN" "world") | 55 | "sudo" '("-u" "root" "emerge" "-uDN" "world") |
| 53 | '((?u "user" t user | 56 | '((?u "user" t user |
| 54 | "execute a command as another USER") | 57 | "execute a command as another USER") |
| 55 | :parse-leading-options-only)))) | 58 | :parse-leading-options-only) |
| 59 | '(user)))) | ||
| 56 | (should | 60 | (should |
| 57 | (equal '("DN" "emerge" "world") | 61 | (equal '("DN" "emerge" "world") |
| 58 | (eshell--process-args | 62 | (eshell--process-args |
| 59 | "sudo" '("-u" "root" "emerge" "-uDN" "world") | 63 | "sudo" '("-u" "root" "emerge" "-uDN" "world") |
| 60 | '((?u "user" t user | 64 | '((?u "user" t user |
| 61 | "execute a command as another USER")))))) | 65 | "execute a command as another USER")) |
| 66 | '(user))))) | ||
| 62 | 67 | ||
| 63 | (ert-deftest esh-opt-test/process-args-external () | 68 | (ert-deftest esh-opt-test/process-args-external () |
| 64 | "Test behavior of :external in `eshell--process-args'." | 69 | "Test behavior of :external in `eshell--process-args'." |
| @@ -69,7 +74,8 @@ | |||
| 69 | "ls" '("/some/path") | 74 | "ls" '("/some/path") |
| 70 | '((?a "all" nil show-all | 75 | '((?a "all" nil show-all |
| 71 | "do not ignore entries starting with .") | 76 | "do not ignore entries starting with .") |
| 72 | :external "ls"))))) | 77 | :external "ls") |
| 78 | '(show-all))))) | ||
| 73 | (cl-letf (((symbol-function 'eshell-search-path) #'identity)) | 79 | (cl-letf (((symbol-function 'eshell-search-path) #'identity)) |
| 74 | (should | 80 | (should |
| 75 | (equal '(no-catch eshell-ext-command "ls") | 81 | (equal '(no-catch eshell-ext-command "ls") |
| @@ -78,7 +84,8 @@ | |||
| 78 | "ls" '("-u" "/some/path") | 84 | "ls" '("-u" "/some/path") |
| 79 | '((?a "all" nil show-all | 85 | '((?a "all" nil show-all |
| 80 | "do not ignore entries starting with .") | 86 | "do not ignore entries starting with .") |
| 81 | :external "ls")) | 87 | :external "ls") |
| 88 | '(show-all)) | ||
| 82 | :type 'no-catch)))) | 89 | :type 'no-catch)))) |
| 83 | (cl-letf (((symbol-function 'eshell-search-path) #'ignore)) | 90 | (cl-letf (((symbol-function 'eshell-search-path) #'ignore)) |
| 84 | (should-error | 91 | (should-error |
| @@ -86,7 +93,8 @@ | |||
| 86 | "ls" '("-u" "/some/path") | 93 | "ls" '("-u" "/some/path") |
| 87 | '((?a "all" nil show-all | 94 | '((?a "all" nil show-all |
| 88 | "do not ignore entries starting with .") | 95 | "do not ignore entries starting with .") |
| 89 | :external "ls")) | 96 | :external "ls") |
| 97 | '(show-all)) | ||
| 90 | :type 'error))) | 98 | :type 'error))) |
| 91 | 99 | ||
| 92 | (ert-deftest esh-opt-test/eval-using-options-short () | 100 | (ert-deftest esh-opt-test/eval-using-options-short () |
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index e01e033e25e..e58b5a14ed9 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el | |||
| @@ -153,7 +153,7 @@ insert the queued one at the next prompt, and finally run it." | |||
| 153 | "Test flushing of previous output" | 153 | "Test flushing of previous output" |
| 154 | (with-temp-eshell | 154 | (with-temp-eshell |
| 155 | (eshell-insert-command "echo alpha") | 155 | (eshell-insert-command "echo alpha") |
| 156 | (eshell-kill-output) | 156 | (eshell-delete-output) |
| 157 | (should (eshell-match-output | 157 | (should (eshell-match-output |
| 158 | (concat "^" (regexp-quote "*** output flushed ***\n") "$"))))) | 158 | (concat "^" (regexp-quote "*** output flushed ***\n") "$"))))) |
| 159 | 159 | ||
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 11af1f75574..28f4d5fa181 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el | |||
| @@ -74,8 +74,8 @@ | |||
| 74 | (defvar file-notify--test-events nil) | 74 | (defvar file-notify--test-events nil) |
| 75 | (defvar file-notify--test-monitors nil) | 75 | (defvar file-notify--test-monitors nil) |
| 76 | 76 | ||
| 77 | (defun file-notify--test-read-event () | 77 | (defun file-notify--test-wait-event () |
| 78 | "Read one event. | 78 | "Wait for one event. |
| 79 | There are different timeouts for local and remote file notification libraries." | 79 | There are different timeouts for local and remote file notification libraries." |
| 80 | (read-event | 80 | (read-event |
| 81 | nil nil | 81 | nil nil |
| @@ -87,7 +87,8 @@ There are different timeouts for local and remote file notification libraries." | |||
| 87 | ;; for any monitor. | 87 | ;; for any monitor. |
| 88 | ((file-notify--test-monitor) 7) | 88 | ((file-notify--test-monitor) 7) |
| 89 | ((file-remote-p temporary-file-directory) 0.1) | 89 | ((file-remote-p temporary-file-directory) 0.1) |
| 90 | (t 0.01)))) | 90 | (t 0.01))) |
| 91 | nil) | ||
| 91 | 92 | ||
| 92 | (defun file-notify--test-timeout () | 93 | (defun file-notify--test-timeout () |
| 93 | "Timeout to wait for arriving a bunch of events, in seconds." | 94 | "Timeout to wait for arriving a bunch of events, in seconds." |
| @@ -103,7 +104,7 @@ There are different timeouts for local and remote file notification libraries." | |||
| 103 | TIMEOUT is the maximum time to wait for, in seconds." | 104 | TIMEOUT is the maximum time to wait for, in seconds." |
| 104 | `(with-timeout (,timeout (ignore)) | 105 | `(with-timeout (,timeout (ignore)) |
| 105 | (while (null ,until) | 106 | (while (null ,until) |
| 106 | (file-notify--test-read-event)))) | 107 | (file-notify--test-wait-event)))) |
| 107 | 108 | ||
| 108 | (defun file-notify--test-no-descriptors () | 109 | (defun file-notify--test-no-descriptors () |
| 109 | "Check that `file-notify-descriptors' is an empty hash table. | 110 | "Check that `file-notify-descriptors' is an empty hash table. |
| @@ -452,7 +453,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." | |||
| 452 | ;; Check, that removing watch descriptors out of order do not | 453 | ;; Check, that removing watch descriptors out of order do not |
| 453 | ;; harm. This fails on cygwin because of timing issues unless a | 454 | ;; harm. This fails on cygwin because of timing issues unless a |
| 454 | ;; long `sit-for' is added before the call to | 455 | ;; long `sit-for' is added before the call to |
| 455 | ;; `file-notify--test-read-event'. | 456 | ;; `file-notify--test-wait-event'. |
| 456 | (unless (eq system-type 'cygwin) | 457 | (unless (eq system-type 'cygwin) |
| 457 | (let (results) | 458 | (let (results) |
| 458 | (cl-flet ((first-callback (event) | 459 | (cl-flet ((first-callback (event) |
| @@ -480,7 +481,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." | |||
| 480 | ;; Remove first watch. | 481 | ;; Remove first watch. |
| 481 | (file-notify-rm-watch file-notify--test-desc) | 482 | (file-notify-rm-watch file-notify--test-desc) |
| 482 | ;; Only the second callback shall run. | 483 | ;; Only the second callback shall run. |
| 483 | (file-notify--test-read-event) | 484 | (file-notify--test-wait-event) |
| 484 | (delete-file file-notify--test-tmpfile) | 485 | (delete-file file-notify--test-tmpfile) |
| 485 | (file-notify--test-wait-for-events | 486 | (file-notify--test-wait-for-events |
| 486 | (file-notify--test-timeout) results) | 487 | (file-notify--test-timeout) results) |
| @@ -622,7 +623,7 @@ delivered." | |||
| 622 | (cons 'file-notify while-no-input-ignore-events)) | 623 | (cons 'file-notify while-no-input-ignore-events)) |
| 623 | create-lockfiles) | 624 | create-lockfiles) |
| 624 | ;; Flush pending actions. | 625 | ;; Flush pending actions. |
| 625 | (file-notify--test-read-event) | 626 | (file-notify--test-wait-event) |
| 626 | (file-notify--test-wait-for-events | 627 | (file-notify--test-wait-for-events |
| 627 | (file-notify--test-timeout) | 628 | (file-notify--test-timeout) |
| 628 | (not (input-pending-p))) | 629 | (not (input-pending-p))) |
| @@ -671,7 +672,7 @@ delivered." | |||
| 671 | (t '(created changed deleted stopped))) | 672 | (t '(created changed deleted stopped))) |
| 672 | (write-region | 673 | (write-region |
| 673 | "another text" nil file-notify--test-tmpfile nil 'no-message) | 674 | "another text" nil file-notify--test-tmpfile nil 'no-message) |
| 674 | (file-notify--test-read-event) | 675 | (file-notify--test-wait-event) |
| 675 | (delete-file file-notify--test-tmpfile)) | 676 | (delete-file file-notify--test-tmpfile)) |
| 676 | (file-notify-rm-watch file-notify--test-desc) | 677 | (file-notify-rm-watch file-notify--test-desc) |
| 677 | 678 | ||
| @@ -707,7 +708,7 @@ delivered." | |||
| 707 | (changed changed deleted stopped)))) | 708 | (changed changed deleted stopped)))) |
| 708 | (write-region | 709 | (write-region |
| 709 | "another text" nil file-notify--test-tmpfile nil 'no-message) | 710 | "another text" nil file-notify--test-tmpfile nil 'no-message) |
| 710 | (file-notify--test-read-event) | 711 | (file-notify--test-wait-event) |
| 711 | (delete-file file-notify--test-tmpfile)) | 712 | (delete-file file-notify--test-tmpfile)) |
| 712 | (file-notify-rm-watch file-notify--test-desc) | 713 | (file-notify-rm-watch file-notify--test-desc) |
| 713 | 714 | ||
| @@ -755,7 +756,7 @@ delivered." | |||
| 755 | (t '(created changed deleted deleted stopped))) | 756 | (t '(created changed deleted deleted stopped))) |
| 756 | (write-region | 757 | (write-region |
| 757 | "any text" nil file-notify--test-tmpfile nil 'no-message) | 758 | "any text" nil file-notify--test-tmpfile nil 'no-message) |
| 758 | (file-notify--test-read-event) | 759 | (file-notify--test-wait-event) |
| 759 | (delete-directory file-notify--test-tmpdir 'recursive)) | 760 | (delete-directory file-notify--test-tmpdir 'recursive)) |
| 760 | (file-notify-rm-watch file-notify--test-desc) | 761 | (file-notify-rm-watch file-notify--test-desc) |
| 761 | 762 | ||
| @@ -805,14 +806,14 @@ delivered." | |||
| 805 | deleted deleted deleted stopped))) | 806 | deleted deleted deleted stopped))) |
| 806 | (write-region | 807 | (write-region |
| 807 | "any text" nil file-notify--test-tmpfile nil 'no-message) | 808 | "any text" nil file-notify--test-tmpfile nil 'no-message) |
| 808 | (file-notify--test-read-event) | 809 | (file-notify--test-wait-event) |
| 809 | (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) | 810 | (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) |
| 810 | ;; The next two events shall not be visible. | 811 | ;; The next two events shall not be visible. |
| 811 | (file-notify--test-read-event) | 812 | (file-notify--test-wait-event) |
| 812 | (set-file-modes file-notify--test-tmpfile 000 'nofollow) | 813 | (set-file-modes file-notify--test-tmpfile 000 'nofollow) |
| 813 | (file-notify--test-read-event) | 814 | (file-notify--test-wait-event) |
| 814 | (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow) | 815 | (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow) |
| 815 | (file-notify--test-read-event) | 816 | (file-notify--test-wait-event) |
| 816 | (delete-directory file-notify--test-tmpdir 'recursive)) | 817 | (delete-directory file-notify--test-tmpdir 'recursive)) |
| 817 | (file-notify-rm-watch file-notify--test-desc) | 818 | (file-notify-rm-watch file-notify--test-desc) |
| 818 | 819 | ||
| @@ -860,10 +861,10 @@ delivered." | |||
| 860 | (t '(created changed renamed deleted deleted stopped))) | 861 | (t '(created changed renamed deleted deleted stopped))) |
| 861 | (write-region | 862 | (write-region |
| 862 | "any text" nil file-notify--test-tmpfile nil 'no-message) | 863 | "any text" nil file-notify--test-tmpfile nil 'no-message) |
| 863 | (file-notify--test-read-event) | 864 | (file-notify--test-wait-event) |
| 864 | (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) | 865 | (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) |
| 865 | ;; After the rename, we won't get events anymore. | 866 | ;; After the rename, we won't get events anymore. |
| 866 | (file-notify--test-read-event) | 867 | (file-notify--test-wait-event) |
| 867 | (delete-directory file-notify--test-tmpdir 'recursive)) | 868 | (delete-directory file-notify--test-tmpdir 'recursive)) |
| 868 | (file-notify-rm-watch file-notify--test-desc) | 869 | (file-notify-rm-watch file-notify--test-desc) |
| 869 | 870 | ||
| @@ -912,11 +913,11 @@ delivered." | |||
| 912 | (t '(attribute-changed attribute-changed))) | 913 | (t '(attribute-changed attribute-changed))) |
| 913 | (write-region | 914 | (write-region |
| 914 | "any text" nil file-notify--test-tmpfile nil 'no-message) | 915 | "any text" nil file-notify--test-tmpfile nil 'no-message) |
| 915 | (file-notify--test-read-event) | 916 | (file-notify--test-wait-event) |
| 916 | (set-file-modes file-notify--test-tmpfile 000 'nofollow) | 917 | (set-file-modes file-notify--test-tmpfile 000 'nofollow) |
| 917 | (file-notify--test-read-event) | 918 | (file-notify--test-wait-event) |
| 918 | (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow) | 919 | (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow) |
| 919 | (file-notify--test-read-event) | 920 | (file-notify--test-wait-event) |
| 920 | (delete-file file-notify--test-tmpfile)) | 921 | (delete-file file-notify--test-tmpfile)) |
| 921 | (file-notify-rm-watch file-notify--test-desc) | 922 | (file-notify-rm-watch file-notify--test-desc) |
| 922 | 923 | ||
| @@ -1087,7 +1088,7 @@ delivered." | |||
| 1087 | (changed changed deleted stopped)))) | 1088 | (changed changed deleted stopped)))) |
| 1088 | (write-region | 1089 | (write-region |
| 1089 | "another text" nil file-notify--test-tmpfile nil 'no-message) | 1090 | "another text" nil file-notify--test-tmpfile nil 'no-message) |
| 1090 | (file-notify--test-read-event) | 1091 | (file-notify--test-wait-event) |
| 1091 | (delete-file file-notify--test-tmpfile)) | 1092 | (delete-file file-notify--test-tmpfile)) |
| 1092 | ;; After deleting the file, the descriptor is not valid anymore. | 1093 | ;; After deleting the file, the descriptor is not valid anymore. |
| 1093 | (should-not (file-notify-valid-p file-notify--test-desc)) | 1094 | (should-not (file-notify-valid-p file-notify--test-desc)) |
| @@ -1134,7 +1135,7 @@ delivered." | |||
| 1134 | (t '(created changed deleted deleted stopped))) | 1135 | (t '(created changed deleted deleted stopped))) |
| 1135 | (write-region | 1136 | (write-region |
| 1136 | "any text" nil file-notify--test-tmpfile nil 'no-message) | 1137 | "any text" nil file-notify--test-tmpfile nil 'no-message) |
| 1137 | (file-notify--test-read-event) | 1138 | (file-notify--test-wait-event) |
| 1138 | (delete-directory file-notify--test-tmpdir 'recursive)) | 1139 | (delete-directory file-notify--test-tmpdir 'recursive)) |
| 1139 | ;; After deleting the parent directory, the descriptor must | 1140 | ;; After deleting the parent directory, the descriptor must |
| 1140 | ;; not be valid anymore. | 1141 | ;; not be valid anymore. |
| @@ -1247,9 +1248,9 @@ delivered." | |||
| 1247 | (let ((source-file-list source-file-list) | 1248 | (let ((source-file-list source-file-list) |
| 1248 | (target-file-list target-file-list)) | 1249 | (target-file-list target-file-list)) |
| 1249 | (while (and source-file-list target-file-list) | 1250 | (while (and source-file-list target-file-list) |
| 1250 | (file-notify--test-read-event) | 1251 | (file-notify--test-wait-event) |
| 1251 | (write-region "" nil (pop source-file-list) nil 'no-message) | 1252 | (write-region "" nil (pop source-file-list) nil 'no-message) |
| 1252 | (file-notify--test-read-event) | 1253 | (file-notify--test-wait-event) |
| 1253 | (write-region "" nil (pop target-file-list) nil 'no-message)))) | 1254 | (write-region "" nil (pop target-file-list) nil 'no-message)))) |
| 1254 | (file-notify--test-with-actions | 1255 | (file-notify--test-with-actions |
| 1255 | (cond | 1256 | (cond |
| @@ -1272,11 +1273,11 @@ delivered." | |||
| 1272 | (let ((source-file-list source-file-list) | 1273 | (let ((source-file-list source-file-list) |
| 1273 | (target-file-list target-file-list)) | 1274 | (target-file-list target-file-list)) |
| 1274 | (while (and source-file-list target-file-list) | 1275 | (while (and source-file-list target-file-list) |
| 1275 | (file-notify--test-read-event) | 1276 | (file-notify--test-wait-event) |
| 1276 | (rename-file (pop source-file-list) (pop target-file-list) t)))) | 1277 | (rename-file (pop source-file-list) (pop target-file-list) t)))) |
| 1277 | (file-notify--test-with-actions (make-list n 'deleted) | 1278 | (file-notify--test-with-actions (make-list n 'deleted) |
| 1278 | (dolist (file target-file-list) | 1279 | (dolist (file target-file-list) |
| 1279 | (file-notify--test-read-event) | 1280 | (file-notify--test-wait-event) |
| 1280 | (delete-file file))) | 1281 | (delete-file file))) |
| 1281 | (delete-directory file-notify--test-tmpfile) | 1282 | (delete-directory file-notify--test-tmpfile) |
| 1282 | (if (or (string-equal (file-notify--test-library) "w32notify") | 1283 | (if (or (string-equal (file-notify--test-library) "w32notify") |
| @@ -1464,7 +1465,7 @@ the file watch." | |||
| 1464 | ;; does not report the `changed' event. | 1465 | ;; does not report the `changed' event. |
| 1465 | (make-list (/ n 2) 'created))) | 1466 | (make-list (/ n 2) 'created))) |
| 1466 | (dotimes (i n) | 1467 | (dotimes (i n) |
| 1467 | (file-notify--test-read-event) | 1468 | (file-notify--test-wait-event) |
| 1468 | (if (zerop (mod i 2)) | 1469 | (if (zerop (mod i 2)) |
| 1469 | (write-region | 1470 | (write-region |
| 1470 | "any text" nil file-notify--test-tmpfile1 t 'no-message) | 1471 | "any text" nil file-notify--test-tmpfile1 t 'no-message) |
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 718ecd51f8b..d4c1ef3ba67 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el | |||
| @@ -1656,30 +1656,47 @@ The door of all subtleties! | |||
| 1656 | (should (equal (file-name-base "foo") "foo")) | 1656 | (should (equal (file-name-base "foo") "foo")) |
| 1657 | (should (equal (file-name-base "foo/bar") "bar"))) | 1657 | (should (equal (file-name-base "foo/bar") "bar"))) |
| 1658 | 1658 | ||
| 1659 | (defun files-tests--check-shebang (shebang expected-mode) | 1659 | (defvar sh-shell) |
| 1660 | "Assert that mode for SHEBANG derives from EXPECTED-MODE." | 1660 | |
| 1661 | (let ((actual-mode | 1661 | (defun files-tests--check-shebang (shebang expected-mode &optional expected-dialect) |
| 1662 | (ert-with-temp-file script-file | 1662 | "Assert that mode for SHEBANG derives from EXPECTED-MODE. |
| 1663 | :text shebang | 1663 | |
| 1664 | (find-file script-file) | 1664 | If EXPECTED-MODE is sh-base-mode, DIALECT says what `sh-shell' should be |
| 1665 | (if (derived-mode-p expected-mode) | 1665 | set to." |
| 1666 | expected-mode | 1666 | (ert-with-temp-file script-file |
| 1667 | major-mode)))) | 1667 | :text shebang |
| 1668 | ;; Tuck all the information we need in the `should' form: input | 1668 | (find-file script-file) |
| 1669 | ;; shebang, expected mode vs actual. | 1669 | (let ((actual-mode (if (derived-mode-p expected-mode) |
| 1670 | (should | 1670 | expected-mode |
| 1671 | (equal (list shebang actual-mode) | 1671 | major-mode))) |
| 1672 | (list shebang expected-mode))))) | 1672 | ;; Tuck all the information we need in the `should' form: input |
| 1673 | ;; shebang, expected mode vs actual. | ||
| 1674 | (should | ||
| 1675 | (equal (list shebang actual-mode) | ||
| 1676 | (list shebang expected-mode))) | ||
| 1677 | (when (eq expected-mode 'sh-base-mode) | ||
| 1678 | (should (eq sh-shell expected-dialect)))))) | ||
| 1673 | 1679 | ||
| 1674 | (ert-deftest files-tests-auto-mode-interpreter () | 1680 | (ert-deftest files-tests-auto-mode-interpreter () |
| 1675 | "Test that `set-auto-mode' deduces correct modes from shebangs." | 1681 | "Test that `set-auto-mode' deduces correct modes from shebangs." |
| 1676 | (files-tests--check-shebang "#!/bin/bash" 'sh-mode) | 1682 | ;; Straightforward interpreter invocation. |
| 1677 | (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-mode) | 1683 | (files-tests--check-shebang "#!/bin/bash" 'sh-base-mode 'bash) |
| 1684 | (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode) | ||
| 1685 | ;; Invocation through env. | ||
| 1686 | (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-base-mode 'bash) | ||
| 1678 | (files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode) | 1687 | (files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode) |
| 1679 | (files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode) | 1688 | (files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode) |
| 1689 | ;; Invocation through env, with supplementary arguments. | ||
| 1690 | (files-tests--check-shebang "#!/usr/bin/env --split-string=bash -eux" 'sh-base-mode 'bash) | ||
| 1691 | (files-tests--check-shebang "#!/usr/bin/env --split-string=-iv --default-signal bash -eux" 'sh-base-mode 'bash) | ||
| 1680 | (files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v OFS=\"\\t\" -f" 'awk-mode) | 1692 | (files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v OFS=\"\\t\" -f" 'awk-mode) |
| 1681 | (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode) | 1693 | (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode) |
| 1682 | (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode)) | 1694 | (files-tests--check-shebang "#!/usr/bin/env -S-vi bash -eux" 'sh-base-mode 'bash) |
| 1695 | (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal=INT bash -eux" 'sh-base-mode 'bash) | ||
| 1696 | (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal bash -eux" 'sh-base-mode 'bash) | ||
| 1697 | (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash) | ||
| 1698 | ;; Invocation through env, with modified environment. | ||
| 1699 | (files-tests--check-shebang "#!/usr/bin/env -S PYTHONPATH=/...:${PYTHONPATH} python" 'python-base-mode)) | ||
| 1683 | 1700 | ||
| 1684 | (ert-deftest files-test-dir-locals-auto-mode-alist () | 1701 | (ert-deftest files-test-dir-locals-auto-mode-alist () |
| 1685 | "Test an `auto-mode-alist' entry in `.dir-locals.el'" | 1702 | "Test an `auto-mode-alist' entry in `.dir-locals.el'" |
diff --git a/test/lisp/info-tests.el b/test/lisp/info-tests.el index 0dfdbf417e8..8020a7419cf 100644 --- a/test/lisp/info-tests.el +++ b/test/lisp/info-tests.el | |||
| @@ -28,18 +28,20 @@ | |||
| 28 | (require 'ert-x) | 28 | (require 'ert-x) |
| 29 | 29 | ||
| 30 | (ert-deftest test-info-urls () | 30 | (ert-deftest test-info-urls () |
| 31 | (should (equal (Info-url-for-node "(tramp)Top") | ||
| 32 | "https://www.gnu.org/software/emacs/manual/html_node/tramp/")) | ||
| 31 | (should (equal (Info-url-for-node "(emacs)Minibuffer") | 33 | (should (equal (Info-url-for-node "(emacs)Minibuffer") |
| 32 | "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer")) | 34 | "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html")) |
| 33 | (should (equal (Info-url-for-node "(emacs)Minibuffer File") | 35 | (should (equal (Info-url-for-node "(emacs)Minibuffer File") |
| 34 | "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File")) | 36 | "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File.html")) |
| 35 | (should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving") | 37 | (should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving") |
| 36 | "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving")) | 38 | "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving.html")) |
| 37 | (should (equal (Info-url-for-node "(eintr)car & cdr") | 39 | (should (equal (Info-url-for-node "(eintr)car & cdr") |
| 38 | "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr")) | 40 | "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr.html")) |
| 39 | (should (equal (Info-url-for-node "(emacs-mime)\tIndex") | 41 | (should (equal (Info-url-for-node "(emacs-mime)\tIndex") |
| 40 | "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index")) | 42 | "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index.html")) |
| 41 | (should (equal (Info-url-for-node "(gnus) Don't Panic") | 43 | (should (equal (Info-url-for-node "(gnus) Don't Panic") |
| 42 | "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic")) | 44 | "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic.html")) |
| 43 | (should-error (Info-url-for-node "(nonexistent)Example"))) | 45 | (should-error (Info-url-for-node "(nonexistent)Example"))) |
| 44 | 46 | ||
| 45 | ;;; info-tests.el ends here | 47 | ;;; info-tests.el ends here |
diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 5c742451a57..9a80ced55ae 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el | |||
| @@ -96,10 +96,10 @@ | |||
| 96 | 96 | ||
| 97 | ;;; Testing `sgml-html-meta-auto-coding-function'. | 97 | ;;; Testing `sgml-html-meta-auto-coding-function'. |
| 98 | 98 | ||
| 99 | (defconst sgml-html-meta-pre "<!doctype html><html><head>" | 99 | (defvar sgml-html-meta-pre "<!doctype html><html><head>" |
| 100 | "The beginning of a minimal HTML document.") | 100 | "The beginning of a minimal HTML document.") |
| 101 | 101 | ||
| 102 | (defconst sgml-html-meta-post "</head></html>" | 102 | (defvar sgml-html-meta-post "</head></html>" |
| 103 | "The end of a minimal HTML document.") | 103 | "The end of a minimal HTML document.") |
| 104 | 104 | ||
| 105 | (defun sgml-html-meta-run (coding-system) | 105 | (defun sgml-html-meta-run (coding-system) |
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 07c4dbc3197..c4a7de9e51f 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el | |||
| @@ -201,6 +201,13 @@ | |||
| 201 | 'completions-first-difference) | 201 | 'completions-first-difference) |
| 202 | return pos)) | 202 | return pos)) |
| 203 | 203 | ||
| 204 | (ert-deftest completion-test--pcm-bug38458 () | ||
| 205 | (should (equal (let ((completion-ignore-case t)) | ||
| 206 | (completion-pcm--merge-try '("tes" point "ing") | ||
| 207 | '("Testing" "testing") | ||
| 208 | "" "")) | ||
| 209 | '("testing" . 4)))) | ||
| 210 | |||
| 204 | (ert-deftest completion-pcm-test-1 () | 211 | (ert-deftest completion-pcm-test-1 () |
| 205 | ;; Point is at end, this does not match anything | 212 | ;; Point is at end, this does not match anything |
| 206 | (should (null | 213 | (should (null |
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 978342b1bb1..1ca2fa9b9b3 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el | |||
| @@ -77,7 +77,7 @@ A resource file is in the resource directory as per | |||
| 77 | `ert-resource-directory'." | 77 | `ert-resource-directory'." |
| 78 | `(expand-file-name ,file (ert-resource-directory))))) | 78 | `(expand-file-name ,file (ert-resource-directory))))) |
| 79 | 79 | ||
| 80 | (defconst tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") | 80 | (defvar tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") |
| 81 | "The test file archive.") | 81 | "The test file archive.") |
| 82 | 82 | ||
| 83 | (defun tramp-archive-test-file-archive-hexlified () | 83 | (defun tramp-archive-test-file-archive-hexlified () |
| @@ -86,7 +86,7 @@ Do not hexlify \"/\". This hexlified string is used in `file:///' URLs." | |||
| 86 | (let* ((url-unreserved-chars (cons ?/ url-unreserved-chars))) | 86 | (let* ((url-unreserved-chars (cons ?/ url-unreserved-chars))) |
| 87 | (url-hexify-string tramp-archive-test-file-archive))) | 87 | (url-hexify-string tramp-archive-test-file-archive))) |
| 88 | 88 | ||
| 89 | (defconst tramp-archive-test-archive | 89 | (defvar tramp-archive-test-archive |
| 90 | (file-name-as-directory tramp-archive-test-file-archive) | 90 | (file-name-as-directory tramp-archive-test-file-archive) |
| 91 | "The test archive.") | 91 | "The test archive.") |
| 92 | 92 | ||
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 2a3b3e16891..cdd2a1efdb2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -265,8 +265,8 @@ is greater than 10. | |||
| 265 | `(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0))) | 265 | `(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0))) |
| 266 | (debug-ignored-errors | 266 | (debug-ignored-errors |
| 267 | (append | 267 | (append |
| 268 | '("^make-symbolic-link not supported$" | 268 | '("\\`make-symbolic-link not supported\\'" |
| 269 | "^error with add-name-to-file") | 269 | "\\`error with add-name-to-file") |
| 270 | debug-ignored-errors)) | 270 | debug-ignored-errors)) |
| 271 | inhibit-message) | 271 | inhibit-message) |
| 272 | (unwind-protect | 272 | (unwind-protect |
| @@ -379,7 +379,7 @@ is greater than 10. | |||
| 379 | (let (tramp-mode) | 379 | (let (tramp-mode) |
| 380 | (should-not (tramp-tramp-file-p "/method:user@host:"))) | 380 | (should-not (tramp-tramp-file-p "/method:user@host:"))) |
| 381 | ;; `tramp-ignored-file-name-regexp' suppresses Tramp. | 381 | ;; `tramp-ignored-file-name-regexp' suppresses Tramp. |
| 382 | (let ((tramp-ignored-file-name-regexp "^/method:user@host:")) | 382 | (let ((tramp-ignored-file-name-regexp "\\`/method:user@host:")) |
| 383 | (should-not (tramp-tramp-file-p "/method:user@host:"))) | 383 | (should-not (tramp-tramp-file-p "/method:user@host:"))) |
| 384 | ;; Methods shall be at least two characters, except the | 384 | ;; Methods shall be at least two characters, except the |
| 385 | ;; default method. | 385 | ;; default method. |
| @@ -3493,6 +3493,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." | |||
| 3493 | (skip-unless (not (tramp--test-rsync-p))) | 3493 | (skip-unless (not (tramp--test-rsync-p))) |
| 3494 | ;; Wildcards are not supported in tramp-crypt.el. | 3494 | ;; Wildcards are not supported in tramp-crypt.el. |
| 3495 | (skip-unless (not (tramp--test-crypt-p))) | 3495 | (skip-unless (not (tramp--test-crypt-p))) |
| 3496 | ;; Wildcards are not supported with "docker cp ..." or "podman cp ...". | ||
| 3497 | (skip-unless (not (tramp--test-container-oob-p))) | ||
| 3496 | 3498 | ||
| 3497 | (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) | 3499 | (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) |
| 3498 | (let* ((tmp-name1 | 3500 | (let* ((tmp-name1 |
| @@ -3815,15 +3817,24 @@ This tests also `access-file', `file-readable-p', | |||
| 3815 | (ignore-errors (delete-file tmp-name1)) | 3817 | (ignore-errors (delete-file tmp-name1)) |
| 3816 | (ignore-errors (delete-file tmp-name2)))))) | 3818 | (ignore-errors (delete-file tmp-name2)))))) |
| 3817 | 3819 | ||
| 3820 | (defun tramp--test-set-ert-test-documentation (test command) | ||
| 3821 | "Set the documentation string for a derived test. | ||
| 3822 | The test is derived from TEST and COMMAND." | ||
| 3823 | (let ((test-doc | ||
| 3824 | (split-string (ert-test-documentation (get test 'ert--test)) "\n"))) | ||
| 3825 | ;; The first line must be extended. | ||
| 3826 | (setcar | ||
| 3827 | test-doc (format "%s Use the \"%s\" command." (car test-doc) command)) | ||
| 3828 | (setf (ert-test-documentation | ||
| 3829 | (get (intern (format "%s-with-%s" test command)) 'ert--test)) | ||
| 3830 | (string-join test-doc "\n")))) | ||
| 3831 | |||
| 3818 | (defmacro tramp--test-deftest-with-stat (test) | 3832 | (defmacro tramp--test-deftest-with-stat (test) |
| 3819 | "Define ert `TEST-with-stat'." | 3833 | "Define ert `TEST-with-stat'." |
| 3820 | (declare (indent 1)) | 3834 | (declare (indent 1)) |
| 3821 | `(ert-deftest ,(intern (concat (symbol-name test) "-with-stat")) () | 3835 | `(ert-deftest ,(intern (concat (symbol-name test) "-with-stat")) () |
| 3822 | ;; This is the docstring. However, it must be expanded to a | ||
| 3823 | ;; string inside the macro. No idea. | ||
| 3824 | ;; (concat (ert-test-documentation (get ',test 'ert--test)) | ||
| 3825 | ;; "\nUse the \"stat\" command.") | ||
| 3826 | :tags '(:expensive-test) | 3836 | :tags '(:expensive-test) |
| 3837 | (tramp--test-set-ert-test-documentation ',test "stat") | ||
| 3827 | (skip-unless (tramp--test-enabled)) | 3838 | (skip-unless (tramp--test-enabled)) |
| 3828 | (skip-unless (tramp--test-sh-p)) | 3839 | (skip-unless (tramp--test-sh-p)) |
| 3829 | (skip-unless (tramp-get-remote-stat tramp-test-vec)) | 3840 | (skip-unless (tramp-get-remote-stat tramp-test-vec)) |
| @@ -3842,11 +3853,8 @@ This tests also `access-file', `file-readable-p', | |||
| 3842 | "Define ert `TEST-with-perl'." | 3853 | "Define ert `TEST-with-perl'." |
| 3843 | (declare (indent 1)) | 3854 | (declare (indent 1)) |
| 3844 | `(ert-deftest ,(intern (concat (symbol-name test) "-with-perl")) () | 3855 | `(ert-deftest ,(intern (concat (symbol-name test) "-with-perl")) () |
| 3845 | ;; This is the docstring. However, it must be expanded to a | ||
| 3846 | ;; string inside the macro. No idea. | ||
| 3847 | ;; (concat (ert-test-documentation (get ',test 'ert--test)) | ||
| 3848 | ;; "\nUse the \"perl\" command.") | ||
| 3849 | :tags '(:expensive-test) | 3856 | :tags '(:expensive-test) |
| 3857 | (tramp--test-set-ert-test-documentation ',test "perl") | ||
| 3850 | (skip-unless (tramp--test-enabled)) | 3858 | (skip-unless (tramp--test-enabled)) |
| 3851 | (skip-unless (tramp--test-sh-p)) | 3859 | (skip-unless (tramp--test-sh-p)) |
| 3852 | (skip-unless (tramp-get-remote-perl tramp-test-vec)) | 3860 | (skip-unless (tramp-get-remote-perl tramp-test-vec)) |
| @@ -3870,11 +3878,8 @@ This tests also `access-file', `file-readable-p', | |||
| 3870 | "Define ert `TEST-with-ls'." | 3878 | "Define ert `TEST-with-ls'." |
| 3871 | (declare (indent 1)) | 3879 | (declare (indent 1)) |
| 3872 | `(ert-deftest ,(intern (concat (symbol-name test) "-with-ls")) () | 3880 | `(ert-deftest ,(intern (concat (symbol-name test) "-with-ls")) () |
| 3873 | ;; This is the docstring. However, it must be expanded to a | ||
| 3874 | ;; string inside the macro. No idea. | ||
| 3875 | ;; (concat (ert-test-documentation (get ',test 'ert--test)) | ||
| 3876 | ;; "\nUse the \"ls\" command.") | ||
| 3877 | :tags '(:expensive-test) | 3881 | :tags '(:expensive-test) |
| 3882 | (tramp--test-set-ert-test-documentation ',test "ls") | ||
| 3878 | (skip-unless (tramp--test-enabled)) | 3883 | (skip-unless (tramp--test-enabled)) |
| 3879 | (skip-unless (tramp--test-sh-p)) | 3884 | (skip-unless (tramp--test-sh-p)) |
| 3880 | (if-let ((default-directory ert-remote-temporary-file-directory) | 3885 | (if-let ((default-directory ert-remote-temporary-file-directory) |
| @@ -5155,8 +5160,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 5155 | (should-not (get-buffer-window (current-buffer) t)) | 5160 | (should-not (get-buffer-window (current-buffer) t)) |
| 5156 | (delete-file tmp-name))) | 5161 | (delete-file tmp-name))) |
| 5157 | 5162 | ||
| 5158 | ;; Check remote and local DESTNATION file. This isn't | 5163 | ;; Check remote and local DESTINATION file. This isn't |
| 5159 | ;; implemented yet ina all file name handler backends. | 5164 | ;; implemented yet in all file name handler backends. |
| 5160 | ;; (dolist (local '(nil t)) | 5165 | ;; (dolist (local '(nil t)) |
| 5161 | ;; (setq tmp-name (tramp--test-make-temp-name local quoted)) | 5166 | ;; (setq tmp-name (tramp--test-make-temp-name local quoted)) |
| 5162 | ;; (should | 5167 | ;; (should |
| @@ -6376,33 +6381,35 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6376 | (setq tramp-remote-path orig-tramp-remote-path) | 6381 | (setq tramp-remote-path orig-tramp-remote-path) |
| 6377 | 6382 | ||
| 6378 | ;; We make a super long `tramp-remote-path'. | 6383 | ;; We make a super long `tramp-remote-path'. |
| 6379 | (make-directory tmp-name) | 6384 | (unless (tramp--test-container-oob-p) |
| 6380 | (should (file-directory-p tmp-name)) | 6385 | (make-directory tmp-name) |
| 6381 | (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) | 6386 | (should (file-directory-p tmp-name)) |
| 6382 | (let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir))) | 6387 | (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) |
| 6383 | (should (file-directory-p dir)) | 6388 | (let ((dir (make-temp-file |
| 6384 | (setq tramp-remote-path | 6389 | (file-name-as-directory tmp-name) 'dir))) |
| 6385 | (append | 6390 | (should (file-directory-p dir)) |
| 6386 | tramp-remote-path `(,(file-remote-p dir 'localname))) | 6391 | (setq tramp-remote-path |
| 6387 | orig-exec-path | 6392 | (append |
| 6388 | (append | 6393 | tramp-remote-path `(,(file-remote-p dir 'localname))) |
| 6389 | (butlast orig-exec-path) | 6394 | orig-exec-path |
| 6390 | `(,(file-remote-p dir 'localname)) | 6395 | (append |
| 6391 | (last orig-exec-path))))) | 6396 | (butlast orig-exec-path) |
| 6392 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) | 6397 | `(,(file-remote-p dir 'localname)) |
| 6393 | (should (equal (exec-path) orig-exec-path)) | 6398 | (last orig-exec-path))))) |
| 6394 | ;; Ignore trailing newline. | 6399 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) |
| 6395 | (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) | 6400 | (should (equal (exec-path) orig-exec-path)) |
| 6396 | ;; The shell doesn't handle such long strings. | 6401 | ;; Ignore trailing newline. |
| 6397 | (unless (tramp-compat-length> | 6402 | (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) |
| 6398 | path | 6403 | ;; The shell doesn't handle such long strings. |
| 6399 | (tramp-get-connection-property | 6404 | (unless (tramp-compat-length> |
| 6400 | tramp-test-vec "pipe-buf" 4096)) | 6405 | path |
| 6401 | ;; The last element of `exec-path' is `exec-directory'. | 6406 | (tramp-get-connection-property |
| 6402 | (should | 6407 | tramp-test-vec "pipe-buf" 4096)) |
| 6403 | (string-equal path (string-join (butlast orig-exec-path) ":")))) | 6408 | ;; The last element of `exec-path' is `exec-directory'. |
| 6404 | ;; The shell "sh" shall always exist. | 6409 | (should |
| 6405 | (should (executable-find "sh" 'remote))) | 6410 | (string-equal path (string-join (butlast orig-exec-path) ":")))) |
| 6411 | ;; The shell "sh" shall always exist. | ||
| 6412 | (should (executable-find "sh" 'remote)))) | ||
| 6406 | 6413 | ||
| 6407 | ;; Cleanup. | 6414 | ;; Cleanup. |
| 6408 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) | 6415 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) |
| @@ -7053,17 +7060,24 @@ This is used in tests which we don't want to tag | |||
| 7053 | (not (and (tramp--test-adb-p) | 7060 | (not (and (tramp--test-adb-p) |
| 7054 | (string-match-p (rx multibyte) default-directory))))) | 7061 | (string-match-p (rx multibyte) default-directory))))) |
| 7055 | 7062 | ||
| 7056 | (defun tramp--test-crypt-p () | ||
| 7057 | "Check, whether the remote directory is encrypted." | ||
| 7058 | (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) | ||
| 7059 | |||
| 7060 | (defun tramp--test-container-p () | 7063 | (defun tramp--test-container-p () |
| 7061 | "Check, whether a container method is used. | 7064 | "Check, whether a container method is used. |
| 7062 | This does not support some special file names." | 7065 | This does not support some special file names." |
| 7063 | (string-match-p | 7066 | (string-match-p |
| 7064 | (rx bol (| "docker" "podman") eol) | 7067 | (rx bol (| "docker" "podman")) |
| 7065 | (file-remote-p ert-remote-temporary-file-directory 'method))) | 7068 | (file-remote-p ert-remote-temporary-file-directory 'method))) |
| 7066 | 7069 | ||
| 7070 | (defun tramp--test-container-oob-p () | ||
| 7071 | "Check, whether the dockercp or podmancp method is used. | ||
| 7072 | They does not support wildcard copy." | ||
| 7073 | (string-match-p | ||
| 7074 | (rx bol (| "dockercp" "podmancp") eol) | ||
| 7075 | (file-remote-p ert-remote-temporary-file-directory 'method))) | ||
| 7076 | |||
| 7077 | (defun tramp--test-crypt-p () | ||
| 7078 | "Check, whether the remote directory is encrypted." | ||
| 7079 | (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) | ||
| 7080 | |||
| 7067 | (defun tramp--test-expensive-test-p () | 7081 | (defun tramp--test-expensive-test-p () |
| 7068 | "Whether expensive tests are run. | 7082 | "Whether expensive tests are run. |
| 7069 | This is used in tests which we don't want to tag `:expensive' | 7083 | This is used in tests which we don't want to tag `:expensive' |
| @@ -7480,7 +7494,8 @@ This requires restrictions of file name syntax." | |||
| 7480 | (tramp--test-gvfs-p) | 7494 | (tramp--test-gvfs-p) |
| 7481 | (tramp--test-windows-nt-or-smb-p)) | 7495 | (tramp--test-windows-nt-or-smb-p)) |
| 7482 | "?foo?bar?baz?") | 7496 | "?foo?bar?baz?") |
| 7483 | (unless (or (tramp--test-ftp-p) | 7497 | (unless (or (tramp--test-container-oob-p) |
| 7498 | (tramp--test-ftp-p) | ||
| 7484 | (tramp--test-gvfs-p) | 7499 | (tramp--test-gvfs-p) |
| 7485 | (tramp--test-windows-nt-or-smb-p)) | 7500 | (tramp--test-windows-nt-or-smb-p)) |
| 7486 | "*foo+bar*baz+") | 7501 | "*foo+bar*baz+") |
| @@ -7500,7 +7515,10 @@ This requires restrictions of file name syntax." | |||
| 7500 | (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) | 7515 | (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) |
| 7501 | "<foo>bar<baz>") | 7516 | "<foo>bar<baz>") |
| 7502 | "(foo)bar(baz)" | 7517 | "(foo)bar(baz)" |
| 7503 | (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") | 7518 | (unless (or (tramp--test-container-oob-p) |
| 7519 | (tramp--test-ftp-p) | ||
| 7520 | (tramp--test-gvfs-p)) | ||
| 7521 | "[foo]bar[baz]") | ||
| 7504 | "{foo}bar{baz}"))) | 7522 | "{foo}bar{baz}"))) |
| 7505 | ;; Simplify test in order to speed up. | 7523 | ;; Simplify test in order to speed up. |
| 7506 | (apply #'tramp--test-check-files | 7524 | (apply #'tramp--test-check-files |
diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index d7e547fcf29..f9f97dba535 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el | |||
| @@ -32,27 +32,18 @@ | |||
| 32 | (should-not (obarrayp "aoeu")) | 32 | (should-not (obarrayp "aoeu")) |
| 33 | (should-not (obarrayp '())) | 33 | (should-not (obarrayp '())) |
| 34 | (should-not (obarrayp [])) | 34 | (should-not (obarrayp [])) |
| 35 | (should (obarrayp (make-vector 7 0)))) | ||
| 36 | |||
| 37 | (ert-deftest obarrayp-unchecked-content-test () | ||
| 38 | "Should fail to check content of passed obarray." | ||
| 39 | :expected-result :failed | ||
| 40 | (should-not (obarrayp ["a" "b" "c"])) | 35 | (should-not (obarrayp ["a" "b" "c"])) |
| 41 | (should-not (obarrayp [1 2 3]))) | 36 | (should-not (obarrayp [1 2 3])) |
| 42 | 37 | (should-not (obarrayp (make-vector 7 0))) | |
| 43 | (ert-deftest obarray-make-default-test () | 38 | (should-not (obarrayp (vector (obarray-make)))) |
| 44 | (let ((table (obarray-make))) | 39 | (should (obarrayp (obarray-make))) |
| 45 | (should (obarrayp table)) | 40 | (should (obarrayp (obarray-make 7)))) |
| 46 | (should (eq (obarray-size table) obarray-default-size)))) | ||
| 47 | 41 | ||
| 48 | (ert-deftest obarray-make-with-size-test () | 42 | (ert-deftest obarray-make-with-size-test () |
| 49 | ;; FIXME: Actually, `wrong-type-argument' is not the right error to signal, | 43 | ;; FIXME: Actually, `wrong-type-argument' is not the right error to signal, |
| 50 | ;; so we shouldn't enforce this misbehavior in tests! | 44 | ;; so we shouldn't enforce this misbehavior in tests! |
| 51 | (should-error (obarray-make -1) :type 'wrong-type-argument) | 45 | (should-error (obarray-make -1) :type 'wrong-type-argument) |
| 52 | (should-error (obarray-make 0) :type 'wrong-type-argument) | 46 | (should-error (obarray-make 'a) :type 'wrong-type-argument)) |
| 53 | (let ((table (obarray-make 1))) | ||
| 54 | (should (obarrayp table)) | ||
| 55 | (should (eq (obarray-size table) 1)))) | ||
| 56 | 47 | ||
| 57 | (ert-deftest obarray-get-test () | 48 | (ert-deftest obarray-get-test () |
| 58 | (let ((table (obarray-make 3))) | 49 | (let ((table (obarray-make 3))) |
| @@ -88,5 +79,15 @@ | |||
| 88 | (obarray-map collect-names table) | 79 | (obarray-map collect-names table) |
| 89 | (should (equal (sort syms #'string<) '("a" "b" "c"))))) | 80 | (should (equal (sort syms #'string<) '("a" "b" "c"))))) |
| 90 | 81 | ||
| 82 | (ert-deftest obarray-clear () | ||
| 83 | (let ((o (obarray-make))) | ||
| 84 | (intern "a" o) | ||
| 85 | (intern "b" o) | ||
| 86 | (intern "c" o) | ||
| 87 | (obarray-clear o) | ||
| 88 | (let ((n 0)) | ||
| 89 | (mapatoms (lambda (_) (setq n (1+ n))) o) | ||
| 90 | (should (equal n 0))))) | ||
| 91 | |||
| 91 | (provide 'obarray-tests) | 92 | (provide 'obarray-tests) |
| 92 | ;;; obarray-tests.el ends here | 93 | ;;; obarray-tests.el ends here |
diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts index 4fca74dd2e1..514d2e08977 100644 --- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts | |||
| @@ -110,3 +110,34 @@ public class Java { | |||
| 110 | } | 110 | } |
| 111 | } | 111 | } |
| 112 | =-=-= | 112 | =-=-= |
| 113 | |||
| 114 | Name: Opening bracket on separate line (bug#67556) | ||
| 115 | |||
| 116 | =-= | ||
| 117 | public class Java { | ||
| 118 | void foo( | ||
| 119 | String foo) | ||
| 120 | { | ||
| 121 | for (var f : rs) | ||
| 122 | return new String[] | ||
| 123 | { | ||
| 124 | "foo", | ||
| 125 | "bar" | ||
| 126 | }; | ||
| 127 | if (a == 0) | ||
| 128 | { | ||
| 129 | return 0; | ||
| 130 | } else if (a == 1) | ||
| 131 | { | ||
| 132 | return 1; | ||
| 133 | } | ||
| 134 | |||
| 135 | switch(expr) | ||
| 136 | { | ||
| 137 | case x: | ||
| 138 | // code block | ||
| 139 | break; | ||
| 140 | } | ||
| 141 | } | ||
| 142 | } | ||
| 143 | =-=-= | ||
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 59957ff0712..1ceee690cfb 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el | |||
| @@ -55,21 +55,27 @@ BODY is code to be executed within the temp buffer. Point is | |||
| 55 | always located at the beginning of buffer. Native completion is | 55 | always located at the beginning of buffer. Native completion is |
| 56 | turned off. Shell buffer will be killed on exit." | 56 | turned off. Shell buffer will be killed on exit." |
| 57 | (declare (indent 1) (debug t)) | 57 | (declare (indent 1) (debug t)) |
| 58 | `(with-temp-buffer | 58 | (let ((dir (make-symbol "dir"))) |
| 59 | (let ((python-indent-guess-indent-offset nil) | 59 | `(with-temp-buffer |
| 60 | (python-shell-completion-native-enable nil)) | 60 | (let ((python-indent-guess-indent-offset nil) |
| 61 | (python-mode) | 61 | (python-shell-completion-native-enable nil)) |
| 62 | (unwind-protect | 62 | (python-mode) |
| 63 | (progn | 63 | (unwind-protect |
| 64 | (run-python nil t) | 64 | ;; Prevent test failures when Jedi is used as a completion |
| 65 | (insert ,contents) | 65 | ;; backend, either directly or indirectly (e.g., via |
| 66 | (goto-char (point-min)) | 66 | ;; IPython). Jedi needs to store cache, but the |
| 67 | (python-tests-shell-wait-for-prompt) | 67 | ;; "/nonexistent" HOME directory is not writable. |
| 68 | ,@body) | 68 | (ert-with-temp-directory ,dir |
| 69 | (when (python-shell-get-buffer) | 69 | (with-environment-variables (("XDG_CACHE_HOME" ,dir)) |
| 70 | (python-shell-with-shell-buffer | 70 | (run-python nil t) |
| 71 | (let (kill-buffer-hook kill-buffer-query-functions) | 71 | (insert ,contents) |
| 72 | (kill-buffer)))))))) | 72 | (goto-char (point-min)) |
| 73 | (python-tests-shell-wait-for-prompt) | ||
| 74 | ,@body)) | ||
| 75 | (when (python-shell-get-buffer) | ||
| 76 | (python-shell-with-shell-buffer | ||
| 77 | (let (kill-buffer-hook kill-buffer-query-functions) | ||
| 78 | (kill-buffer))))))))) | ||
| 73 | 79 | ||
| 74 | (defmacro python-tests-with-temp-file (contents &rest body) | 80 | (defmacro python-tests-with-temp-file (contents &rest body) |
| 75 | "Create a `python-mode' enabled file with CONTENTS. | 81 | "Create a `python-mode' enabled file with CONTENTS. |
| @@ -4799,6 +4805,111 @@ def foo(): | |||
| 4799 | (end-of-line 0) | 4805 | (end-of-line 0) |
| 4800 | (should-not (nth 2 (python-shell-completion-at-point)))))) | 4806 | (should-not (nth 2 (python-shell-completion-at-point)))))) |
| 4801 | 4807 | ||
| 4808 | (defun python-tests--completion-module () | ||
| 4809 | "Check if modules can be completed in Python shell." | ||
| 4810 | (insert "import datet") | ||
| 4811 | (completion-at-point) | ||
| 4812 | (beginning-of-line) | ||
| 4813 | (should (looking-at-p "import datetime")) | ||
| 4814 | (kill-line) | ||
| 4815 | (insert "from datet") | ||
| 4816 | (completion-at-point) | ||
| 4817 | (beginning-of-line) | ||
| 4818 | (should (looking-at-p "from datetime")) | ||
| 4819 | (end-of-line) | ||
| 4820 | (insert " import timed") | ||
| 4821 | (completion-at-point) | ||
| 4822 | (beginning-of-line) | ||
| 4823 | (should (looking-at-p "from datetime import timedelta")) | ||
| 4824 | (kill-line)) | ||
| 4825 | |||
| 4826 | (defun python-tests--completion-parameters () | ||
| 4827 | "Check if parameters can be completed in Python shell." | ||
| 4828 | (insert "import re") | ||
| 4829 | (comint-send-input) | ||
| 4830 | (python-tests-shell-wait-for-prompt) | ||
| 4831 | (insert "re.split('b', 'abc', maxs") | ||
| 4832 | (completion-at-point) | ||
| 4833 | (should (string= "re.split('b', 'abc', maxsplit=" | ||
| 4834 | (buffer-substring (line-beginning-position) (point)))) | ||
| 4835 | (insert "0, ") | ||
| 4836 | (should (python-shell-completion-at-point)) | ||
| 4837 | ;; Test if cache is used. | ||
| 4838 | (cl-letf (((symbol-function 'python-shell-completion-get-completions) | ||
| 4839 | 'ignore) | ||
| 4840 | ((symbol-function 'python-shell-completion-native-get-completions) | ||
| 4841 | 'ignore)) | ||
| 4842 | (insert "fla") | ||
| 4843 | (completion-at-point) | ||
| 4844 | (should (string= "re.split('b', 'abc', maxsplit=0, flags=" | ||
| 4845 | (buffer-substring (line-beginning-position) (point))))) | ||
| 4846 | (beginning-of-line) | ||
| 4847 | (kill-line)) | ||
| 4848 | |||
| 4849 | (defun python-tests--completion-extra-context () | ||
| 4850 | "Check if extra context is used for completion." | ||
| 4851 | (insert "re.split('b', 'abc',") | ||
| 4852 | (comint-send-input) | ||
| 4853 | (python-tests-shell-wait-for-prompt) | ||
| 4854 | (insert "maxs") | ||
| 4855 | (completion-at-point) | ||
| 4856 | (should (string= "maxsplit=" | ||
| 4857 | (buffer-substring (line-beginning-position) (point)))) | ||
| 4858 | (insert "0)") | ||
| 4859 | (comint-send-input) | ||
| 4860 | (python-tests-shell-wait-for-prompt) | ||
| 4861 | (insert "from re import (") | ||
| 4862 | (comint-send-input) | ||
| 4863 | (python-tests-shell-wait-for-prompt) | ||
| 4864 | (insert "IGN") | ||
| 4865 | (completion-at-point) | ||
| 4866 | (should (string= "IGNORECASE" | ||
| 4867 | (buffer-substring (line-beginning-position) (point))))) | ||
| 4868 | |||
| 4869 | (defun python-tests--pythonstartup-file () | ||
| 4870 | "Return Jedi readline setup file if PYTHONSTARTUP is not set." | ||
| 4871 | (or (getenv "PYTHONSTARTUP") | ||
| 4872 | (with-temp-buffer | ||
| 4873 | (if (eql 0 (call-process python-tests-shell-interpreter | ||
| 4874 | nil t nil "-m" "jedi" "repl")) | ||
| 4875 | (string-trim (buffer-string)) | ||
| 4876 | "")))) | ||
| 4877 | |||
| 4878 | (ert-deftest python-shell-completion-at-point-jedi-completer () | ||
| 4879 | "Check if Python shell completion works when Jedi completer is used." | ||
| 4880 | (skip-unless (executable-find python-tests-shell-interpreter)) | ||
| 4881 | (with-environment-variables | ||
| 4882 | (("PYTHONSTARTUP" (python-tests--pythonstartup-file))) | ||
| 4883 | (python-tests-with-temp-buffer-with-shell | ||
| 4884 | "" | ||
| 4885 | (python-shell-with-shell-buffer | ||
| 4886 | (python-shell-completion-native-turn-on) | ||
| 4887 | (skip-unless (string= python-shell-readline-completer-delims "")) | ||
| 4888 | (python-tests--completion-module) | ||
| 4889 | (python-tests--completion-parameters) | ||
| 4890 | (python-tests--completion-extra-context))))) | ||
| 4891 | |||
| 4892 | (ert-deftest python-shell-completion-at-point-ipython () | ||
| 4893 | "Check if Python shell completion works for IPython." | ||
| 4894 | (let ((python-shell-interpreter "ipython") | ||
| 4895 | (python-shell-interpreter-args "-i --simple-prompt")) | ||
| 4896 | (skip-unless | ||
| 4897 | (and | ||
| 4898 | (executable-find python-shell-interpreter) | ||
| 4899 | (eql (call-process python-shell-interpreter nil nil nil "--version") 0))) | ||
| 4900 | (with-environment-variables | ||
| 4901 | (("PYTHONSTARTUP" (python-tests--pythonstartup-file))) | ||
| 4902 | (python-tests-with-temp-buffer-with-shell | ||
| 4903 | "" | ||
| 4904 | (python-shell-with-shell-buffer | ||
| 4905 | (python-shell-completion-native-turn-off) | ||
| 4906 | (python-tests--completion-module) | ||
| 4907 | (python-tests--completion-parameters) | ||
| 4908 | (python-shell-completion-native-turn-on) | ||
| 4909 | (skip-unless (string= python-shell-readline-completer-delims "")) | ||
| 4910 | (python-tests--completion-module) | ||
| 4911 | (python-tests--completion-parameters) | ||
| 4912 | (python-tests--completion-extra-context)))))) | ||
| 4802 | 4913 | ||
| 4803 | 4914 | ||
| 4804 | ;;; PDB Track integration | 4915 | ;;; PDB Track integration |
| @@ -4945,11 +5056,6 @@ import abc | |||
| 4945 | 5056 | ||
| 4946 | (ert-deftest python-ffap-module-path-1 () | 5057 | (ert-deftest python-ffap-module-path-1 () |
| 4947 | (skip-unless (executable-find python-tests-shell-interpreter)) | 5058 | (skip-unless (executable-find python-tests-shell-interpreter)) |
| 4948 | ;; Skip the test on macOS, since the standard Python installation uses | ||
| 4949 | ;; libedit rather than readline which confuses the running of an inferior | ||
| 4950 | ;; interpreter in this case (see bug#59477 and bug#25753). | ||
| 4951 | (skip-when (eq system-type 'darwin)) | ||
| 4952 | (trace-function 'python-shell-output-filter) | ||
| 4953 | (python-tests-with-temp-buffer-with-shell | 5059 | (python-tests-with-temp-buffer-with-shell |
| 4954 | " | 5060 | " |
| 4955 | import abc | 5061 | import abc |
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index ba51f375cc6..e50738f1122 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el | |||
| @@ -92,6 +92,8 @@ | |||
| 92 | ("1@example.com" 1 email "1@example.com") | 92 | ("1@example.com" 1 email "1@example.com") |
| 93 | ;; email addresses user portion containing dots | 93 | ;; email addresses user portion containing dots |
| 94 | ("foo.bar@example.com" 1 email "foo.bar@example.com") | 94 | ("foo.bar@example.com" 1 email "foo.bar@example.com") |
| 95 | ("foo.bar@example.com" 5 email "foo.bar@example.com") | ||
| 96 | (" fo.ba@example.com" 6 email "fo.ba@example.com") | ||
| 95 | (".foobar@example.com" 1 email nil) | 97 | (".foobar@example.com" 1 email nil) |
| 96 | (".foobar@example.com" 2 email "foobar@example.com") | 98 | (".foobar@example.com" 2 email "foobar@example.com") |
| 97 | ;; email addresses domain portion containing dots and dashes | 99 | ;; email addresses domain portion containing dots and dashes |
| @@ -180,6 +182,13 @@ position to retrieve THING.") | |||
| 180 | (should (thing-at-point-looking-at "2abcd")) | 182 | (should (thing-at-point-looking-at "2abcd")) |
| 181 | (should (equal (match-data) m2))))) | 183 | (should (equal (match-data) m2))))) |
| 182 | 184 | ||
| 185 | (ert-deftest thing-at-point-looking-at-overlapping-matches () | ||
| 186 | (with-temp-buffer | ||
| 187 | (insert "foo.bar.baz") | ||
| 188 | (goto-char (point-max)) | ||
| 189 | (should (thing-at-point-looking-at "[a-z]+\\.[a-z]+")) | ||
| 190 | (should (string= "bar.baz" (match-string 0))))) | ||
| 191 | |||
| 183 | (ert-deftest test-symbol-thing-1 () | 192 | (ert-deftest test-symbol-thing-1 () |
| 184 | (with-temp-buffer | 193 | (with-temp-buffer |
| 185 | (insert "foo bar zot") | 194 | (insert "foo bar zot") |
diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index 4cee084e211..dc4abf50767 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el | |||
| @@ -367,11 +367,11 @@ | |||
| 367 | (while (consp insn) | 367 | (while (consp insn) |
| 368 | (let ((newcar (car insn))) | 368 | (let ((newcar (car insn))) |
| 369 | (if (or (consp (car insn)) (comp-mvar-p (car insn))) | 369 | (if (or (consp (car insn)) (comp-mvar-p (car insn))) |
| 370 | (setf newcar (comp-copy-insn (car insn)))) | 370 | (setf newcar (comp--copy-insn (car insn)))) |
| 371 | (push newcar result)) | 371 | (push newcar result)) |
| 372 | (setf insn (cdr insn))) | 372 | (setf insn (cdr insn))) |
| 373 | (nconc (nreverse result) | 373 | (nconc (nreverse result) |
| 374 | (if (comp-mvar-p insn) (comp-copy-insn insn) insn))) | 374 | (if (comp-mvar-p insn) (comp--copy-insn insn) insn))) |
| 375 | (if (comp-mvar-p insn) | 375 | (if (comp-mvar-p insn) |
| 376 | (copy-comp-mvar insn) | 376 | (copy-comp-mvar insn) |
| 377 | insn))) | 377 | insn))) |
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 8bfe939fb23..67d632823b2 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el | |||
| @@ -904,16 +904,23 @@ Return a list of results." | |||
| 904 | (should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f))) | 904 | (should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f))) |
| 905 | (should (= (comp-tests-fw-prop-1-f) 6)))) | 905 | (should (= (comp-tests-fw-prop-1-f) 6)))) |
| 906 | 906 | ||
| 907 | (defun comp-tests--type-lists-equal (l1 l2) | ||
| 908 | (and (= (length l1) (length l2)) | ||
| 909 | (cl-every #'comp-tests--types-equal l1 l2))) | ||
| 910 | |||
| 907 | (defun comp-tests--types-equal (t1 t2) | 911 | (defun comp-tests--types-equal (t1 t2) |
| 908 | "Whether the types T1 and T2 are equal." | 912 | "Whether the types T1 and T2 are equal." |
| 909 | (or (equal t1 t2) ; optimization for the common case | 913 | (or (equal t1 t2) ; for atoms, and optimization for the common case |
| 910 | (and (consp t1) (consp t2) | 914 | (and (consp t1) (consp t2) |
| 911 | (eq (car t1) (car t2)) | 915 | (eq (car t1) (car t2)) |
| 912 | (if (memq (car t1) '(and or member)) | 916 | (cond ((memq (car t1) '(and or member)) |
| 913 | (null (cl-set-exclusive-or (cdr t1) (cdr t2) | 917 | ;; Order or duplicates don't matter. |
| 914 | :test #'comp-tests--types-equal)) | 918 | (null (cl-set-exclusive-or (cdr t1) (cdr t2) |
| 915 | (and (= (length t1) (length t2)) | 919 | :test #'comp-tests--types-equal))) |
| 916 | (cl-every #'comp-tests--types-equal (cdr t1) (cdr t2))))))) | 920 | ((eq (car t1) 'function) |
| 921 | (and (comp-tests--type-lists-equal (nth 1 t1) (nth 1 t2)) | ||
| 922 | (comp-tests--types-equal (nth 2 t1) (nth 2 t2)))) | ||
| 923 | (t (comp-tests--type-lists-equal (cdr t1) (cdr t2))))))) | ||
| 917 | 924 | ||
| 918 | (defun comp-tests-check-ret-type-spec (func-form ret-type) | 925 | (defun comp-tests-check-ret-type-spec (func-form ret-type) |
| 919 | (let ((lexical-binding t) | 926 | (let ((lexical-binding t) |
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index e1c90feb09a..187dc2f34d5 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el | |||
| @@ -282,26 +282,39 @@ expressions works for identifiers starting with period." | |||
| 282 | (should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d) | 282 | (should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d) |
| 283 | :type 'cyclic-variable-indirection)) | 283 | :type 'cyclic-variable-indirection)) |
| 284 | 284 | ||
| 285 | (defvar eval-tests/global-var 'value) | 285 | (defvar eval-tests/global-var 'global-value) |
| 286 | (defvar-local eval-tests/buffer-local-var 'value) | 286 | (defvar-local eval-tests/buffer-local-var 'default-value) |
| 287 | (ert-deftest eval-tests/default-value () | 287 | (ert-deftest eval-tests/default-value () |
| 288 | ;; `let' overrides the default value for global variables. | 288 | ;; `let' overrides the default value for global variables. |
| 289 | (should (default-boundp 'eval-tests/global-var)) | 289 | (should (default-boundp 'eval-tests/global-var)) |
| 290 | (should (eq 'value (default-value 'eval-tests/global-var))) | 290 | (should (eq 'global-value (default-value 'eval-tests/global-var))) |
| 291 | (should (eq 'value eval-tests/global-var)) | 291 | (should (eq 'global-value eval-tests/global-var)) |
| 292 | (let ((eval-tests/global-var 'bar)) | 292 | (let ((eval-tests/global-var 'let-value)) |
| 293 | (should (eq 'bar (default-value 'eval-tests/global-var))) | 293 | (should (eq 'let-value (default-value 'eval-tests/global-var))) |
| 294 | (should (eq 'bar eval-tests/global-var))) | 294 | (should (eq 'let-value eval-tests/global-var))) |
| 295 | ;; `let' overrides the default value everywhere, but leaves | 295 | ;; `let' overrides the default value everywhere, but leaves |
| 296 | ;; buffer-local values unchanged in current buffer and in the | 296 | ;; buffer-local values unchanged in current buffer and in the |
| 297 | ;; buffers where there is no explicitly set buffer-local value. | 297 | ;; buffers where there is no explicitly set buffer-local value. |
| 298 | (should (default-boundp 'eval-tests/buffer-local-var)) | 298 | (should (default-boundp 'eval-tests/buffer-local-var)) |
| 299 | (should (eq 'value (default-value 'eval-tests/buffer-local-var))) | 299 | (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) |
| 300 | (should (eq 'value eval-tests/buffer-local-var)) | 300 | (should (eq 'default-value eval-tests/buffer-local-var)) |
| 301 | (with-temp-buffer | 301 | (with-temp-buffer |
| 302 | (let ((eval-tests/buffer-local-var 'bar)) | 302 | (let ((eval-tests/buffer-local-var 'let-value)) |
| 303 | (should (eq 'bar (default-value 'eval-tests/buffer-local-var))) | 303 | (should (eq 'let-value (default-value 'eval-tests/buffer-local-var))) |
| 304 | (should (eq 'bar eval-tests/buffer-local-var))))) | 304 | (should (eq 'let-value eval-tests/buffer-local-var)))) |
| 305 | ;; When current buffer has explicit buffer-local binding, `let' does | ||
| 306 | ;; not alter the default binding. | ||
| 307 | (with-temp-buffer | ||
| 308 | (setq-local eval-tests/buffer-local-var 'local-value) | ||
| 309 | (let ((eval-tests/buffer-local-var 'let-value)) | ||
| 310 | ;; Let in a buffer with local binding does not change the | ||
| 311 | ;; default value for variable. | ||
| 312 | (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) | ||
| 313 | (should (eq 'let-value eval-tests/buffer-local-var)) | ||
| 314 | (with-temp-buffer | ||
| 315 | ;; We are in a new buffer - `eval-tests/buffer-local-var' has its global default value. | ||
| 316 | (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) | ||
| 317 | (should (eq 'default-value eval-tests/buffer-local-var)))))) | ||
| 305 | 318 | ||
| 306 | (ert-deftest eval-tests--handler-bind () | 319 | (ert-deftest eval-tests--handler-bind () |
| 307 | ;; A `handler-bind' has no effect if no error is signaled. | 320 | ;; A `handler-bind' has no effect if no error is signaled. |
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 3893b8b0320..7437c07f156 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el | |||
| @@ -1097,6 +1097,16 @@ | |||
| 1097 | (should (= (sxhash-equal (record 'a (make-string 10 ?a))) | 1097 | (should (= (sxhash-equal (record 'a (make-string 10 ?a))) |
| 1098 | (sxhash-equal (record 'a (make-string 10 ?a)))))) | 1098 | (sxhash-equal (record 'a (make-string 10 ?a)))))) |
| 1099 | 1099 | ||
| 1100 | (ert-deftest fns--define-hash-table-test () | ||
| 1101 | ;; Check that we can have two differently-named tests using the | ||
| 1102 | ;; same functions (bug#68668). | ||
| 1103 | (define-hash-table-test 'fns-tests--1 'my-cmp 'my-hash) | ||
| 1104 | (define-hash-table-test 'fns-tests--2 'my-cmp 'my-hash) | ||
| 1105 | (let ((h1 (make-hash-table :test 'fns-tests--1)) | ||
| 1106 | (h2 (make-hash-table :test 'fns-tests--2))) | ||
| 1107 | (should (eq (hash-table-test h1) 'fns-tests--1)) | ||
| 1108 | (should (eq (hash-table-test h2) 'fns-tests--2)))) | ||
| 1109 | |||
| 1100 | (ert-deftest test-secure-hash () | 1110 | (ert-deftest test-secure-hash () |
| 1101 | (should (equal (secure-hash 'md5 "foobar") | 1111 | (should (equal (secure-hash 'md5 "foobar") |
| 1102 | "3858f62230ac3c915f300c664312c63f")) | 1112 | "3858f62230ac3c915f300c664312c63f")) |
diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index 14d160df25c..99d522d1856 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el | |||
| @@ -34,7 +34,7 @@ | |||
| 34 | (let ((num 0)) | 34 | (let ((num 0)) |
| 35 | (mapcar (lambda (str) (cons str (cl-incf num))) list))) | 35 | (mapcar (lambda (str) (cons str (cl-incf num))) list))) |
| 36 | (defun minibuf-tests--strings-to-obarray (list) | 36 | (defun minibuf-tests--strings-to-obarray (list) |
| 37 | (let ((ob (make-vector 7 0))) | 37 | (let ((ob (obarray-make 7))) |
| 38 | (mapc (lambda (str) (intern str ob)) list) | 38 | (mapc (lambda (str) (intern str ob)) list) |
| 39 | ob)) | 39 | ob)) |
| 40 | (defun minibuf-tests--strings-to-string-hashtable (list) | 40 | (defun minibuf-tests--strings-to-string-hashtable (list) |
| @@ -61,6 +61,9 @@ | |||
| 61 | 61 | ||
| 62 | ;;; Testing functions that are agnostic to type of COLLECTION. | 62 | ;;; Testing functions that are agnostic to type of COLLECTION. |
| 63 | 63 | ||
| 64 | (defun minibuf-tests--set-equal (a b) | ||
| 65 | (null (cl-set-exclusive-or a b :test #'equal))) | ||
| 66 | |||
| 64 | (defun minibuf-tests--try-completion (xform-collection) | 67 | (defun minibuf-tests--try-completion (xform-collection) |
| 65 | (let* ((abcdef (funcall xform-collection '("abc" "def"))) | 68 | (let* ((abcdef (funcall xform-collection '("abc" "def"))) |
| 66 | (+abba (funcall xform-collection '("abc" "abba" "def")))) | 69 | (+abba (funcall xform-collection '("abc" "abba" "def")))) |
| @@ -101,7 +104,8 @@ | |||
| 101 | (let* ((abcdef (funcall xform-collection '("abc" "def"))) | 104 | (let* ((abcdef (funcall xform-collection '("abc" "def"))) |
| 102 | (+abba (funcall xform-collection '("abc" "abba" "def")))) | 105 | (+abba (funcall xform-collection '("abc" "abba" "def")))) |
| 103 | (should (equal (all-completions "a" abcdef) '("abc"))) | 106 | (should (equal (all-completions "a" abcdef) '("abc"))) |
| 104 | (should (equal (all-completions "a" +abba) '("abc" "abba"))) | 107 | (should (minibuf-tests--set-equal (all-completions "a" +abba) |
| 108 | '("abc" "abba"))) | ||
| 105 | (should (equal (all-completions "abc" +abba) '("abc"))) | 109 | (should (equal (all-completions "abc" +abba) '("abc"))) |
| 106 | (should (equal (all-completions "abcd" +abba) nil)))) | 110 | (should (equal (all-completions "abcd" +abba) nil)))) |
| 107 | 111 | ||
| @@ -111,7 +115,8 @@ | |||
| 111 | (+abba (funcall xform-collection '("abc" "abba" "def"))) | 115 | (+abba (funcall xform-collection '("abc" "abba" "def"))) |
| 112 | (+abba-member (funcall collection-member +abba))) | 116 | (+abba-member (funcall collection-member +abba))) |
| 113 | (should (equal (all-completions "a" abcdef abcdef-member) '("abc"))) | 117 | (should (equal (all-completions "a" abcdef abcdef-member) '("abc"))) |
| 114 | (should (equal (all-completions "a" +abba +abba-member) '("abc" "abba"))) | 118 | (should (minibuf-tests--set-equal (all-completions "a" +abba +abba-member) |
| 119 | '("abc" "abba"))) | ||
| 115 | (should (equal (all-completions "abc" +abba +abba-member) '("abc"))) | 120 | (should (equal (all-completions "abc" +abba +abba-member) '("abc"))) |
| 116 | (should (equal (all-completions "abcd" +abba +abba-member) nil)) | 121 | (should (equal (all-completions "abcd" +abba +abba-member) nil)) |
| 117 | (should-not (all-completions "a" abcdef #'ignore)) | 122 | (should-not (all-completions "a" abcdef #'ignore)) |
| @@ -124,7 +129,8 @@ | |||
| 124 | (+abba (funcall xform-collection '("abc" "abba" "def")))) | 129 | (+abba (funcall xform-collection '("abc" "abba" "def")))) |
| 125 | (let ((completion-regexp-list '("."))) | 130 | (let ((completion-regexp-list '("."))) |
| 126 | (should (equal (all-completions "a" abcdef) '("abc"))) | 131 | (should (equal (all-completions "a" abcdef) '("abc"))) |
| 127 | (should (equal (all-completions "a" +abba) '("abc" "abba"))) | 132 | (should (minibuf-tests--set-equal (all-completions "a" +abba) |
| 133 | '("abc" "abba"))) | ||
| 128 | (should (equal (all-completions "abc" +abba) '("abc"))) | 134 | (should (equal (all-completions "abc" +abba) '("abc"))) |
| 129 | (should (equal (all-completions "abcd" +abba) nil))) | 135 | (should (equal (all-completions "abcd" +abba) nil))) |
| 130 | (let ((completion-regexp-list '("X"))) | 136 | (let ((completion-regexp-list '("X"))) |
diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index a89bf1298c0..bdc9630c783 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el | |||
| @@ -254,7 +254,7 @@ | |||
| 254 | (should (eq nil (treesit-node-text | 254 | (should (eq nil (treesit-node-text |
| 255 | (treesit-search-subtree | 255 | (treesit-search-subtree |
| 256 | subarray "\\[")))) | 256 | subarray "\\[")))) |
| 257 | ;; If ALL=nil, searching for number should still find the | 257 | ;; If ALL=t, searching for number should still find the |
| 258 | ;; numbers. | 258 | ;; numbers. |
| 259 | (should (equal "1" (treesit-node-text | 259 | (should (equal "1" (treesit-node-text |
| 260 | (treesit-search-subtree | 260 | (treesit-search-subtree |